modencryption.bas

MD5加解密源码

Attribute VB_Name = "modEncryption"
'Coded by Tim Cinel, 15 Oct 2003
'This module is an example of some low-level encryption.

'Remember, when encrypting, we need a way to get our original message back
'so do not ever use Rnd (Random Function). I suggest using a Calculated
'Random Number generater that requires an input.

Function Encrypt(strPassword As String, strInput As String) As String
    Dim PasswordVal As Long, CurrentChar As Long, CurrentMod As Long
    
    'Lets turn our password into a number! Yippee!
    PasswordVal = GetPasswordValue(strPassword)
    
    'CurrentMod will makes it difficult to recognise when we use the same character more than once.
    CurrentMod = 2
    
    For i = 1 To Len(strInput)
        CurrentChar = Asc(Mid(strInput, i, 1))
        'Set currentchar as the ASCII value of the the character being encrypted
        CurrentChar = CurrentChar + PasswordVal
        
        'CurrentMod is passed into CalculateSeed - See that function for more details.
        CurrentChar = CurrentChar - CalculateSeed(CLng(CurrentMod))
                
        CurrentChar = WrapNumber(CurrentChar, 0, 255)
        
        Encrypt = Encrypt & Chr(CurrentChar)
        
        CurrentMod = CurrentMod + 1
        If CurrentMod > 30 Then CurrentMod = 2
    Next i
End Function

Function Decrypt(strPassword As String, strInput As String) As String
    Dim PasswordVal As Long, CurrentChar As Long, CurrentMod As Long
    
    'Lets turn our password into a number! Yippee!
    PasswordVal = GetPasswordValue(strPassword)
    CurrentMod = 2
    
    For i = 1 To Len(strInput)
        CurrentChar = Asc(Mid(strInput, i, 1))
        'Set currentchar as the ASCII value of the the character being encrypted
        CurrentChar = CurrentChar - PasswordVal
        
        'CurrentMod is passed into CalculateSeed - See that function for more details.
        CurrentChar = CurrentChar + CalculateSeed(CLng(CurrentMod))
        
        'We need to make sure that CurrentChar ends up being between 0 and 255, so we wrap it!
        CurrentChar = WrapNumber(CurrentChar, 0, 255)
        
        Decrypt = Decrypt & Chr(CurrentChar)
        
        'Add 1 to CurrentMod (For calculated randomization)
        CurrentMod = CurrentMod + 1
        If CurrentMod > 30 Then CurrentMod = 2
    Next i
End Function

Private Function GetPasswordValue(strPassword As String) As Long
    Dim ASCII_Vals As Long
    
    For i = 1 To Len(strPassword)
        'We need to add up all the ASCII values from all the characters
        ASCII_Vals = ASCII_Vals + Asc(Mid(strPassword, i, 1))
    Next i
    
    If ASCII_Vals > Len(strPassword) Then
        'Divide the Calculated Random Number (CRN) of ASCII_Vals by the CRN of the length of the password.
        GetPasswordValue = Int(CalculateSeed(ASCII_Vals) / CalculateSeed(Len(strPassword) + 1))
    Else
        'We would end up with 0 if we divided, so we aint gonna divide!
        'We will just use the CRN ASCII_Vals produces.
        GetPasswordValue = CalculateSeed(ASCII_Vals)
    End If
    
End Function

Private Function CalculateSeed(InputNumber As Long) As Long
    'This functions pretty much makes the InputNumber appear to become a totally random
    'number, but unke using rnd (Random Function) this will always return the same number
    'as long as you enter the same number.
    
    'Log and Cos are just Maths functions
    
    CalculateSeed = Int(Log(InputNumber) * Cos(InputNumber) * 137)
End Function

Private Function WrapNumber(lngNumber As Long, lngMinimum As Long, lngMaximum As Long) As Long
    Dim Range As Long
    Range = lngMaximum - lngMinimum
    'This function 'wraps' numbers.
    'If u want a number to be in a certain range (say between 0 and 255)
    'this funciton will make any number fit into that range!
     WrapNumber = lngNumber
     
     If lngNumber > lngMaximum Then
        Do Until WrapNumber <= lngMaximum
            WrapNumber = WrapNumber - Range
        Loop
     ElseIf lngNumber < lngMinimum Then
        Do Until WrapNumber >= lngMinimum
            WrapNumber = WrapNumber + Range
        Loop
     End If
    
End Function