I'm not positive who I got this module from (Possibly Dragon of fatal-error? Not sure.). I received it probably January of this year. I'm currently going through my files and cleaning out my computer. I figured I'd post this module incase anyone else might be able to learn from it.
Imports System.Security.Cryptography
Module War3CDKeyDecode
Private war3_codeval(256) As Byte
Private TranslateTable(480) As Byte
Private W3_KEYLEN = 26
Private W3_BUFLEN = (W3_KEYLEN * 2)
Public Function InitArrays()
war3_codeval = FillArray( _
&HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, _
&HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, _
&HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, _
&HFF, &HFF, &H0, &HFF, &H1, &HFF, &H2, &H3, &H4, &H5, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, _
&HFF, &HFF, &H6, &H7, &H8, &H9, &HA, &HB, &HC, &HFF, &HD, &HE, &HFF, &HF, &H10, &HFF, _
&H11, &HFF, &H12, &HFF, &H13, &HFF, &H14, &H15, &H16, &H17, &H18, &HFF, &HFF, &HFF, &HFF, &HFF, _
&HFF, &HFF, &H6, &H7, &H8, &H9, &HA, &HB, &HC, &HFF, &HD, &HE, &HFF, &HF, &H10, &HFF, _
&H11, &HFF, &H12, &HFF, &H13, &HFF, &H14, &H15, &H16, &H17, &H18, &HFF, &HFF, &HFF, &HFF, &HFF, _
&HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, _
&HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, _
&HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, _
&HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, _
&HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, _
&HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, _
&HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, _
&HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF _
)
TranslateTable = FillArray( _
&H9, &H4, &H7, &HF, &HD, &HA, &H3, &HB, &H1, &H2, &HC, &H8, &H6, &HE, &H5, &H0, _
&H9, &HB, &H5, &H4, &H8, &HF, &H1, &HE, &H7, &H0, &H3, &H2, &HA, &H6, &HD, &HC, _
&HC, &HE, &H1, &H4, &H9, &HF, &HA, &HB, &HD, &H6, &H0, &H8, &H7, &H2, &H5, &H3, _
&HB, &H2, &H5, &HE, &HD, &H3, &H9, &H0, &H1, &HF, &H7, &HC, &HA, &H6, &H4, &H8, _
&H6, &H2, &H4, &H5, &HB, &H8, &HC, &HE, &HD, &HF, &H7, &H1, &HA, &H0, &H3, &H9, _
&H5, &H4, &HE, &HC, &H7, &H6, &HD, &HA, &HF, &H2, &H9, &H1, &H0, &HB, &H8, &H3, _
&HC, &H7, &H8, &HF, &HB, &H0, &H5, &H9, &HD, &HA, &H6, &HE, &H2, &H4, &H3, &H1, _
&H3, &HA, &HE, &H8, &H1, &HB, &H5, &H4, &H2, &HF, &HD, &HC, &H6, &H7, &H9, &H0, _
&HC, &HD, &H1, &HF, &H8, &HE, &H5, &HB, &H3, &HA, &H9, &H0, &H7, &H2, &H4, &H6, _
&HD, &HA, &H7, &HE, &H1, &H6, &HB, &H8, &HF, &HC, &H5, &H2, &H3, &H0, &H4, &H9, _
&H3, &HE, &H7, &H5, &HB, &HF, &H8, &HC, &H1, &HA, &H4, &HD, &H0, &H6, &H9, &H2, _
&HB, &H6, &H9, &H4, &H1, &H8, &HA, &HD, &H7, &HE, &H0, &HC, &HF, &H2, &H3, &H5, _
&HC, &H7, &H8, &HD, &H3, &HB, &H0, &HE, &H6, &HF, &H9, &H4, &HA, &H1, &H5, &H2, _
&HC, &H6, &HD, &H9, &HB, &H0, &H1, &H2, &HF, &H7, &H3, &H4, &HA, &HE, &H8, &H5, _
&H3, &H6, &H1, &H5, &HB, &HC, &H8, &H0, &HF, &HE, &H9, &H4, &H7, &HA, &HD, &H2, _
&HA, &H7, &HB, &HF, &H2, &H8, &H0, &HD, &HE, &HC, &H1, &H6, &H9, &H3, &H5, &H4, _
&HA, &HB, &HD, &H4, &H3, &H8, &H5, &H9, &H1, &H0, &HF, &HC, &H7, &HE, &H2, &H6, _
&HB, &H4, &HD, &HF, &H1, &H6, &H3, &HE, &H7, &HA, &HC, &H8, &H9, &H2, &H5, &H0, _
&H9, &H6, &H7, &H0, &H1, &HA, &HD, &H2, &H3, &HE, &HF, &HC, &H5, &HB, &H4, &H8, _
&HD, &HE, &H5, &H6, &H1, &H9, &H8, &HC, &H2, &HF, &H3, &H7, &HB, &H4, &H0, &HA, _
&H9, &HF, &H4, &H0, &H1, &H6, &HA, &HE, &H2, &H3, &H7, &HD, &H5, &HB, &H8, &HC, _
&H3, &HE, &H1, &HA, &H2, &HC, &H8, &H4, &HB, &H7, &HD, &H0, &HF, &H6, &H9, &H5, _
&H7, &H2, &HC, &H6, &HA, &H8, &HB, &H0, &HF, &H4, &H3, &HE, &H9, &H1, &HD, &H5, _
&HC, &H4, &H5, &H9, &HA, &H2, &H8, &HD, &H3, &HF, &H1, &HE, &H6, &H7, &HB, &H0, _
&HA, &H8, &HE, &HD, &H9, &HF, &H3, &H0, &H4, &H6, &H1, &HC, &H7, &HB, &H2, &H5, _
&H3, &HC, &H4, &HA, &H2, &HF, &HD, &HE, &H7, &H0, &H5, &H8, &H1, &H6, &HB, &H9, _
&HA, &HC, &H1, &H0, &H9, &HE, &HD, &HB, &H3, &H7, &HF, &H8, &H5, &H2, &H4, &H6, _
&HE, &HA, &H1, &H8, &H7, &H6, &H5, &HC, &H2, &HF, &H0, &HD, &H3, &HB, &H4, &H9, _
&H3, &H8, &HE, &H0, &H7, &H9, &HF, &HC, &H1, &H6, &HD, &H2, &H5, &HA, &HB, &H4, _
&H3, &HA, &HC, &H4, &HD, &HB, &H9, &HE, &HF, &H6, &H1, &H7, &H2, &H0, &H5, &H8 _
)
End Function
Private Function FillArray(ByVal ParamArray inBuf() As Object) As Byte()
Dim tmpOut(UBound(inBuf)) As Byte
Dim i As Integer
For i = LBound(inBuf) To UBound(inBuf)
tmpOut(i) = CByte(inBuf(i))
Next
Return tmpOut
End Function
Public Sub DecodeWar3CDkey(ByVal cdkey As String, ByRef ProdID As String, ByRef val1 As String, ByRef val2 As String)
Dim i As Integer
Dim tablebuf(W3_BUFLEN - 1) As Byte
Dim values(3) As Long
Dim keybuf(W3_KEYLEN + 1) As Byte
For i = 0 To (cdkey.Length - 1)
keybuf(i) = CByte(Asc(Mid(cdkey, i + 1, 1)))
Next
TableLookup(keybuf, tablebuf)
For i = W3_BUFLEN To 1 Step -1
ProcessExpKeyValue(&H4, &H5, values, tablebuf(i - 1))
Next
DecodeKeyTablePass1(values)
DecodeKeyTablePass2(values)
ProdID = MakeDWORD(values(0) >> &HA)
val1 = MakeDWORD(((values(0) And &H3FF) << &H10) Or (values(1) >> &H10))
val2 = MakeWORD(values(1) And 65535)
val2 += MakeDWORD(values(2))
val2 += MakeDWORD(values(3))
End Sub
Private Function MakeDWORD(ByVal Data As Long) As String
Try
Dim tmp As String
tmp = Right("00000000" & Hex(Data), 8)
Dim a As String, b As String, c As String, D As String
a = Mid(tmp, 1, 2)
b = Mid(tmp, 3, 2)
c = Mid(tmp, 5, 2)
D = Mid(tmp, 7, 2)
MakeDWORD = Chr(Val("&H" & D))
MakeDWORD += Chr(Val("&H" & c))
MakeDWORD += Chr(Val("&H" & b))
MakeDWORD += Chr(Val("&H" & a))
Catch e As Exception
System.Diagnostics.Debug.WriteLine(e.Message)
End Try
End Function
Private Function MakeWORD(ByVal Data As Integer) As String
Try
Dim tmp As String
tmp = Right("0000" & Hex(Data), 4)
Dim a As String, b As String
a = Mid(tmp, 1, 2)
b = Mid(tmp, 3, 2)
MakeWORD = Chr(Val("&H" & b))
MakeWORD += Chr(Val("&H" & a))
Catch e As Exception
System.Diagnostics.Debug.WriteLine(e.Message)
End Try
End Function
Private Sub TableLookup(ByVal key As Byte(), ByRef buf As Byte())
Dim ebx As Long, edx As Long = &H21
Dim eax As Byte
Dim i As Integer
For i = 1 To (W3_KEYLEN)
ebx = (edx + &H7B5) Mod W3_BUFLEN
edx = (ebx + &H7B5) Mod W3_BUFLEN
eax = war3_codeval(key(i - 1))
buf(ebx) = CByte(CInt(eax \ 5))
buf(edx) = CByte(CInt(eax Mod 5))
Next
End Sub
Private Function ProcessExpKeyValue(ByVal u1 As Long, ByVal Multiplier As Long, ByVal KeyTableValue As Long(), ByVal ExpKeyValue As Byte) As Integer
Dim i As Integer
Dim Param1 As Int64
Dim Param2 As Int64
Dim edxeax As Int64
Dim Pos As Integer = u1 - 1
For i = u1 To 1 Step -1
Param1 = KeyTableValue(Pos) And 4294967295
Param2 = Multiplier And 4294967295
edxeax = Param1 * Param2
KeyTableValue(Pos) = (ExpKeyValue + edxeax) And 4294967295
ExpKeyValue = (edxeax >> 32)
Pos -= 1
Next
Return ExpKeyValue
End Function
Private Sub DecodeKeyTablePass1(ByRef KeyTable As Long())
Dim ebx As Long, ecx As Long, edx As Long, esi As Long, ebp As Long
Dim var_C As Long, var_8 As Long, var_4 As Long
Dim i As Long
Dim j As Long '?
ebp = &H1D
var_8 = ebp
For i = &H1D0 To 0 Step -16
esi = (ebp And &H7) << &H2
ecx = ebp >> &H3
var_4 = ecx
edx = KeyTable(&H3 - ecx) And 4294967295
ebx = &HF << (esi And &HFF)
var_C = (edx And ebx) >> (esi And &HFF)
If i < &H1D0 Then
For j = &H1D To ebp Step -1
If j <= ebp Then Exit For
ecx = (j And &H7) << &H2
ebp = KeyTable(&H3 - (j >> &H3)) And 4294967295
ebp = (ebp And (&HF << ecx)) >> ecx
ebp = ebp Xor TranslateTable(var_C + i)
var_C = TranslateTable(ebp + i)
ebp = var_8
Next
End If
If ((ebp - 1) >= 0) Then
var_8 = ebp - 1
For j = (ebp - 1) To 0 Step -1
ecx = (j And &H7) << 2
ebp = KeyTable(&H3 - (j >> &H3)) And 4294967295
ebp = (ebp And (&HF << ecx)) >> ecx
ebx = TranslateTable(var_C + i)
ebp = (ebp And &HFF) Xor ebx
var_C = TranslateTable(ebp + i)
Next
End If
ebx = (TranslateTable(var_C + i) And &HF) << (esi And &HFF)
Dim index As Integer
index = &H3 - var_4
KeyTable(index) = (ebx Or (Not (&HF << (esi And &HFF)) And KeyTable(index))) And 4294967295
ebp = var_8
Next
End Sub
Private Sub DecodeKeyTablePass2(ByRef KeyTable As Long())
Dim eax As Long, edx As Long, ecx As Long, edi As Long, esi As Long, ebp As Long
Dim vars(3) As Long
Dim location As Integer
vars(0) = KeyTable(0)
vars(1) = KeyTable(1)
vars(2) = KeyTable(2)
vars(3) = KeyTable(3)
esi = 0
For edi = 0 To (120 - 1)
eax = edi And &H1F
ecx = esi And &H1F
edx = 3 - (edi >> 5)
location = 12 - ((esi >> 5) << 2)
ebp = vars(location / 4)
ebp = CByte((ebp And (1 << ecx)) >> ecx)
KeyTable(edx) = (((ebp And 1) << eax) Or (Not (1 << eax) And KeyTable(edx))) And 4294967295
esi += &HB
If (esi >= 120) Then
esi -= 120
End If
Next
End Sub
Private Function EncodeStringToByteArray(ByVal inBuf As String) As Byte()
Dim bytOut(inBuf.Length - 1) As Byte
Dim intI As Integer
For intI = 0 To (inBuf.Length - 1)
bytOut(intI) = CByte(Asc(Mid(inBuf, intI + 1)))
Next
Return bytOut
End Function
Private Function EncodeByteArrayToString(ByVal inBuf As Byte()) As String
Dim bytOut As String
Dim intI As Integer
For intI = 0 To (inBuf.Length - 1)
bytOut += Chr(Val(inBuf(intI)))
Next
Return bytOut
End Function
Public Function DecodeHashCDKey(ByVal strCDKey As String, ByVal lngClientKey As Long, ByVal lngServerKey As Long) As String
Dim ProdID As String, Val1 As String, Val2 As String
Dim strOut As String, strHashedData As String, strDataToHash As String
DecodeWar3CDkey(UCase$(strCDKey), ProdID, Val1, Val2)
strDataToHash = MakeDWORD(lngClientKey) + MakeDWORD(lngServerKey) + ProdID + Val1 + Val2
strHashedData = EncodeByteArrayToString(SHA1.Create("SHA1").ComputeHash(EncodeStringToByteArray(strDataToHash)))
strOut = MakeDWORD(strCDKey.Length) + ProdID + Val1 + MakeDWORD(0) + strHashedData
Return strOut
End Function
End Module
Looks very much like a VB implementation of my leaked C++ version.
You can initialize arrays when you declare them instead of creating some function to do it for you.
Private war3_codeVal() As Byte = {&HFF, &HFF, ..., &HFF}
Quote from: warz on August 16, 2005, 10:51 AM
Imports System.Security.Cryptography
That's an odd VB6 line; looks more Java-y.
Quote from: Arta[vL] on August 16, 2005, 11:15 AM
Looks very much like a VB implementation of my leaked C++ version.
I think we went over this before. :)
It's probably gone from Maddox's implement via Java.
.NET just wants to be Java.
Looks like someone forgot to remove the top line after they finished porting!
Quote from: Warrior on August 21, 2005, 12:39 AM
Looks like someone forgot to remove the top line after they finished porting!
How so? I thought .NET has "Imports System.Something", etc?
I think Warrior thought someone ported it from .NET to VB6.