KeyReg

Public Function GenerateKey(ByVal Name As String) As String
Dim lPart1 As Long
Dim lPart2 As Long
Dim ch As Long
Dim i As Long
Dim n As Long
'Name is trimmed and restricted to 40

Name = Trim$(Name)
Name = Mid$(Name, 1, 40)
If Len(Name) = 0 Then
Exit Function
End If
'The key is made up of two parts, both 4digit hex values

'Part1 is quite tricky

For i = 1 To Len(Name)
ch = Asc(Mid$(Name, i, 1)) * &H100
'Run through the calculations 8 times for each character

For n = 1 To 8
'Do different things based on the result of this wierd if

If (((ch Xor lPart1) Mod &H10000) And &H8000&) = 0 Then
'Bit shift 1 bit left

lPart1 = lPart1 And &HFFFFFFF
lPart1 = lPart1 * 2
Else
'Bit shift 1 bit left

lPart1 = lPart1 And &HFFFFFFF
lPart1 = lPart1 * 2
'Xor with the magic number

lPart1 = lPart1 Xor &H1021&
End If
ch = ch * 2
Next n
Next i
'Add a bit for luck

lPart1 = lPart1 + &He'&
'Only want 4 digits

lPart1 = lPart1 Mod &H10000
'Part2 is very simple

For i = 1 To Len(Name)
lPart2 = lPart2 + (Asc(Mid$(Name, i, 1)) * (i - 1))
Next i
'Build up from 2 parts (making sure eachpart is 4 digits)

GenerateKey = String$(4 - Len(CStr(Hex(lPart1))), "0") _
& CStr(Hex(lPart1)) _
& String$(4 - Len(CStr(Hex(lPart2))), "0") _
& CStr(Hex(lPart2))
End Function