bascode.bas

由VB编写的一个实用短信计费系统。主要模块包括（1）计费管理子系统：用户入费；错单处理；用户费率管理；费率管理；用户分析（2）系统维护子系统：管理员登录、管理员管理、数据库设置等（3）计费引擎子系统

Attribute VB_Name = "basCode"
Public Type ENCRYPTCLASS
  Name As String
  Object As Object
  Homepage As String
End Type
Public EncryptObjects() As ENCRYPTCLASS
Public EncryptObjectsCount As Long
Public intColorR As Integer
Public intColorG As Integer
Public intColorB As Integer
Public Const BENCHMARKSIZE = 1000000
Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

' Translate a password into an offset value.
Private Function NumericPassword(ByVal password As String) As Long

    Dim Value As Long
    Dim ch As Long
    Dim shift1 As Long
    Dim shift2 As Long
    Dim i As Integer
    Dim str_len As Integer

    str_len = Len(password)
    For i = 1 To str_len
        ' Add the next letter.
        ch = Asc(Mid$(password, i, 1))
        Value = Value Xor (ch * 2 ^ shift1)
        Value = Value Xor (ch * 2 ^ shift2)

        ' Change the shift offsets.
        shift1 = (shift1 + 7) Mod 19
        shift2 = (shift2 + 13) Mod 23
    Next i
    NumericPassword = Value
    
End Function
' Encipher the text using the pasword.
Public Function Cipher(ByVal password As String, ByVal from_text As String) As String

    Const MIN_ASC = 32  ' Space.
    Const MAX_ASC = 126 ' ~.
    Const NUM_ASC = MAX_ASC - MIN_ASC + 1
    Dim to_text As String
    Dim Offset As Long
    Dim str_len As Integer
    Dim i As Integer
    Dim ch As Integer

    ' Initialize the random number generator.
    Offset = NumericPassword(password)
    Rnd -1
    Randomize Offset

    ' Encipher the string.
    str_len = Len(from_text)
    For i = 1 To str_len
        ch = Asc(Mid$(from_text, i, 1))
        If ch >= MIN_ASC And ch <= MAX_ASC Then
            ch = ch - MIN_ASC
            Offset = Int((NUM_ASC + 1) * Rnd)
            ch = ((ch + Offset) Mod NUM_ASC)
            ch = ch + MIN_ASC
            to_text = to_text & Chr$(ch)
        End If
    Next i
    Cipher = to_text
    
End Function
' Encipher the text using the pasword.
Public Function Decipher(ByVal password As String, ByVal from_text As String) As String

    Const MIN_ASC = 32  ' Space.
    Const MAX_ASC = 126 ' ~.
    Const NUM_ASC = MAX_ASC - MIN_ASC + 1
    Dim to_text As String
    Dim Offset As Long
    Dim str_len As Integer
    Dim i As Integer
    Dim ch As Integer
    to_text = ""
    ' Initialize the random number generator.
    Offset = NumericPassword(password)
    Rnd -1
    Randomize Offset

    ' Encipher the string.
    str_len = Len(from_text)
    For i = 1 To str_len
        ch = Asc(Mid$(from_text, i, 1))
        If ch >= MIN_ASC And ch <= MAX_ASC Then
            ch = ch - MIN_ASC
            Offset = Int((NUM_ASC + 1) * Rnd)
            ch = ((ch - Offset) Mod NUM_ASC)
            If ch < 0 Then ch = ch + NUM_ASC
            ch = ch + MIN_ASC
            to_text = to_text & Chr$(ch)
        End If
    Next i
    Decipher = to_text
    
End Function