About This Code
Brief Description:
Simple Encryption with Hexkey for Passwords
Contributor:
Gernot Hummer
Last Modified:
16 Sep 2004
OpenNTF Disclaimer
All of the program code and information presented in the OpenNTF.org Code Bin are provided "as-is", and should be used at your own risk. OpenNTF.org make no express or implied warranty about anything in the Code Bin, and OpenNTF.org will not be responsible or liable for any damage caused by the use or misuse of anything from this site. OpenNTF.org makes no guarantees about anything. Please thoroughly test all of the knowledge and code you find here before you attempt to use them in your production environment.
Code / Description
'### (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
Usage / Example
A small LotusScript Library that provides a simple mechanism for Encryption based on a hexadecimal key - functionality reduced to letters, capital letters and numbers.
I didn't find the time to make the script library include special characters or spaces since I only needed to encrypt passwords. Still should work fine for the latter.
Code Attachments