Visual Basic War3CDKeyDecode

[warz]

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.

Code Select Expand


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


[Arta]

Looks very much like a VB implementation of my leaked C++ version.

[dxoigmn]

You can initialize arrays when you declare them instead of creating some function to do it for you.

Code Select Expand


Private war3_codeVal() As Byte = {&HFF, &HFF, ..., &HFF}


[R.a.B.B.i.T]

Code Select Expand


Imports System.Security.Cryptography


That's an odd VB6 line; looks more Java-y.

[iago]

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. 

[Blaze]

Code Select Expand


Imports System.Security.Cryptography


That's an odd VB6 line; looks more Java-y.

Think .Net.

[R.a.B.B.i.T]

.NET just wants to be Java.

[Warrior]

Looks like someone forgot to remove the top line after they finished porting!

[UserLoser.]

Looks like someone forgot to remove the top line after they finished porting!

How so? I thought .NET has "Imports System.Something", etc?

[Blaze]

I think Warrior thought someone ported it from .NET to VB6.