Author | Message | Time |
---|---|---|
dRAgoN | [code]'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. '-------------------------- https://davnit.net/bnet/vL/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[/code] [code]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[/code] [code]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[/code] 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 | May 3, 2010, 12:00 AM |
RealityRipple | 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 ([glow=blue,2,500]"246789BCDEFGHJKMNPRTVWXZ"[/glow]). 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 | May 13, 2010, 3:04 AM |
dRAgoN | [code]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[/code] 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. | May 16, 2010, 12:08 AM |
Yegg | In your data hash function, all of your for loops can be rolled into a single loop: [code] 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; }[/code] | May 16, 2010, 9:12 AM |