I wrote another hashing method, and this time its rather decent, IMO. Comment, if thou dare! =)
Option Explicit
Private Const Alphabet = "3412785609PLMZAQWSXMKONJIEDCVFRBUHTFCVGY"
Public Function Hash(S As String) As String
Dim Ret As String, Ret2 As String, i As Byte, V1 As Byte, V2 As Byte
P1: For i = 1 To Len(S)
Let V1 = Asc(Mid(S, i, 1)) Mod 34
Let V2 = Int(Asc(Mid(S, i, 1)) / 34)
Let Ret = Ret & Chr((V1 + V2) Mod 128)
Next i
P2: For i = 1 To Len(Ret) Step 2
If Len(Ret) < i + 1 Then GoTo P3
Let V1 = Asc(Mid(Ret, i, 1))
Let V2 = Asc(Mid(Ret, i + 1, 1))
Ret2 = Ret2 & Chr(V1 + V2)
Next i
P3: Let Ret = Ret2: Let Ret2 = vbNullString
For i = 1 To Len(Ret)
Let V1 = Asc(Mid(S, i, 1)) Mod 34
Let V2 = Int(Asc(Mid(S, i, 1)) / 34)
Let Ret2 = Ret2 & Chr(V1) & Chr(V2)
Next i
Let Hash = MakeReadable(Pad(Ret2))
End Function
Private Function Pad(S As String) As String
Randomize: Dim i As Byte, Padding As String
For i = 1 To 128
Let Padding = Padding & Chr(i + 127)
Next i
Let Pad = Left(S & Padding, 128)
End Function
Private Function MakeReadable(Data As String) As String
Dim Ret As String, i As Integer
For i = 1 To Len(Data)
Let Ret = Ret & Mid(Alphabet, Val(Asc(Mid(Data, i, 1)) Mod Len(Alphabet)) + 1, 1)
Next i
Let MakeReadable = Ret
End Function
Hash("joetheodd")
0000: 37 32 39 32 48 31 41 32 30 39 50 4C 4D 5A 41 51 7292H1A209PLMZAQ
0010: 57 53 58 4D 4B 4F 4E 4A 49 45 44 43 56 46 52 42 WSXMKONJIEDCVFRB
0020: 55 48 54 46 43 56 47 59 33 34 31 32 37 38 35 36 UHTFCVGY34127856
0030: 30 39 50 4C 4D 5A 41 51 57 53 58 4D 4B 4F 4E 4A 09PLMZAQWSXMKONJ
0040: 49 45 44 43 56 46 52 42 55 48 54 46 43 56 47 59 IEDCVFRBUHTFCVGY
0050: 33 34 31 32 37 38 35 36 30 39 50 4C 4D 5A 41 51 3412785609PLMZAQ
0060: 57 53 58 4D 4B 4F 4E 4A 49 45 44 43 56 46 52 42 WSXMKONJIEDCVFRB
0070: 55 48 54 46 43 56 47 59 33 34 31 32 37 38 35 36 UHTFCVGY34127856
EDIT -
And if you want to send this over a network, you can hash to DWORD[32]. I suppose inserting the normal hash as a Non-NTString works too, but thats beside the point. =)
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal numBytes As Long)
Public Function HashAsDWORD(S As String) As Long()
Dim Hashed As String: Let Hashed = Hash(S)
Dim Ret(32) As Long
For i = 1 To 128 Step 4
Ret(i) = GetDWORD(Mid(Hashed, i, 4))
Next i
Let HashAsDWORD = Ret
End Function
Public Function GetDWORD(Data As String) As Long
Dim lReturn As Long
Call CopyMemory(lReturn, ByVal Data, 4)
GetDWORD = lReturn
End Function