'### (c) Gernot Hummer, 2004
Const ENCRYPTION_KEY = "1234567890ABCDEF1234567890ABCDEF1234567890ABCDEF12"
Dim pwstrings List As String
Function Encrypt( PasswordClear As String )
'Function returns encrypted string.
Dim encryptedarray List As String
Dim pwarray List As String
Dim hexvalue As String
Dim decvalue As Integer
Dim i As Integer
i = 0
Call GeneratePasswordArray ( PasswordClear )
Forall character In pwstrings
hexvalue = "&H" & GetTransposeSegment( i )
decvalue = Cint( hexvalue )
encryptedarray( i ) = Chr( SwapCodeTable( Asc( character ) + decvalue ) )
i = i + 1
End Forall
Encrypt = ArrayBackToString( encryptedarray )
Erase pwstrings
End Function
Function Decrypt( PasswordEncrypted As String )
'Function returns decrypted string.
Dim encryptedarray List As String
Dim hexvalue As String
Dim decvalue As Integer
Dim i As Integer
i = 0
Call GeneratePasswordArray ( PasswordEncrypted )
Forall character In pwstrings
hexvalue = "&H" & GetTransposeSegment( i )
decvalue = Cint( hexvalue )
encryptedarray( i ) = Chr( SwapCodeTable( Asc( character ) - decvalue ) )
i = i + 1
End Forall
Decrypt = ArrayBackToString( encryptedarray )
Erase pwstrings
End Function
Function GeneratePasswordArray( Password As String )
'Function returns an array with all characters of the password string.
Dim i As Integer
i = 0
For i = 1 To Len( Password )
pwstrings( i ) = Mid( Password, i , 1 )
Next i
GeneratePasswordArray = pwstrings
End Function
Function ArrayBackToString( PasswordArray List As String )
'Function returns a string consisting of all characters in the array.
Dim pwstring As String
Forall character In PasswordArray
pwstring = pwstring + character
End Forall
ArrayBackToString = pwstring
End Function
Function GetTransposeSegment( i As Integer )
'Function returns the element of the PASSWORD_KEY on position i.
'If i is greater than the length of the key, the last element of the key will be returned.
If i < Len( ENCRYPTION_KEY ) - 1 Then
GetTransposeSegment = Mid( Cstr( ENCRYPTION_KEY ), i + 1, 1 )
Else
GetTransposeSegment = Mid( Cstr( ENCRYPTION_KEY ), 50, 1 )
End If
End Function
Function SwapCodeTable( i As Integer )
'Function ensures, that only valid ascii-codes are used.
If i > 122 Then
SwapCodeTable = i - 75
Elseif i < 48 Then
SwapCodeTable = i + 75
Else
SwapCodeTable = i
End If
End Function
|