modcipher.bas

ERP管理系统源代码erp 管理系统源代码

Attribute VB_Name = "modCipher"
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'                                                                                                       '
'   MODULE        : modCipher                                                                           '
'   DESCRIPTION   : 信息加密解密模块 —— 加密解密模块中的功能                                          '
'   CREATE        : Chenmw 2001,10,22                                                                   '
'   CODE          : Chenmw 2001,10,22                                                                   '
'   FUNCTION      : 保存基础模块中的常用公共信息                                                        '
'   USAGE         : 使用 InitBaseInfoModule 初始化本模块。                                              '
'   SUMMARY       : 在文件最后                                                                          '
'                                                                                                       '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'                                                                                                       '
'   1.函数声明                                                                                          '
'       (1)加密函数                                                                                     '
'           Public Sub Cipher(ByVal password As String, ByVal from_text As String, to_text As String)   '
'                   password-----口令，from_text-----明文，to_text-----密文                             '
'       (2)解密函数                                                                                     '
'           Public Sub Decipher(ByVal password As String,ByVal from_text As String,to_text As String)   '
'                   password-----口令，from_text-----明文，to_text-----密文                             '
'       (3)散转函数                                                                                     '
'           Private Function NumericPassword(ByVal password As String) As Long                          '
'                   password-----口令，返回散转后的值                                                   '
'                                                                                                       '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' Encipher the text using the pasword.
Public Sub Cipher(ByVal password As String, ByVal from_text As String, to_text As String)
    
    Const MIN_ASC = 32  ' Space.
    Const MAX_ASC = 126 ' ~.
    Const NUM_ASC = MAX_ASC - MIN_ASC + 1
    
    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
    
End Sub

' Encipher the text using the pasword.
Public Sub Decipher(ByVal password As String, ByVal from_text As String, to_text As String)
    Const MIN_ASC = 32  ' Space.
    Const MAX_ASC = 126 ' ~.
    Const NUM_ASC = MAX_ASC - MIN_ASC + 1
    
    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)
            If ch < 0 Then ch = ch + NUM_ASC
            ch = ch + MIN_ASC
            to_text = to_text & Chr$(ch)
        End If
    Next i
    
End Sub

' 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