Hi
Firstly  great credit to the authors.
I wanted this functionality from SQL Server  so I decided to try and convert the VB to VBScript.
I had problems with data types as VB Script only has the Variant data type, but after some work I know have it working and you can just pass the parameters to the VBS script and it will output the desired licence code.
Here is an example usage from the command line:
C:\>cscript getlicencecode.vbs richard.briggs@leansoftware.net EDT
I can't see how to attach a file here so here is the VBScript (Copy and save as getlicencecode.vbs file)
Option Explicit
Private Const OFFSET_4 = 4294967296Private Const MAXINT_4 = 2147483647
Private StatePrivate ByteCounter Private ByteBuffer()Private Const S11 = 7
Private Const S12 = 12
Private Const S13 = 17
Private Const S14 = 22
Private Const S21 = 5
Private Const S22 = 9
Private Const S23 = 14
Private Const S24 = 20
Private Const S31 = 4
Private Const S32 = 11
Private Const S33 = 16
Private Const S34 = 23
Private Const S41 = 6
Private Const S42 = 10
Private Const S43 = 15
Private Const S44 = 21
Set args = WScript.Arguments
State = Array(cdbl(1),cdbl(1),cdbl(1),cdbl(1),cdbl(1))
for i = 1 to 64
redim preserve ByteBuffer(i) ByteBuffer(i) = cbyte(0)
next
Dim Email, App, args,ans,i
Email = args.Item(0)
App = args.Item(1)
ans = FormatKeyCode(GenKeyString(Email,App, 0),5)
Wscript.Echo ans
Public Function GenKeyString(ByVal UserName, ProdName , F_Code )
Dim TempStr Dim KeyStr Dim KeyVal Dim CodeVal Dim CodeLow Dim CodeHigh Dim KeyLowV1 Dim KeyLowV2 Dim KeyLow1
Dim KeyLow2
Dim ChrV1
Dim ChrV2
TempStr = LCase(UserName) & LCase(ProdName)
KeyStr = DigestStrToHexStr(TempStr)
KeyVal = HexStrToBinStr(KeyStr)
CodeVal = F_Code And &HFFFF
CodeLow = CodeVal And &HFF
CodeHigh = (((CodeVal And &HFF00) / 256) And &HFF)
KeyLow1 = Mid(KeyVal, Len(KeyVal), 1)
KeyLow2 = Mid(KeyVal, Len(KeyVal)  1, 1)
KeyLowV1 = Asc(KeyLow1)
KeyLowV2 = Asc(KeyLow2)
KeyLowV1 = (KeyLowV1 Xor CodeLow)
KeyLowV2 = (KeyLowV2 Xor CodeHigh)
ChrV1 = Chr(KeyLowV1)
ChrV2 = Chr(KeyLowV2)
KeyVal = Mid(KeyVal, 1, Len(KeyVal)  2)
KeyVal = KeyVal & ChrV2 & ChrV1
KeyVal = Mid(KeyVal, 3, Len(KeyVal)  2)
dim RawChk
RawChk = DigestStrToHexStr(KeyVal)
dim rc1, rc2
RC1 = Mid(RawChk, 1, 2)
RC2 = Mid(RawChk, Len(RawChk)  1, 2)
dim StubStr
StubStr = BinStrToHexStr(KeyVal)
GenKeyString = RC1 & RC2 & StubStr
End Function
Public Function ValidateKeyCode(ByVal KeyCode, UserName, ProjName ) Dim ActiveBytes Dim LUNameHash Dim LUName Dim ValidKey Dim KeyMD5 Dim KeySig
ValidKey = False
If Len(KeyCode) = 32 Then
BinKeyCode = HexStrToBinStr(KeyCode)
ActiveBytes = Right(BinKeyCode, 14)
KeyMD5 = DigestStrToHexStr(ActiveBytes)
ValidSig = Left(KeyMD5, 2) & Right(KeyMD5, 2)
KeySig = Left(KeyCode, 4)
If KeySig = ValidSig Then
ValidKey = True
Else
ValidKey = False
End If
If ValidKey Then
LUName = LCase(UserName) & LCase(ProjName)
LUNameHash = DigestStrToHexStr(LUName)
ActiveBytes = Mid(KeyCode, 5, 24)
LUNameHash = Mid(LUNameHash, 5, 24)
If ActiveBytes = LUNameHash Then
ValidKey = True
Else
ValidKey = False
End If
End If
Else
ValidKey = False
End If
ValidateKeyCode = ValidKey
End Function
Public Function ExtractKeyFBits(ByVal KeyCode, UserName, ProjName )
Dim PermVal Dim RealHash Dim LUser Dim Perms Dim BinCodePerm Dim BinUHashPerm Dim HiCodePerm Dim HIUMask Dim LoUMask Dim HiPerm Dim LoPerm
PermVal = 0
If ValidateKeyCode(KeyCode, UserName, ProjName) Then
LUser = LCase(UserName) & LCase(ProjName)
UserHash = DigestStrToHexStr(LUser)
KCodedPerm = Right(KeyCode, 4)
UHashPerm = Right(UserHash, 4)
BinCodePerm = HexStrToBinStr(KCodedPerm)
BinUHashPerm = HexStrToBinStr(UHashPerm)
HiCodePerm = Asc(Mid(BinCodePerm, 1, 1))
LoCodePerm = Asc(Mid(BinCodePerm, 2, 1))
HIUMask = Asc(Mid(BinUHashPerm, 1, 1))
LoUMask = Asc(Mid(BinUHashPerm, 2, 1))
HiPerm = HiCodePerm Xor HIUMask
LoPerm = LoCodePerm Xor LoUMask
PermVal = (HiPerm * 256) Or LoPerm
Else
PermVal = 0
End If
ExtractKeyFBits = PermVal
End Function
Public Function FormatKeyCode(ByVal StrIn , ByVal GrpLen )
Dim StrLen Dim CurGrp Dim OutStr Dim GrpStr Dim GrpStart
StrLen = Len(StrIn)
dim strGroups, StrLeftOver
strGroups = Int(StrLen / GrpLen)
StrLeftOver = StrLen Mod GrpLen
For CurGrp = 0 To (strGroups  1)
GrpStart = (CurGrp * GrpLen) + 1
GrpStr = Mid(StrIn, GrpStart, GrpLen)
If CurGrp > 0 Then
OutStr = OutStr & "" & GrpStr
Else
OutStr = OutStr & GrpStr
End If
Next
If StrLeftOver > 0 Then
OutStr = OutStr & "" & Right(StrIn, StrLeftOver)
End If
FormatKeyCode = OutStr
End Function
Const B32Map = "0123456789ABCDEFGHJKLMNPRSTVWXYZ"
Public Function RemoveDashes(ByVal StrIn ) RemoveDashes = Replace(StrIn, "", "")
End Function
Public Function ShiftStrLeft(ByVal StrIn , ByVal Bits ) Dim CurPos Dim WorkStr Dim RetStr Dim CurByteVal Dim BitMask Dim InvMask Dim ShiftBits Dim WholeBytes Dim LeftPart Dim RightPart Dim Carry Dim PrevChar Dim TrimMask
WholeBytes = Int(Bits / 8)
ShiftBits = Bits Mod 8
BitMask = 255  (2 ^ (8  ShiftBits)  1)
InvMask = Not (BitMask)
TrimMask = (2 ^ ShiftBits)  1
CurPos = 1
StrLen = Len(StrIn)
StrBits = StrLen * 8
WorkStr = StrIn
If (StrBits > Bits) Then
If (WholeBytes > 0) Then
WorkStr = Right(WorkStr, StrLen  WholeBytes)
For CurPos = 1 To WholeBytes
WorkStr = WorkStr & Chr(0)
Next
RetStr = WorkStr
End If
If (ShiftBits > 0) Then
For CurPos = 1 To Len(WorkStr)
CurByteVal = Asc(Mid(WorkStr, CurPos, 1))
LeftPart = (CurByteVal And BitMask) And &HFF
RightPart = (CurByteVal And InvMask) And &HFF
LeftPart = Int(LeftPart / (2 ^ (8  ShiftBits)))
RightPart = (RightPart * (2 ^ ShiftBits))
If CurPos = 1 Then
PrevChar = (RightPart)
RetStr = ""
Else
PrevChar = PrevChar Or LeftPart
RetStr = RetStr & Chr(PrevChar)
PrevChar = RightPart
End If
Next
PrevChar = (PrevChar Or (LeftPart And Not (TrimMask)))
RetStr = RetStr & Chr(PrevChar)
End If
Else
For CurPos = 1 To StrLen
RetStr = RetStr & Chr(0)
Next End If
ShiftStrLeft = RetStr
End Function
Public Function ShiftStrRight(ByVal StrIn , ByVal Bits ) Dim CurPos Dim WorkStr Dim RetStr Dim CurByteVal Dim BitMask Dim InvMask Dim ShiftBits Dim WholeBytes Dim LeftPart Dim RightPart Dim Carry Dim PrevChar Dim TrimMask
WholeBytes = Int(Bits / 8)
ShiftBits = Bits Mod 8
BitMask = 255  ((2 ^ ShiftBits)  1)
InvMask = Not (BitMask)
TrimMask = (2 ^ ShiftBits)  1
CurPos = 1
StrLen = Len(StrIn)
StrBits = StrLen * 8
WorkStr = StrIn
If (StrBits > Bits) Then
If (WholeBytes > 0) Then
WorkStr = Left(WorkStr, StrLen  WholeBytes)
For CurPos = 1 To WholeBytes
WorkStr = Chr(0) & WorkStr
Next
RetStr = WorkStr
End If
If (ShiftBits > 0) Then
RetStr = ""
For CurPos = Len(WorkStr) To 1 Step 1
CurByteVal = Asc(Mid(WorkStr, CurPos, 1))
LeftPart = CurByteVal And BitMask
LeftPart = LeftPart / (2 ^ ShiftBits)
RightPart = CurByteVal And InvMask
RightPart = RightPart * (2 ^ (8  ShiftBits))
If CurPos = Len(WorkStr) Then
Carry = LeftPart
Else
CurByteVal = RightPart Or Carry
Carry = LeftPart
RetStr = Chr(CurByteVal) & RetStr
End If
Next
RetStr = Chr(Carry) & RetStr
End If
Else
For CurPos = 1 To StrLen
RetStr = RetStr & Chr(0)
Next End If
ShiftStrRight = RetStr
End Function
Public Function Base32Enc(ByVal StrIn ) Dim CurBit Dim Mask32 Dim CurPos Dim CurVal Dim StrBits Dim BitsProc Dim WorkStr Dim RetStr Dim CurConv
RetStr = ""
WorkStr = StrIn
StrBits = Len(StrIn) * 8
strGroups = Int(StrBits / 5)
If (StrBits Mod 5) <> 0 Then strGroups = strGroups + 1
StrChar = Len(StrIn)
BitsProc = 0
Mask32 = &H1F
For CurPos = 1 To strGroups
CurVal = Asc(Mid(WorkStr, Len(WorkStr), 1))
CurVal = (CurVal And Mask32) + 1
CurConv = Mid(B32Map, CurVal, 1)
WorkStr = ShiftStrRight(WorkStr, 5)
RetStr = CurConv & RetStr
Next
Base32Enc = RetStr
End Function
Public Function Base32Dec(ByVal StrIn ) Dim CurPos Dim CurVal Dim CurChr Dim RetStr Dim WorkStr Dim Carry Dim CarryMask Dim CurMask Dim ThisVal Dim ThisChar Dim ShiftBits Dim OutBytes Dim InBits
BitsProc = 0
BaseMask = &H1F
Carry = 0
WorkStr = StrIn
InBits = Len(StrIn) * 5
OutBytes = Int(InBits / 8)
For CurPos = 1 To OutBytes
RetStr = RetStr & Chr(0)
Next
For CurPos = 1 To Len(StrIn)
CurChr = Mid(WorkStr, CurPos, 1)
CurVal = InStr(1, B32Map, CurChr)
CurVal = CurVal  1
RetStr = ShiftStrLeft(RetStr, 5)
ThisChar = Mid(RetStr, Len(RetStr), 1)
RetStr = Left(RetStr, Len(RetStr)  1)
ThisVal = Asc(ThisChar)
ThisVal = ThisVal Or CurVal
ThisChar = Chr(ThisVal)
RetStr = RetStr & ThisChar
Next
Base32Dec = RetStr
End Function
Public Function HexStrToBinStr(ByVal StrIn ) Dim StrOut Dim Ch Dim HexByte Dim ByteVal Dim ByteCh
StrOut = ""
For Ch = 1 To Len(StrIn) Step 2
HexByte = Mid(StrIn, Ch, 2)
ByteVal = cint("&H" & HexByte)
ByteCh = Chr(ByteVal)
StrOut = StrOut & ByteCh
Next
HexStrToBinStr = StrOut
End Function
Public Function BinStrToHexStr(ByVal StrIn ) Dim StrOut Dim Ch Dim HexByte Dim HexChr
StrOut = ""
For Ch = 1 To Len(StrIn)
HexByte = Mid(StrIn, Ch, 1)
HexChr = Hex(Asc(HexByte))
If Len(HexChr) = 1 Then HexChr = "0" & HexChr
StrOut = StrOut & HexChr
Next
BinStrToHexStr = StrOut
End Function
Function RegisterA() RegisterA = State(1)
End function
Function RegisterB() RegisterB = State(2)
End function
Function RegisterC() RegisterC = State(3)
End function
Function RegisterD() RegisterD = State(4)
End function
Public Function DigestStrToHexStr(SourceString ) MD5Init
MD5Update Len(SourceString), StringToArray(SourceString)
MD5Final
DigestStrToHexStr = GetValues
End Function
Private Function StringToArray(InString ) Dim i dim bytBuffer() ReDim bytBuffer(Len(InString))
For i = 0 To Len(InString)  1
bytBuffer(i) = Asc(Mid(InString, i + 1, 1))
Next StringToArray = bytBuffer
End Function
Public Function GetValues() GetValues = LongToString(State(1)) & LongToString(State(2)) & LongToString(State(3)) & LongToString(State(4))
End Function
Private Function LongToString(Num) Dim A dim B dim C dim D A = Num And &HFF&
If A < 16 Then LongToString = "0" & Hex(A) Else LongToString = Hex(A)
B = (Num And &HFF00&) \ 256
If B < 16 Then LongToString = LongToString & "0" & Hex(B) Else LongToString = LongToString & Hex(B)
C = (Num And &HFF0000) \ 65536
If C < 16 Then LongToString = LongToString & "0" & Hex(C) Else LongToString = LongToString & Hex(C)
If Num < 0 Then D = ((Num And &H7F000000) \ 16777216) Or &H80& Else D = (Num And &HFF000000) \ 16777216
If D < 16 Then LongToString = LongToString & "0" & Hex(D) Else LongToString = LongToString & Hex(D)
End Function
Public Sub MD5Init()
ByteCounter = 0
State(1) = UnsignedToLong(cDbl(1732584193))
State(2) = UnsignedToLong(cDbl(4023233417))
State(3) = UnsignedToLong(cDbl(2562383102))
State(4) = UnsignedToLong(cdbl(271733878))
End Sub
Public Sub MD5Final()
Dim dblBits dim padding(72) dim lngBytesBuffered padding(0) = &H80
dblBits = ByteCounter * 8
lngBytesBuffered = ByteCounter Mod 64
If lngBytesBuffered <= 56 Then MD5Update 56  lngBytesBuffered, padding Else MD5Update 120  ByteCounter, padding
padding(0) = UnsignedToLong(dblBits) And &HFF&
padding(1) = UnsignedToLong(dblBits) \ 256 And &HFF&
padding(2) = UnsignedToLong(dblBits) \ 65536 And &HFF&
padding(3) = UnsignedToLong(dblBits) \ 16777216 And &HFF&
padding(4) = 0
padding(5) = 0
padding(6) = 0
padding(7) = 0
MD5Update 8, padding
End Sub
Public Sub MD5Update(InputLen , InputBuffer() )
Dim II dim i dim J dim K dim lngBufferedBytes dim lngBufferRemaining dim lngRem
lngBufferedBytes = ByteCounter Mod 64
lngBufferRemaining = 64  lngBufferedBytes
ByteCounter = ByteCounter + InputLen
If InputLen >= lngBufferRemaining Then
For II = 0 To lngBufferRemaining  1
ByteBuffer(lngBufferedBytes + II) = InputBuffer(II)
Next MD5Transform ByteBuffer
lngRem = (InputLen) Mod 64
For i = lngBufferRemaining To InputLen  II  lngRem Step 64
For J = 0 To 63
ByteBuffer(J) = InputBuffer(i + J)
Next MD5Transform ByteBuffer
Next lngBufferedBytes = 0
Else
i = 0
End If
For K = 0 To InputLen  i  1
ByteBuffer(lngBufferedBytes + K) = InputBuffer(i + K)
Next End Sub
Private Sub MD5Transform(Buffer() )
Dim X(16) dim A dim B dim C dim D
A = State(1)
B = State(2)
C = State(3)
D = State(4)
Decode 64, X, Buffer
FF A, B, C, D, X(0), S11, 680876936
FF D, A, B, C, X(1), S12, 389564586
FF C, D, A, B, X(2), S13, 606105819
FF B, C, D, A, X(3), S14, 1044525330
FF A, B, C, D, X(4), S11, 176418897
FF D, A, B, C, X(5), S12, 1200080426
FF C, D, A, B, X(6), S13, 1473231341
FF B, C, D, A, X(7), S14, 45705983
FF A, B, C, D, X(8), S11, 1770035416
FF D, A, B, C, X(9), S12, 1958414417
FF C, D, A, B, X(10), S13, 42063
FF B, C, D, A, X(11), S14, 1990404162
FF A, B, C, D, X(12), S11, 1804603682
FF D, A, B, C, X(13), S12, 40341101
FF C, D, A, B, X(14), S13, 1502002290
FF B, C, D, A, X(15), S14, 1236535329
GG A, B, C, D, X(1), S21, 165796510
GG D, A, B, C, X(6), S22, 1069501632
GG C, D, A, B, X(11), S23, 643717713
GG B, C, D, A, X(0), S24, 373897302
GG A, B, C, D, X(5), S21, 701558691
GG D, A, B, C, X(10), S22, 38016083
GG C, D, A, B, X(15), S23, 660478335
GG B, C, D, A, X(4), S24, 405537848
GG A, B, C, D, X(9), S21, 568446438
GG D, A, B, C, X(14), S22, 1019803690
GG C, D, A, B, X(3), S23, 187363961
GG B, C, D, A, X(8), S24, 1163531501
GG A, B, C, D, X(13), S21, 1444681467
GG D, A, B, C, X(2), S22, 51403784
GG C, D, A, B, X(7), S23, 1735328473
GG B, C, D, A, X(12), S24, 1926607734
HH A, B, C, D, X(5), S31, 378558
HH D, A, B, C, X(8), S32, 2022574463
HH C, D, A, B, X(11), S33, 1839030562
HH B, C, D, A, X(14), S34, 35309556
HH A, B, C, D, X(1), S31, 1530992060
HH D, A, B, C, X(4), S32, 1272893353
HH C, D, A, B, X(7), S33, 155497632
HH B, C, D, A, X(10), S34, 1094730640
HH A, B, C, D, X(13), S31, 681279174
HH D, A, B, C, X(0), S32, 358537222
HH C, D, A, B, X(3), S33, 722521979
HH B, C, D, A, X(6), S34, 76029189
HH A, B, C, D, X(9), S31, 640364487
HH D, A, B, C, X(12), S32, 421815835
HH C, D, A, B, X(15), S33, 530742520
HH B, C, D, A, X(2), S34, 995338651
II A, B, C, D, X(0), S41, 198630844
II D, A, B, C, X(7), S42, 1126891415
II C, D, A, B, X(14), S43, 1416354905
II B, C, D, A, X(5), S44, 57434055
II A, B, C, D, X(12), S41, 1700485571
II D, A, B, C, X(3), S42, 1894986606
II C, D, A, B, X(10), S43, 1051523
II B, C, D, A, X(1), S44, 2054922799
II A, B, C, D, X(8), S41, 1873313359
II D, A, B, C, X(15), S42, 30611744
II C, D, A, B, X(6), S43, 1560198380
II B, C, D, A, X(13), S44, 1309151649
II A, B, C, D, X(4), S41, 145523070
II D, A, B, C, X(11), S42, 1120210379
II C, D, A, B, X(2), S43, 718787259
II B, C, D, A, X(9), S44, 343485551
State(1) = LongOverflowAdd(State(1), A)
State(2) = LongOverflowAdd(State(2), B)
State(3) = LongOverflowAdd(State(3), C)
State(4) = LongOverflowAdd(State(4), D)
End Sub
Private Sub Decode(Length , OutputBuffer() , InputBuffer() )
Dim intDblIndex dim intByteIndex dim dblSum For intByteIndex = 0 To Length  1 Step 4
dblSum = InputBuffer(intByteIndex) + InputBuffer(intByteIndex + 1) * 256 + InputBuffer(intByteIndex + 2) * 65536 + InputBuffer(intByteIndex + 3) * 16777216
OutputBuffer(intDblIndex) = UnsignedToLong(dblSum)
intDblIndex = intDblIndex + 1
NextEnd Sub
Private Function FF(A , B , C , D, X , S , ac ) A = LongOverflowAdd4(A, (B And C) Or (Not (B) And D), X, ac)
A = LongLeftRotate(A, S)
A = LongOverflowAdd(A, B)
End Function
Private Function GG(A, B, C , D, X , S, ac) A = LongOverflowAdd4(A, (B And D) Or (C And Not (D)), X, ac)
A = LongLeftRotate(A, S)
A = LongOverflowAdd(A, B)
End Function
Private Function HH(A , B , C , D , X , S , ac ) A = LongOverflowAdd4(A, B Xor C Xor D, X, ac)
A = LongLeftRotate(A, S)
A = LongOverflowAdd(A, B)
End Function
Private Function II(A, B, C, D, X, S, ac) A = LongOverflowAdd4(A, C Xor (B Or Not (D)), X, ac)
A = LongLeftRotate(A, S)
A = LongOverflowAdd(A, B)
End Function
Function LongLeftRotate(value , Bits ) Dim lngSign dim lngI Bits = Bits Mod 32
If Bits = 0 Then LongLeftRotate = value: Exit Function
For lngI = 1 To Bits
lngSign = value And &HC0000000
value = (value And &H3FFFFFFF) * 2
value = value Or ((lngSign < 0) And 1) Or (CBool(lngSign And &H40000000) And &H80000000)
Next
LongLeftRotate = value
End Function
Private Function LongOverflowAdd(Val1 , Val2 ) Dim lngHighWord dim lngLowWord dim lngOverflow lngLowWord = (Val1 And &HFFFF&) + (Val2 And &HFFFF&)
lngOverflow = lngLowWord \ 65536
lngHighWord = (((Val1 And &HFFFF0000) \ 65536) + ((Val2 And &HFFFF0000) \ 65536) + lngOverflow) And &HFFFF&
LongOverflowAdd = UnsignedToLong((lngHighWord * 65536) + (lngLowWord And &HFFFF&))
End Function
Private Function LongOverflowAdd4(Val1 , Val2 , val3 , val4 ) Dim lngHighWord dim lngLowWord dim lngOverflow lngLowWord = (Val1 And &HFFFF&) + (Val2 And &HFFFF&) + (val3 And &HFFFF&) + (val4 And &HFFFF&)
lngOverflow = lngLowWord \ 65536
lngHighWord = (((Val1 And &HFFFF0000) \ 65536) + ((Val2 And &HFFFF0000) \ 65536) + ((val3 And &HFFFF0000) \ 65536) + ((val4 And &HFFFF0000) \ 65536) + lngOverflow) And &HFFFF&
LongOverflowAdd4 = UnsignedToLong((lngHighWord * 65536) + (lngLowWord And &HFFFF&))
End Function
Private Function UnsignedToLong(value ) If value < 0 Or value >= OFFSET_4 Then Error 6
If value <= MAXINT_4 Then UnsignedToLong = value Else UnsignedToLong = value  OFFSET_4
End Function
Private Function LongToUnsigned(value) If value < 0 Then LongToUnsigned = value + OFFSET_4 Else LongToUnsigned = value
End Function
Richard Briggs
