jwcolby
jwcolby at colbyconsulting.com
Fri Apr 29 10:00:07 CDT 2011
Thanks to Gustav. this is encryption, not hashing.
Option Compare Database
Option Explicit
' PC1 Cipher 128-bit key
' (c) Alexander Pukall 1991
' Can be used freely even for commercial applications
'
' MS Access 97 version by
' Gustav Brock, Cactus Data ApS
' gustav at cactus.dk
'
' 2002-03-09. V1.0
' Initial port from Visual Basic.
' 2002-06-23. V1.1
' Code clean up and constants added.
' Redundant code removed.
' Modified to fully comply with VB datatypes.
' Modified to not crash for certain passwords.
' Modified for high speed conversion of long strings ( > 32K).
' 2002-06-24. V1.2
' Functions added for en/decrypting to/from binary strings.
' Usage:
' SetPassword(password) sets password prior to en/decryption.
' GetPassword() retrieves current password.
' StrEncrypt(DecryptedString) returns encrypted ascii string.
' StrDecrypt(EncryptedString_ascii) returns decrypted string.
' StrEncryptBin(DecryptedString) returns encrypted binary string.
' StrDecryptBin(EncryptedString_binary) returns decrypted string.
'
' Encrypted ascii string is twice the length of the decrypted string.
' Encrypted ascii string contains low ascii chars from a to p only.
' Encrypted binary string is same length as the decrypted string.
' Encrypted binary string may contain any char including Chr(0).
' Password may contain any ascii char including Chr(0).
' Password is maintained in global variable strPC1Password16.
Private Const clngHexMax As Long = &H10
Private Const clngBytMax As Long = &H100
' Maximum value of unsigned Integer.
Private Const clngIntMax As Long = &H10000
' clngAscMin defines beginning of a 16 letter range from a to p.
Private Const clngAscMin As Long = &H61
Private strPC1Password16 As String * clngHexMax
Private x1a0(9) As Long
Private cle(17) As Long
Private x1a2 As Long
Private lngInt As Long
Private lngRes As Long
Private lngTmp As Long
Private ax As Long
Private bx As Long
Private cx As Long
Private dx As Long
Private si As Long
Private i As Long
Private c As Long
Private d As Long
Private e As Long
Private strEncrypted As String
Private strDecrypted As String
Public Function SetPassword(ByRef strPassword As String) As Integer
Dim intPasswordLength As Integer
' Remove leading and trailing spaces from password.
strPassword = Trim(strPassword)
' Set global variable and limit password to fixed length of 16 characters.
strPC1Password16 = strPassword
' Find and return net length of password.
intPasswordLength = Len(strPassword)
SetPassword = intPasswordLength
End Function
Public Function GetPassword() As String
' Get global variable strPC1Password16.
GetPassword = RTrim(strPC1Password16)
End Function
Public Function StrEncrypt(ByVal strInput As String) As String
strDecrypted = strInput
Call Encrypt(False)
StrEncrypt = strEncrypted
End Function
Public Function StrDecrypt(ByVal strInput As String) As String
strEncrypted = strInput
Call Decrypt(False)
StrDecrypt = strDecrypted
End Function
Public Function StrEncryptBin(ByVal strInput As String) As String
strDecrypted = strInput
Call Encrypt(True)
StrEncryptBin = strEncrypted
End Function
Public Function StrDecryptBin(ByVal strInput As String) As String
strEncrypted = strInput
Call Decrypt(True)
StrDecryptBin = strDecrypted
End Function
Private Sub Encrypt(ByVal booBinary As Boolean)
Dim strX As String
Dim lngC As Long
Dim lngD As Long
Dim lngM As Long
Dim lngN As Long
Dim lngX As Long
si = 0
x1a2 = 0
i = 0
strX = strDecrypted
lngX = Len(strX)
strEncrypted = Space(lngX * (2 - Abs(booBinary)))
For lngN = 1 To clngHexMax
cle(lngN) = Asc(mID(strPC1Password16, lngN, 1))
Next lngN
For lngN = 1 To lngX
c = Asc(mID(strX, lngN, 1))
' Calculate lngInt.
Call Assemble
lngC = lngInt \ clngBytMax
lngD = lngInt Mod clngBytMax
For lngM = 1 To clngHexMax
cle(lngM) = cle(lngM) Xor c
Next lngM
c = c Xor (lngC Xor lngD)
If booBinary = False Then
' Build ascii string.
d = (c \ clngHexMax) Mod clngHexMax
e = c Mod clngHexMax
' clngAscMin + d gives one letter range from a to p for the 4 high bits of c.
' clngAscMin + e gives one letter range from a to p for the 4 low bits of c.
' Perform high speed insertion of encrypted character.
Mid(strEncrypted, (lngN * 2) - 1, 1) = Chr(clngAscMin + d)
Mid(strEncrypted, (lngN * 2) - 0, 1) = Chr(clngAscMin + e)
Else
' Build binary string.
' Perform high speed insertion of encrypted character.
Mid(strEncrypted, lngN, 1) = Chr(c)
End If
Next lngN
End Sub
Private Sub Decrypt(ByVal booBinary As Boolean)
Dim strX As String
Dim lngC As Long
Dim lngD As Long
Dim lngM As Long
Dim lngN As Long
Dim lngX As Long
si = 0
x1a2 = 0
i = 0
strX = strEncrypted
lngX = Len(strX) \ (2 - Abs(booBinary))
strDecrypted = Space(lngX)
For lngN = 1 To clngHexMax
cle(lngN) = Asc(mID(strPC1Password16, lngN, 1))
Next lngN
For lngN = 1 To lngX
If booBinary = False Then
d = Asc(mID(strX, (lngN * 2) - 1, 1))
If d >= clngAscMin Then
' Transform the letter to the 4 high bits of c.
d = d - clngAscMin
If d < clngHexMax Then
d = d * clngHexMax
End If
End If
e = Asc(mID(strX, (lngN * 2) - 0, 1))
If e >= clngAscMin Then
' Transform the letter to the 4 low bits of c.
e = e - clngAscMin
If e < clngHexMax Then
c = d + e
End If
End If
Else
c = Asc(mID(strX, lngN, 1))
End If
' Calculate lngInt.
Call Assemble
lngC = (lngInt \ clngBytMax) Mod clngBytMax
lngD = lngInt Mod clngBytMax
c = c Xor (lngC Xor lngD)
For lngM = 1 To clngHexMax
cle(lngM) = cle(lngM) Xor c
Next lngM
' Perform high speed insertion of decrypted character.
Mid(strDecrypted, lngN, 1) = Chr(c)
Next lngN
End Sub
Private Sub Assemble()
Dim lngM As Long
Dim lngN As Long
x1a0(0) = ((cle(1) * clngBytMax) + cle(2)) Mod clngIntMax
Call Code
lngInt = lngRes
For lngM = 1 To (clngHexMax / 2) - 1
lngN = lngM * 2
x1a0(lngM) = x1a0(lngM - 1) Xor ((cle(lngN + 1) * clngBytMax) + cle(lngN + 2))
Call Code
lngInt = lngInt Xor lngRes
Next lngM
i = 0
End Sub
Private Sub Code()
Const clngKeyB As Long = &H4E35
Const clngKeyC As Long = &H15A
dx = (x1a2 + i) Mod clngIntMax
ax = x1a0(i)
cx = clngKeyC
bx = clngKeyB
lngTmp = ax
ax = si
si = lngTmp
lngTmp = ax
ax = dx
dx = lngTmp
If (ax <> 0) Then
ax = ((ax Mod clngIntMax) * (bx Mod clngIntMax)) Mod clngIntMax
End If
lngTmp = ax
ax = cx
cx = lngTmp
If (ax <> 0) Then
ax = ((ax Mod clngIntMax) * (si Mod clngIntMax)) Mod clngIntMax
cx = (ax + cx) Mod clngIntMax
End If
lngTmp = ax
ax = si
si = lngTmp
ax = ((ax Mod clngIntMax) * (bx Mod clngIntMax)) Mod clngIntMax
dx = (cx + dx) Mod clngIntMax
ax = ax + 1
x1a2 = dx
x1a0(i) = ax
lngRes = ax Xor dx
i = i + 1
End Sub
John W. Colby
www.ColbyConsulting.com
On 4/28/2011 5:21 PM, Asger Blond wrote:
> How do you create the hash - any generator to recommend?
> Asger