'Credits: MyndFyre, iago, Adron, yobguls, l)ragon
'Extended Credits: Maddox, RealityRipple, Yegg
'06-01-10, ---------------, Added latest edit of the 26 decode.
'05-25-10, [BrokenSHA1], I guess VB still fails at math, problem (not) fixed random overflowing, tempfix remove integer overflow checking.
'05-19-10, [NLS], Conversion of MSBNCSUTIL SRP class ">Not Tested<" (See second post)
'05-16-10, ---------------, Minor adjustments to the entire namespace.
'05-16-10, ---------------, Added RealityRipple/Yegg re-written Decoders.
'05-15-10, [ver-ix86-#-CV], Checkrevision in next code section working however need to clean it a little still.
'05-07-10, [BrokenSHA1], Complete.
'05-06-10, [Decode16], squashed some of the upper portion of the code, as well as the final loop.
'05-05-10, [Decode26], CDKey Decode complete.
'05-04-10, [Decode26], Thank warz, i got lazy and stripped my poor conversion from a few years ago.
'-------------------------- http://forum.valhallalegends.com/index.php?topic=12538.0
'05-03-10, [Decode26], No its not complete yet.
'05-03-10, [Decode16], CDKey Decode
'05-02-10, [Decode13], CDKey Decode
Imports System
Imports System.IO
Imports System.Security.Cryptography
Imports System.Globalization
Imports System.Numerics 'Note you need to add referance to the Numerics dll
Namespace HashData
Public Class CDKeys
#Region "Fields"
Public key, decoded_key As String
Private key2() As Char
Public product, val1, val2 As UInt32
Private w3Val2(9) As Byte
Private hash() As Byte
Private valid As Boolean
Private isKey_26 As Boolean
#End Region
#Region "Class Propertys."
Public ReadOnly Property ProductKey As Byte()
Get
Return BitConverter.GetBytes(product)
End Get
End Property
Public ReadOnly Property Value1 As Byte()
Get
Return BitConverter.GetBytes(val1)
End Get
End Property
Public ReadOnly Property Value2 As Byte()
Get
If isKey_26 Then
Return w3Val2
Else
Return BitConverter.GetBytes(val2)
End If
End Get
End Property
#End Region
#Region "Constants"
#Region "Starcraft"
Private SC_KEYLEN As Integer = 13
#End Region
#Region "Warcraft II, Diablo II, Diablo II:Lords of Destruction"
Private WC2_KEYLEN As Integer = 16
Private D2_KEYLEN As Integer = 16
Private LOD_KEYLEN As Integer = 16
#End Region
#Region "Warcraft III, Warcraft III:Frozen Throne, (NEW)Starcraft [Classic]"
Private W3_KEYLEN As Integer = 26
Private W3_BUFLEN As UInteger = (W3_KEYLEN * 2)
#End Region
#End Region
#Region "Char Maps"
#Region "Warcraft III, Warcraft III:Frozen Throne, (NEW)Starcraft [Classic]"
Private ReadOnly TRANSLATEMAP()() As Byte = { _
New Byte() {&H9, &H4, &H7, &HF, &HD, &HA, &H3, &HB, &H1, &H2, &HC, &H8, &H6, &HE, &H5, &H0},
New Byte() {&H9, &HB, &H5, &H4, &H8, &HF, &H1, &HE, &H7, &H0, &H3, &H2, &HA, &H6, &HD, &HC},
New Byte() {&HC, &HE, &H1, &H4, &H9, &HF, &HA, &HB, &HD, &H6, &H0, &H8, &H7, &H2, &H5, &H3},
New Byte() {&HB, &H2, &H5, &HE, &HD, &H3, &H9, &H0, &H1, &HF, &H7, &HC, &HA, &H6, &H4, &H8},
New Byte() {&H6, &H2, &H4, &H5, &HB, &H8, &HC, &HE, &HD, &HF, &H7, &H1, &HA, &H0, &H3, &H9},
New Byte() {&H5, &H4, &HE, &HC, &H7, &H6, &HD, &HA, &HF, &H2, &H9, &H1, &H0, &HB, &H8, &H3},
New Byte() {&HC, &H7, &H8, &HF, &HB, &H0, &H5, &H9, &HD, &HA, &H6, &HE, &H2, &H4, &H3, &H1},
New Byte() {&H3, &HA, &HE, &H8, &H1, &HB, &H5, &H4, &H2, &HF, &HD, &HC, &H6, &H7, &H9, &H0},
New Byte() {&HC, &HD, &H1, &HF, &H8, &HE, &H5, &HB, &H3, &HA, &H9, &H0, &H7, &H2, &H4, &H6},
New Byte() {&HD, &HA, &H7, &HE, &H1, &H6, &HB, &H8, &HF, &HC, &H5, &H2, &H3, &H0, &H4, &H9},
New Byte() {&H3, &HE, &H7, &H5, &HB, &HF, &H8, &HC, &H1, &HA, &H4, &HD, &H0, &H6, &H9, &H2},
New Byte() {&HB, &H6, &H9, &H4, &H1, &H8, &HA, &HD, &H7, &HE, &H0, &HC, &HF, &H2, &H3, &H5},
New Byte() {&HC, &H7, &H8, &HD, &H3, &HB, &H0, &HE, &H6, &HF, &H9, &H4, &HA, &H1, &H5, &H2},
New Byte() {&HC, &H6, &HD, &H9, &HB, &H0, &H1, &H2, &HF, &H7, &H3, &H4, &HA, &HE, &H8, &H5},
New Byte() {&H3, &H6, &H1, &H5, &HB, &HC, &H8, &H0, &HF, &HE, &H9, &H4, &H7, &HA, &HD, &H2},
New Byte() {&HA, &H7, &HB, &HF, &H2, &H8, &H0, &HD, &HE, &HC, &H1, &H6, &H9, &H3, &H5, &H4},
New Byte() {&HA, &HB, &HD, &H4, &H3, &H8, &H5, &H9, &H1, &H0, &HF, &HC, &H7, &HE, &H2, &H6},
New Byte() {&HB, &H4, &HD, &HF, &H1, &H6, &H3, &HE, &H7, &HA, &HC, &H8, &H9, &H2, &H5, &H0},
New Byte() {&H9, &H6, &H7, &H0, &H1, &HA, &HD, &H2, &H3, &HE, &HF, &HC, &H5, &HB, &H4, &H8},
New Byte() {&HD, &HE, &H5, &H6, &H1, &H9, &H8, &HC, &H2, &HF, &H3, &H7, &HB, &H4, &H0, &HA},
New Byte() {&H9, &HF, &H4, &H0, &H1, &H6, &HA, &HE, &H2, &H3, &H7, &HD, &H5, &HB, &H8, &HC},
New Byte() {&H3, &HE, &H1, &HA, &H2, &HC, &H8, &H4, &HB, &H7, &HD, &H0, &HF, &H6, &H9, &H5},
New Byte() {&H7, &H2, &HC, &H6, &HA, &H8, &HB, &H0, &HF, &H4, &H3, &HE, &H9, &H1, &HD, &H5},
New Byte() {&HC, &H4, &H5, &H9, &HA, &H2, &H8, &HD, &H3, &HF, &H1, &HE, &H6, &H7, &HB, &H0},
New Byte() {&HA, &H8, &HE, &HD, &H9, &HF, &H3, &H0, &H4, &H6, &H1, &HC, &H7, &HB, &H2, &H5},
New Byte() {&H3, &HC, &H4, &HA, &H2, &HF, &HD, &HE, &H7, &H0, &H5, &H8, &H1, &H6, &HB, &H9},
New Byte() {&HA, &HC, &H1, &H0, &H9, &HE, &HD, &HB, &H3, &H7, &HF, &H8, &H5, &H2, &H4, &H6},
New Byte() {&HE, &HA, &H1, &H8, &H7, &H6, &H5, &HC, &H2, &HF, &H0, &HD, &H3, &HB, &H4, &H9},
New Byte() {&H3, &H8, &HE, &H0, &H7, &H9, &HF, &HC, &H1, &H6, &HD, &H2, &H5, &HA, &HB, &H4},
New Byte() {&H3, &HA, &HC, &H4, &HD, &HB, &H9, &HE, &HF, &H6, &H1, &H7, &H2, &H0, &H5, &H8}}
#End Region
#End Region
Public Sub New(ByVal cdKey As String)
InitalizePrivate(cdKey)
End Sub
Private Sub InitalizePrivate(ByVal cdKey As String)
If IsNothing(cdKey) AndAlso (cdKey = "") Then
'"CDKey is Missing."
Exit Sub
End If
cdKey = cdKey.Replace("-", "")
Me.key = cdKey
isKey_26 = (cdKey.Length = W3_KEYLEN)
Dim i As Integer
Select Case cdKey.Length
Case SC_KEYLEN
While (i < SC_KEYLEN)
If (Not Char.IsDigit(cdKey, i)) Then
'"You fail at SC"
End If
i += 1
End While
'decoded_key = Decode13(cdKey)
Call Decode13DigitKey(cdKey, product, val1, val2)
Exit Select
Case WC2_KEYLEN ', D2_KEYLEN, LOD_KEYLEN
While (i < WC2_KEYLEN)
If Not (Char.IsLetterOrDigit(cdKey, i)) Then
'"You fail at WC2 or D2 or LOD"
End If
i += 1
End While
'decoded_key = Decode16(cdKey)
Call Decode16DigitKey(cdKey, product, val1, val2)
Exit Select
Case W3_KEYLEN
While (i < W3_KEYLEN)
If Not (Char.IsLetterOrDigit(cdKey, i)) Then
'"You fail at WC3, WC3:TFT, NEWSCKEY"
End If
i += 1
End While
'DecodeWar3CDkey(cdKey)
Call Decode26DigitKey(cdKey, product, val1, w3Val2)
Exit Select
Case Else
End Select
End Sub
#Region "Starcraft CDKey Decoder."
Friend Sub Decode13DigitKey(ByVal Key As String, ByRef Product As UInt32, ByRef PublicVal As UInt32, ByRef PrivateVal As UInt32)
Dim salt As Int32 = &H13AC9741, SEQ() As Byte = {6, 0, 2, 9, 3, 11, 1, 7, 5, 4, 10, 8}, Decoded(12) As Char
For I As Int32 = 11 To 0 Step -1
Dim C As Byte = Asc(Key.Substring(SEQ(I), 1))
If C <= 55 Then Decoded(I) = Chr(C Xor (salt And 7)) : salt >>= 3 Else Decoded(I) = Chr(C Xor I And 1)
Next
If Key.EndsWith(GetLastVal(Key)) Then
Dim sDone As String = Decoded
Product = UInt32.Parse(sDone.Substring(0, 2), Globalization.NumberStyles.AllowHexSpecifier)
PublicVal = sDone.Substring(2, 7)
PrivateVal = sDone.Substring(9, 3)
Else
Product = 0 : PublicVal = 0 : PrivateVal = 0
End If
End Sub
Private Function GetLastVal(ByVal sKey As String) As Char
Dim lLenVal As UInt32 = 3, Key() As Char = sKey.ToCharArray
For I As Int32 = 0 To 11
lLenVal = lLenVal + (CStr(Key(I)) Xor (lLenVal * 2))
Next I
Return CStr(lLenVal Mod 10)
End Function
Private Function Decode13_Old(ByVal cdkey As String) As String
Dim i, pos, accum As Int32
Dim temp As Byte
Dim HashKey As Int32 = &H13AC9741
Dim KeyAr(&HC) As Byte
key2 = cdkey.ToCharArray
For i = &H0 To &HC
KeyAr(i) = Asc(cdkey.Substring(i, &H1))
'Debug.Print(Chr(KeyAr(i)))
Next
accum = &H3
For i = &H0 To &HB
accum += ((KeyAr(i) - &H30) Xor (accum * &H2))
Next
If Not ((accum Mod &HA) = (KeyAr(&HC) - &H30)) Then
valid = False
Erase KeyAr
Return "your cdkey is shit"
End If
valid = True
pos = &HB
i = &HC2
While i >= &H7
temp = KeyAr(pos)
KeyAr(pos) = KeyAr(i Mod &HC)
KeyAr(i Mod &HC) = temp
pos -= &H1
i -= &H11
End While
i = cdkey.Length - &H2
While i >= &H0
temp = UCase(KeyAr(i))
KeyAr(i) = temp
If temp <= &H37 Then
KeyAr(i) = KeyAr(i) Xor (HashKey And &H7)
HashKey >>= &H3
ElseIf temp < &H41 Then
KeyAr(i) = KeyAr(i) Xor (i And &H1)
End If
i -= &H1
End While
Dim tempKey As String = ""
For i = &H0 To &HC
tempKey &= Chr(KeyAr(i))
Next
'sscanf((const char *)arrayKey, "%2ld%7ld%3ld", &product, &value1, &value2);
product = Integer.Parse(tempKey.Substring(&H0, &H2))
val1 = Integer.Parse(tempKey.Substring(&H2, &H7))
val2 = Integer.Parse(tempKey.Substring(&H9, &H3))
Erase KeyAr
Return tempKey
End Function
#End Region
#Region "Warcraft II, Diablo II, Diablo II:Lords of destruction"
Friend Sub Decode16DigitKey(ByVal Key As String, ByRef Product As UInt32, ByRef PublicVal As UInt32, ByRef PrivateVal As UInt32)
Dim salt As Int32 = &H13AC9741, SEQ() As Byte = {5, 6, 0, 1, 2, 3, 4, 9, 10, 11, 12, 13, 14, 15, 7, 8}
Const CodeValues As String = "246789BCDEFGHJKMNPRTVWXZ"
Dim aryKey() As Char = Key.ToCharArray
For I As Integer = 0 To 14 Step 2
If Not CodeValues.Contains(aryKey(I + 1)) OrElse Not CodeValues.Contains(aryKey(I)) Then Exit Sub
Dim N As Int32 = (CodeValues.IndexOf(aryKey(I + 1))) + (CodeValues.IndexOf(aryKey(I)) * 24) And &HFF
aryKey(I) = Chr(IIf(((N >> 4) And &HF) < 10, ((N >> 4) And &HF) + &H30, ((N >> 4) And &HF) + &H37))
aryKey(I + 1) = Chr(IIf((N And &HF) < 10, (N And &HF) + &H30, (N And &HF) + &H37))
Next I
Dim Decoded(15) As Char
For I As Int32 = 15 To 0 Step -1
Dim C As Byte = Asc(Char.ToUpper(aryKey(SEQ(I))))
If C <= 55 Then
Decoded(I) = Chr(C Xor (salt And 7))
salt >>= 3
ElseIf C < 65 Then
Decoded(I) = Chr(C Xor I And 1)
Else
Decoded(I) = Chr(C)
End If
Next
Dim sDone As String = Decoded
Product = UInt32.Parse(sDone.Substring(0, 2), Globalization.NumberStyles.AllowHexSpecifier)
PublicVal = UInt32.Parse(sDone.Substring(2, 6), Globalization.NumberStyles.AllowHexSpecifier)
PrivateVal = UInt32.Parse(sDone.Substring(8), Globalization.NumberStyles.AllowHexSpecifier)
End Sub
Private Function getHexVal(ByVal val As Integer) As Char
val = val And &HF
Return Chr(IIf((val < &HA), (val + &H30), (val + &H37)))
End Function
Private Function getNumVal(ByVal c As Char) As Integer
c = Char.ToUpper(c, CultureInfo.InvariantCulture)
Return IIf((Char.IsDigit(c)), (Asc(c) - &H30), (Asc(c) - &H37))
End Function
#End Region
#Region "Warcraft III, Warcraft III:Frozen Throne, (NEW)Starcraft Keys"
Friend Sub Decode26DigitKey(ByVal Key As String, ByRef Product As UInt32, ByRef PublicVal As UInt32, ByRef PrivateVal() As Byte)
Const CodeValues As String = "246789BCDEFGHJKMNPRTVWXYZ"
Dim cKey() As Char = Key.ToCharArray
Dim aOrd() As Byte = {30, 27, 24, 21, 18, 15, 12, 9, 6, 3, 0, 49,
46, 43, 40, 37, 34, 31, 28, 25,
22, 19, 16, 13, 10, 7, 4, 1, 50, 47, 44, 41,
38, 35, 32, 29, 26, 23, 20, 17,
14, 11, 8, 5, 2, 51, 48, 45, 42, 39, 36, 33}
Dim n_digitsBase5(0 To 51) As Byte
For I As Integer = 0 To 26 - 1
If Not CodeValues.Contains(cKey(I)) Then Exit Sub
Dim c As Byte = CodeValues.IndexOf(cKey(I))
n_digitsBase5(aOrd(I * 2)) = CByte(c \ 5)
n_digitsBase5(aOrd(I * 2 + 1)) = CByte(c Mod 5)
Next I
Dim n As System.Numerics.BigInteger = 0
For I As Integer = 51 To 0 Step -1 : n = n * 5 + n_digitsBase5(I) : Next I
Dim nbytes() As Byte = n.ToByteArray
Dim nibbles(0 To 29) As Byte
For I As Integer = 0 To 14
For J As Integer = 0 To 1
nibbles((I << 1) + J) = CByte((nbytes(I) >> (J << 2)) And CUInt(&HF))
Next J
Next I
For R As Integer = 29 To 0 Step -1
Dim perm() As Byte = TRANSLATEMAP(R)
Dim c As Byte = nibbles(R)
For r2 As Integer = 29 To 0 Step -1
If R = r2 Then Continue For
c = perm(nibbles(r2) Xor perm(c))
Next r2
nibbles(R) = perm(c)
Next R
Dim bits As New BitArray(128)
For I As Integer = 0 To 29
For J As Integer = 0 To 3
Dim b As Boolean = CBool(((nibbles(I) >> J) And &H1) <> 0)
bits.Set((I * 4 + J), b)
Next J
Next I
For I As Integer = 0 To 119
Dim J As Integer = (I * 11) Mod 120
If J <= I Then Continue For
Dim b As Boolean = bits.Get(I)
bits(I) = bits(J)
bits.Set(J, b)
Next I
Dim bb(0 To 14) As Byte
For I As Integer = 0 To 14
For J As Integer = 0 To 7
If bits.Get((I << 3) + J) Then bb(I) = bb(I) Or CByte(&H1 << J)
Next J
Next I
If bb(14) = &H0 Then
Product = bb(&HD) >> &HA
PublicVal = System.BitConverter.ToUInt32(bb, &HA) And &HFFFFFF
Dim bOrder() As Byte = {8, 9, 4, 5, 6, 7, 0, 1, 2, 3}
ReDim PrivateVal(9)
For I As Integer = 0 To 9 : PrivateVal(I) = bb(bOrder(I)) : Next
Else
Product = 0
PublicVal = 0
Erase PrivateVal
End If
End Sub
#End Region
End Class
End Namespace
Imports System.IO
Namespace HashData
Module CheckRevision
Private ReadOnly HashCodes() As Int32 = {&HE7F4CB62, &HF6A14FFC, &HAA5504AF, &H871FCDC2, _
&H11BF6A18, &HC57292E6, &H7927D27E, &H2FEC8733}
Public Function DoCheckrevision(ByVal exe As String, _
ByVal dll As String, _
ByVal snp As String, _
ByVal hashcommand As String, _
ByVal mpqname As String) As Boolean
If InStr(mpqname.ToLower, "lockdown") > 0 Then
Return False
Else
CheckRevisionVB(exe, dll, snp, hashcommand, CheckSumHash, ExeInfoStr, mpqname, VersionVal)
End If
Return True
End Function
Public Function CheckRevisionVB(ByVal exe As String, ByVal dll As String, ByVal snp As String, _
ByVal HashCommand As String, _
ByRef Checksum As Long, _
ByRef exeInfo As String, _
ByVal mpqName As String, _
ByRef Ver As Long) As Boolean
Dim Operations(3) As String
Dim Values(3) As Long
Dim opDest(3) As Integer
Dim opSrc1(3) As Integer
Dim opSrc2(3) As Integer
Dim mpqNum As Integer = CInt(Val(Replace(Replace(Replace(Replace(LCase(mpqName), ".mpq", ""), "ix86", ""), "ver", ""), "-", "")))
If mpqNum < 0 OrElse mpqNum > 7 Then
Return False
End If
Dim i As Integer, j As Integer, k As Integer
Dim FileNames(2) As String
If exe = "" Then
Return False
End If
FileNames(0) = exe
If dll = "" Then
Return False
End If
FileNames(1) = dll
If snp = "" Then
Return False
End If
FileNames(2) = snp
InitVars(HashCommand, Values, opDest, opSrc1, Operations, opSrc2)
Values(0) = (Values(0) Xor HashCodes(mpqNum)) And &HFFFFFFFFUI
Dim currentOperandBuffer(1023) As Byte
For i = 0 To 2 '# of files = 3
Using currentfile As New FileStream(FileNames(i), FileMode.Open, FileAccess.Read, FileShare.Read)
While currentfile.Position < currentfile.Length
Dim currentFilePosition As Long = 0
Dim amountToRead As Long = Math.Min(currentfile.Length - currentfile.Position, 1024)
currentfile.Read(currentOperandBuffer, 0, amountToRead)
If (amountToRead < 1024) Then
Dim currentPaddingByte As Byte = Byte.Parse(&HFF)
For j = amountToRead To 1023
currentOperandBuffer(j) = currentPaddingByte
If currentPaddingByte = 0 Then
currentPaddingByte = Byte.Parse(&HFF)
Else
currentPaddingByte -= 1
End If
Next
End If
For j = 0 To 1023 Step 4
Values(3) = BitConverter.ToUInt32(currentOperandBuffer, j)
For k = 0 To 3 '# of operations = 4
Select Case (Operations(k))
Case "+"
Values(opDest(k)) = ((Values(opSrc1(k)) + Values(opSrc2(k)))) And UInt32.MaxValue
Exit Select
Case "-"
Values(opDest(k)) = ((Values(opSrc1(k)) - Values(opSrc2(k)))) And UInt32.MaxValue
Exit Select
Case "^"
Values(opDest(k)) = ((Values(opSrc1(k)) Xor Values(opSrc2(k)))) And UInt32.MaxValue
Exit Select
Case "*"
Values(opDest(k)) = ((Values(opSrc1(k)) * Values(opSrc2(k)))) And UInt32.MaxValue
Exit Select
Case "/"
Values(opDest(k)) = ((Values(opSrc1(k)) / Values(opSrc2(k)))) And UInt32.MaxValue
Exit Select
Case Else
Exit Select
End Select
Next
Next
End While
End Using
Next
exeInfo = FileNames(0)
GetExeinfoAndVersion(exeInfo, Ver)
Checksum = Values(2)
Return True
End Function
Private Sub GetExeinfoAndVersion(ByRef exeInf As String, ByRef ver As Long)
Dim eInfo As New FileInfo(exeInf)
Dim fVer As FileVersionInfo = FileVersionInfo.GetVersionInfo(exeInf)
Dim eLength As Long = eInfo.Length
Dim eDate As String = " " & _
lngStr(eInfo.LastWriteTimeUtc.Month) & "/" & _
lngStr(eInfo.LastWriteTimeUtc.Day) & "/" & _
lngStr(eInfo.LastWriteTimeUtc.Year) & _
" " & _
lngStr(eInfo.LastWriteTimeUtc.Hour) & ":" & _
lngStr(eInfo.LastWriteTimeUtc.Minute) & ":" & _
lngStr(eInfo.LastWriteTimeUtc.Second) & _
" "
exeInf = eInfo.Name & eDate & eLength.ToString
Dim b(3) As Byte
b(3) = fVer.ProductMajorPart And &HFFI
b(2) = fVer.ProductMinorPart And &HFFI
b(1) = fVer.ProductBuildPart And &HFFI
b(0) = fVer.ProductPrivatePart And &HFFI
ver = BitConverter.ToInt32(b, 0)
End Sub
Private Function lngStr(ByVal inVal As String) As String
If inVal.Length = 1 Then
Return "0" + inVal
ElseIf inVal.Length = 4 Then
Return Right(inVal, 2)
Else
Return inVal
End If
End Function
Private Function getNum(ByVal c As String) As Integer
Select Case UCase(c)
Case "A"
Return 0
Case "B"
Return 1
Case "C"
Return 2
Case "S"
Return 3
Case Else
Return -1
End Select
End Function
Public Sub InitVars(ByVal HashCommand As String, _
ByRef dwVars() As Long, _
ByRef varDest() As Integer, _
ByRef Val1() As Integer, _
ByRef Oper() As String, _
ByRef Val2() As Integer)
Dim s() As String = Split(HashCommand, " ")
Dim dwVariables(3) As Long
Dim opValueDest(3) As Integer, opValueSrc1(3) As Integer, opValueSrc2(3) As Integer
Dim operation(3) As String
Dim NumberOfOperations As Integer
Dim i As Integer
For i = 0 To 2
dwVariables(getNum(Mid(s(i), 1, 1))) = (Long.Parse(Mid(s(i), 3, s(i).Length)))
Next
dwVars = dwVariables
NumberOfOperations = CInt(Val(s(3)))
For i = 0 To (NumberOfOperations - 1)
opValueDest(i) = getNum(Mid(s(i + 4), 1, 1))
opValueSrc1(i) = getNum(Mid(s(i + 4), 3, 1))
operation(i) = Mid(s(i + 4), 4, 1)
opValueSrc2(i) = getNum(Mid(s(i + 4), 5, 1))
Next
varDest = opValueDest
Val1 = opValueSrc1
Oper = operation
Val2 = opValueSrc2
End Sub
End Module
End Namespace
Namespace HashData
Public Module BrokenSHA1 'Legacy hashing
Public Function BuildCDKeyData(ByVal sKey As UInt32, ByVal cKey As UInt32, _
ByVal ProdKey As UInt32, _
ByVal val1 As UInt32, _
ByVal val2 As UInt32, _
ByVal KeyLength As UInt32) As Byte()
Dim OutBuf(35) As Byte
Array.Copy(BitConverter.GetBytes(KeyLength), 0, OutBuf, 0, 4)
Array.Copy(BitConverter.GetBytes(UInt32.Parse(ProdKey)), 0, OutBuf, 4, 4)
Array.Copy(BitConverter.GetBytes(val1), 0, OutBuf, 8, 4)
Array.Copy(BitConverter.GetBytes(UInt32.Parse(&H0UI)), 0, OutBuf, 12, 4)
Array.Copy(HashCDKey(sKey, cKey, ProdKey, val1, val2), 0, OutBuf, 16, 20)
Return OutBuf
End Function
Public Function HashCDKey(ByVal ServerKey As UInt32, ByVal ClientKey As UInt32, _
ByVal prodid As UInt32, ByVal val1 As UInt32, _
ByVal val2 As UInt32) As Byte()
Dim dwHashBuff(19) As Byte
Dim tHashBuf(23) As Byte
Array.Copy(BitConverter.GetBytes(ClientKey), 0, tHashBuf, 0, 4)
Array.Copy(BitConverter.GetBytes(ServerKey), 0, tHashBuf, 4, 4)
Array.Copy(BitConverter.GetBytes(prodid), 0, tHashBuf, 8, 4)
Array.Copy(BitConverter.GetBytes(val1), 0, tHashBuf, 12, 4)
Array.Copy(BitConverter.GetBytes(UInt32.Parse(0)), 0, tHashBuf, 16, 4)
Array.Copy(BitConverter.GetBytes(val2), 0, tHashBuf, 20, 4)
dwHashBuff = SafeHash(tHashBuf)
Erase tHashBuf
Return dwHashBuff
End Function
Public Function HashPass(ByVal password As String, ByVal val1 As Int32, ByVal val2 As Int32) As Byte()
Dim passwordhash() As Byte = CreateAccount(password)
Dim tmpBuf(19) As Byte
Dim p1(7) As Byte
Dim p1ph(27) As Byte
Array.Copy(BitConverter.GetBytes(val1), 0, p1, 0, 4)
Array.Copy(BitConverter.GetBytes(val2), 0, p1, 4, 4)
Array.Copy(p1, 0, p1ph, 0, 8)
Array.Copy(passwordhash, 0, p1ph, 8, 20)
passwordhash = SafeHash(p1ph)
Array.Copy(p1, 0, p1ph, 0, 8)
Array.Copy(passwordhash, 0, p1ph, 8, 20)
Erase p1
Erase passwordhash
Erase tmpBuf
Return p1ph
End Function
Public Function CreateAccount(ByVal password As String) As Byte()
Dim dwHashBuffer(19) As Byte
dwHashBuffer = SafeHash(System.Text.Encoding.ASCII.GetBytes(password))
Return dwHashBuffer
End Function
Private Function ROL(ByVal val As UInteger, ByVal shift As Integer) As UInteger
shift = shift And &H1F
val = (val >> (32 - shift)) Or (val << shift)
Return val
End Function
Private Function ForceUint(ByVal inVal As Double) As UInteger
While inVal > UInteger.MaxValue
inVal -= 4294967296
End While
While inVal < UInteger.MinValue
inVal += 4294967296
End While
Return inVal
End Function
Private Function Add(ByVal number1 As Double, ByVal number2 As Double) As UInteger
Return ForceUint(CDbl(number1) + CDbl(number2))
End Function
Public Function SafeHash(ByVal InBuf() As Byte) As Byte()
If (InBuf.Length > 1024) Then Throw New ArgumentOutOfRangeException("<InBuf()> Error data exceeded 1024 bytes")
Dim data(1023) As Byte
Array.Copy(InBuf, 0, data, 0, InBuf.Length)
Dim i As Int32
Dim mdata As MemoryStream = New MemoryStream(data, True)
Dim br As BinaryReader = New BinaryReader(mdata)
Dim bw As BinaryWriter = New BinaryWriter(mdata)
Dim a, b, c, d, e, g As UInteger
Dim expr_ldata_i, expr_ldata_i_2, expr_ldata_i_8, expr_ldata_i_13 As UInteger
Dim shiftVal As Int32
For i = 0 To 63
mdata.Seek((i * 4), SeekOrigin.Begin)
'// mdata now at ldata[i]
expr_ldata_i = br.ReadUInt32()
'// mdata now at ldata[i+1]
mdata.Seek(1 * 4, SeekOrigin.Current)
'// mdata now at ldata[i+2]
expr_ldata_i_2 = br.ReadUInt32()
'// mdata now at ldata[i+3]
mdata.Seek(5 * 4, SeekOrigin.Current)
'// mdata now at ldata[i+8]
expr_ldata_i_8 = br.ReadUInt32()
'// mdata now at ldata[i+9]
mdata.Seek(4 * 4, SeekOrigin.Current)
'// mdata now at ldata[i+13]
expr_ldata_i_13 = br.ReadUInt32()
'// mdata now at ldata[i+14]
shiftVal = ((expr_ldata_i Xor expr_ldata_i_8 Xor expr_ldata_i_2 Xor expr_ldata_i_13) And &H1F) And Int32.MaxValue
mdata.Seek(2 * 4, SeekOrigin.Current)
'// mdata now at ldata[i+16]
bw.Write(ROL(1, shiftVal))
Next
a = &H67452301L
b = &HEFCDAB89L
c = &H98BADCFEL
d = &H10325476L
e = &HC3D2E1F0L
g = 0
mdata.Seek(0, SeekOrigin.Begin)
For i = 0 To 79
g = br.ReadUInt32()
g = Add(g, e)
g = Add(g, ROL(a, 5))
Select Case i
Case Is < 20
g = Add(g, ((b And c) Or ((Not b) And d)))
g = Add(g, &H5A827999L)
Case Is < 40
g = Add(g, (d Xor c Xor b))
g = Add(g, &H6ED9EBA1L)
Case Is < 60
g = Add(g, (c And b) Or (d And c) Or (d And b))
g = Add(g, &H8F1BBCDCL)
Case Is < 80
g = Add(g, (d Xor c Xor b))
g = Add(g, &HCA62C1D6L)
End Select
e = d
d = c
c = ROL(b, 30)
b = a
a = g
Next
br.Close()
bw.Close()
mdata.Close()
Dim result As Byte() = New Byte(19) {}
mdata = New MemoryStream(result, 0, 20, True, True)
bw = New BinaryWriter(mdata)
bw.Write(Add(&H67452301UI, a))
bw.Write(Add(&HEFCDAB89UI, b))
bw.Write(Add(&H98BADCFEUI, c))
bw.Write(Add(&H10325476UI, d))
bw.Write(Add(&HC3D2E1F0UI, e))
mdata.Close()
bw.Close()
Return result
End Function
End Module
End Namespace
Obvious rehash, this way I wont lose my shit this time around.
Not a final, I will be adding to this as I get time to.
If you improve upon what ever's here be sure to leave a note about it, goes for what ever
Been working on better CDKey Encoding/Decoding with Yegg. Most the stuff in the old code is just obfuscation and unimproved port leftovers.
13 and 16 digit keys both simply switch the order of the key around and then run it through a simple little xor decrypter, with 16 digit keys being converted to compatible numbers based on the CodeValues string ("246789BCDEFGHJKMNPRTVWXZ").
Instead of switching the order through functions, a byte array storing the index order of the encoded values is used to set the result of the encryption into the right positions, consolidating and simplifying the function dramatically.
The last value for 13 digit keys is pulled out into another function (GetLastVal) for easy key checking and creation (note that it's optional in the decode function, since it doesn't effect the values sent to Battle.net).
26 Digit keys are much more complex, but use the same CodeValues as 16 digit keys, except with the addition of the letter "Y" in the alphabetically correct position. The rest of the code I have really needs improvement, which I'll be working on over the next few days.
For now, all code in the link below works, though only the 13 and 16 decoders and 13 encoder are perfected. 16's encoder needs a bit of work on the second loop.
Work in progress: http://pastebin.com/1Z0w2kJU
Namespace HashData
Public Class NLS
Public ReadOnly Modulus() As Byte = { _
&HF8, &HFF, &H1A, &H8B, &H61, &H99, &H18, &H3, &H21, &H86, &HB6, &H8C, &HA0, &H92, &HB5, &H55, _
&H7E, &H97, &H6C, &H78, &HC7, &H32, &H12, &HD9, &H12, &H16, &HF6, &H65, &H85, &H23, &HC7, &H87}
Public Const Generator As Int32 = 47
Public Const SignatureKey As Int32 = &H10001
Public ReadOnly ServerModulus() As Byte = { _
&HCF, &H8D, &H69, &H7F, &HBA, &HC2, &H8D, &HB6, &HFD, &H9D, &H54, &HCC, &H41, &H40, &HED, &HC2, _
&H96, &H78, &H51, &H57, &HE7, &HBD, &HF5, &H2D, &HB0, &H32, &HD9, &H40, &H66, &H8E, &H16, &HEA, _
&H76, &H34, &H8A, &H8E, &H69, &H32, &H84, &H41, &H20, &HD3, &H8A, &H8, &H5E, &H3D, &HF4, &H2A, _
&H98, &HDD, &H0, &HC2, &HE4, &HFC, &H26, &HFD, &HF4, &H25, &HD3, &H4D, &H2D, &HC5, &H82, &HD0, _
&H20, &HA6, &H6, &HA1, &HD5, &H77, &HE1, &HC9, &H73, &HB8, &HF3, &HCB, &H9E, &H43, &H7, &H88, _
&HFC, &H39, &H5A, &H15, &HB, &H48, &HF, &H29, &H35, &H56, &HBA, &H2D, &HFC, &HC1, &HE5, &HDC, _
&HB5, &H56, &HB5, &H8F, &HE, &HCD, &H3B, &H3A, &HA1, &HB4, &H19, &H42, &HE8, &H20, &HFA, &HB0, _
&H32, &HE3, &HB, &H9D, &H78, &H6E, &HFA, &HC3, &HF, &HC5, &HD, &HF, &HAB, &HD6, &HA3, &HD5}
Private ReadOnly s_sha As SHA1 = New SHA1Managed()
Private ReadOnly s_rand As RandomNumberGenerator = New RNGCryptoServiceProvider()
Private ReadOnly s_modulus As BigInteger = New BigInteger(Modulus)
Private ReadOnly s_generator As BigInteger = New BigInteger(ULong.Parse(47))
Private userName, password As String
Private k(), userNameAscii() As Byte
Private verifier, x, a, _A, m1 As BigInteger
Public Sub New(ByVal Username As String, ByVal Password As String)
Username = Username
userNameAscii = Encoding.ASCII.GetBytes(Username)
Password = Password
Dim rand_a(31) As Byte
s_rand.GetNonZeroBytes(rand_a)
a = New BigInteger(rand_a)
a = a Mod s_modulus
a = New BigInteger(ReverseArray(a.ToByteArray))
'//A = s_generator.ModPow(a, s_modulus)
_A = New BigInteger(ReverseArray(BigInteger.ModPow(s_generator, a, s_modulus).ToByteArray))
End Sub
Public Function VerifyServerProof(ByVal serverProof() As Byte) As Boolean
If Not (serverProof.Length = 20) Then
Throw New ArgumentOutOfRangeException("Resources.nlsServerProof20")
Return False
End If
Dim ms_m2 As MemoryStream = New MemoryStream(92) '92
Dim bw As BinaryWriter = New BinaryWriter(ms_m2)
bw.Write(EnsureArrayLength(a.ToByteArray, 32))
bw.Write(m1.ToByteArray)
bw.Write(k)
Dim client_m2_data() As Byte = ms_m2.GetBuffer()
ms_m2.Close()
Dim client_hash_m2() As Byte = s_sha.ComputeHash(client_m2_data)
Dim client_m2 As BigInteger = New BigInteger(client_hash_m2)
Dim server_m2 As BigInteger = New BigInteger(serverProof)
Debug.WriteLine(client_m2.ToString, "Client")
Debug.WriteLine(server_m2.ToString, "Server")
Return client_m2.Equals(server_m2)
End Function
Public Function LoginProof(ByVal stream As Stream, ByVal serverSalt() As Byte, ByVal serverRandomKey() As Byte) As Int32
If Not (serverSalt.Length = 32) Then
Throw New ArgumentOutOfRangeException("Resources.param_salt, serverSalt, Resources.nlsSalt32")
End If
If Not (serverRandomKey.Length = 32) Then
Throw New ArgumentOutOfRangeException("Resources.param_serverKey, serverRandomKey, Resources.nlsServerKey32")
End If
If (stream.Position + 20 > stream.Length) Then
Throw New IOException("Resources.nlsLoginProofSpace")
End If
CalculateM1(serverSalt, serverRandomKey)
stream.Write(EnsureArrayLength(Me.m1.ToByteArray, 20), 0, 20)
Return 20
End Function
Public Function LoginProof(ByVal buffer() As Byte, ByVal startIndex As Int32, ByVal totalLength As Int32, ByVal serverSalt() As Byte, ByVal serverKey() As Byte) As Int32
Dim ms As MemoryStream = New MemoryStream(buffer, startIndex, totalLength, True)
Return LoginProof(ms, serverSalt, serverKey)
End Function
Public Function LoginProof(ByRef logonProofPacket As PacketClass, ByVal serverSalt() As Byte, ByVal serverKey() As Byte) As Int32
Dim temp(19) As Byte
Dim len As Int32 = LoginProof(temp, 0, 20, serverSalt, serverKey)
logonProofPacket.AddByteArray(temp)
Return len
End Function
Public Function LoginAccount(ByVal stream As Stream) As Int32
If ((stream.Position + 33 + userNameAscii.Length) > stream.Length) Then
Throw New IOException("Resources.nlsAcctLoginSpace")
End If
stream.Write(EnsureArrayLength(a.ToByteArray, 32), 0, 32)
stream.Write(userNameAscii, 0, userNameAscii.Length)
stream.WriteByte(0)
Return 33 + userNameAscii.Length
End Function
Public Function LoginAccount(ByRef loginPacket As PacketClass) As Int32
Dim temp(33 + (userNameAscii.Length - 1)) As Byte
Dim len As Int32 = LoginAccount(temp, 0, temp.Length)
loginPacket.AddByteArray(temp)
Return len
End Function
Public Function LoginAccount(ByVal buffer() As Byte, ByVal startIndex As Int32, ByVal totalLength As Int32) As Int32
Dim ms As MemoryStream = New MemoryStream(buffer, startIndex, totalLength, True)
Return LoginAccount(MS)
End Function
Public Function CreateAccount(ByVal stream As Stream) As Int32
If ((stream.Position + 65 + userNameAscii.Length) > stream.Length) Then
Throw New IOException("Resources.nlsAcctCreateSpace")
End If
Dim clientSalt(31) As Byte
s_rand.GetNonZeroBytes(clientSalt)
CalculateVerifier(clientSalt)
stream.Write(EnsureArrayLength(clientSalt, 32), 0, 32)
stream.Write(ReverseArray(EnsureArrayLength(verifier.ToByteArray, 32)), 0, 32)
stream.Write(userNameAscii, 0, userNameAscii.Length)
stream.WriteByte(0)
Return 65 + userNameAscii.Length
End Function
Public Function CreateAccount(ByVal acctPacket As PacketClass) As Int32
Dim temp(65 + (userName.Length - 1)) As Byte
Dim len As Int32 = CreateAccount(temp, 0, temp.Length)
acctPacket.AddByteArray(temp)
Return len
End Function
Public Function CreateAccount(ByVal buffer() As Byte, ByVal startIndex As Int32, ByVal totalLength As Int32) As Int32
Dim ms As MemoryStream = New MemoryStream(buffer, startIndex, totalLength, True)
Return CreateAccount(MS)
End Function
Public Function ValidateServerSignature(ByVal serverSignature() As Byte, ByVal ipAddress() As Byte) As Boolean
If Not (serverSignature.Length = 128) Then
Throw New ArgumentOutOfRangeException("Resources.nlsSrvSig128")
End If
Dim key As BigInteger = New BigInteger(New Byte() {0, 1, 0, 1}) ' /* ReverseArray(new BigInteger((ulong)SignatureKey).GetBytes()) */);
Dim _mod As BigInteger = New BigInteger(ServerModulus) ', 16) 'Fix modulus
Dim sig As BigInteger = New BigInteger(ReverseArray(serverSignature))
Dim result() As Byte = BigInteger.ModPow(sig, key, _mod).ToByteArray
Dim res As BigInteger = New BigInteger(ReverseArray(result))
Dim ms_res As MemoryStream = New MemoryStream(result.Length)
ms_res.Write(ipAddress, 0, 4)
Dim i As Integer
For i = 4 To result.Length
ms_res.WriteByte(&HBB)
Next
ms_res.Seek(-1, SeekOrigin.Current)
ms_res.WriteByte(&HB)
Dim cor_res As BigInteger = New BigInteger(ms_res.GetBuffer())
ms_res.Close()
Return cor_res.Equals(res)
End Function
Private Sub CalculateVerifier(ByVal serverSalt() As Byte)
Dim unpwexpr As String = String.Concat(userName.ToUpper(CultureInfo.InvariantCulture), ":", password.ToUpper(CultureInfo.InvariantCulture))
Dim unpw_bytes() As Byte = Encoding.ASCII.GetBytes(unpwexpr)
Dim hash1() As Byte = s_sha.ComputeHash(unpw_bytes)
Dim unpw_salt_bytes(serverSalt.Length + hash1.Length) As Byte '// should be 52
Array.Copy(serverSalt, unpw_salt_bytes, serverSalt.Length)
Array.Copy(hash1, 0, unpw_salt_bytes, serverSalt.Length, hash1.Length)
Dim hash2() As Byte = s_sha.ComputeHash(unpw_salt_bytes)
SyncLock (Me)
'//this.salt = serverSalt;
x = New BigInteger(ReverseArray(hash2))
'//x = new BigInteger(hash2);
verifier = BigInteger.ModPow(s_generator, x, s_modulus)
End SyncLock
End Sub
Private Sub CalculateM1(ByVal saltFromServer() As Byte, ByVal issuedServerKey() As Byte)
Dim local_B As BigInteger = New BigInteger(ReverseArray(issuedServerKey))
'//BigInteger local_B = new BigInteger(serverKey);
'// first calculate u.
Dim u_sha() As Byte = s_sha.ComputeHash(issuedServerKey)
Dim u As BigInteger = New BigInteger(u_sha) ', 4)
If (IsNothing(verifier)) Then
CalculateVerifier(saltFromServer)
End If
'// then we need to calculate S.
Dim local_S As BigInteger = ((s_modulus + local_B - verifier) Mod s_modulus)
local_S = BigInteger.ModPow(local_S, (a + (u * x)), s_modulus)
Dim bytes_s() As Byte = EnsureArrayLength(ReverseArray(local_S.ToByteArray), 32)
'//byte[] bytes_s = local_S.GetBytes();
'// now K. yeah, this is weird.
Dim even_s(15) As Byte
Dim odds_s(15) As Byte
Dim i, j As Int32
For i = 0 To (bytes_s.Length - 1) Step 2
even_s(j) = bytes_s(i)
odds_s(j) = bytes_s(i + 1)
j += 1
Next
Dim even_hash() As Byte = s_sha.ComputeHash(even_s)
Dim odds_hash() As Byte = s_sha.ComputeHash(odds_s)
Dim local_k(39) As Byte
For i = 0 To (local_k.Length - 1)
If ((i And 1) = 0) Then
local_k(i) = even_hash(i / 2)
Else
local_k(i) = odds_hash(i / 2)
End If
next
'// finally, m1.
Dim sha_g As BigInteger = New BigInteger(s_sha.ComputeHash(ReverseArray(s_generator.ToByteArray)))
Dim sha_n As BigInteger = New BigInteger(s_sha.ComputeHash(ReverseArray(s_modulus.ToByteArray)))
Dim g_xor_n As BigInteger = sha_g Xor sha_n
Dim ms As MemoryStream = New MemoryStream(40 + saltFromServer.Length + a.ToByteArray.Length + issuedServerKey.Length + local_k.Length)
Dim bw As BinaryWriter = New BinaryWriter(ms)
bw.Write(g_xor_n.ToByteArray)
bw.Write(s_sha.ComputeHash(Encoding.ASCII.GetBytes(userName.ToUpper(CultureInfo.InvariantCulture))))
bw.Write(saltFromServer)
bw.Write(EnsureArrayLength(a.ToByteArray, 32))
'#If DEBUG Then
'If (a.ToByteArray.Length < 32) Then
' DataFormatter.WriteToTrace(a.ToByteArray, "A length less than 32 bytes")
'End If
'#End If
bw.Write(issuedServerKey)
bw.Write(local_k)
Dim m1_data() As Byte = ms.GetBuffer()
ms.Close()
Dim m1_hash() As Byte = s_sha.ComputeHash(m1_data)
SyncLock (Me)
Me.k = local_k
'//this.salt = saltFromServer;
'//this.serverKey = issuedServerKey;
'//this.S = local_S;
m1 = New BigInteger(m1_hash)
End SyncLock
End Sub
Private Function ReverseArray(ByVal arb() As Byte) As Byte()
Dim res(arb.Length) As Byte
Dim i As Int32
For i = 0 To (arb.Length - 1)
res(i) = arb(arb.Length - 1 - i)
Next
Return res
End Function
Private Function EnsureArrayLength(ByVal array() As Byte, ByVal minSize As Int32) As Byte()
If (array.Length < minSize) Then
Dim temp(minSize) As Byte
Buffer.BlockCopy(array, 0, temp, minSize - array.Length, array.Length)
array = temp
End If
Return array
End Function
End Class
End Namespace
Un-Tested conversion, have no means of testing this atm.
Edit: Looking over iago's, this should work still stands as is though for now.
In your data hash function, all of your for loops can be rolled into a single loop:
for (i = 0; i < 80; ++i) {
if (i < 64)
lpdwBuffer [i + 16] = ROL (1, (lpdwBuffer [i] ^ lpdwBuffer [i + 8] ^ lpdwBuffer [i + 2] ^ lpdwBuffer [i + 13]) % 32);
if (i < 20)
g = lpdwBuffer[i] + ROL (a, 5) + e + ((b & c) | (~b & d)) + 0x5a827999lu;
else if (i < 40)
g = (d ^ c ^ b) + e + ROL (g, 5) + lpdwBuffer[i] + 0x6ed9eba1lu;
else if (i < 60)
g = lpdwBuffer[i] + ROL (g, 5) + e + ((c & b) | (d & c) | (d & b)) - 0x70e44324lu;
else
g = (d ^ c ^ b) + e + ROL (g, 5) + lpdwBuffer[i] - 0x359d3e2alu;
e = d;
d = c;
c = ROL (b, 30);
b = a;
a = g;
}