Rudimentary Warden information

[l2k-Shadow]

RealityRipple; it errors out saying:

'Run time error '53':

File not found: RSHA.dll'

I attempted registering the RSHA dll via regsvr32, referencing the RSHA dll via VB, both failed.

I'm guessing I'm the one to blame here; so what am I doing wrong? Thanks in advance for your time.

If you're running it out of the IDE, move the RSHA.dll into your folder which contains VB6.exe

[Don Cullen]

Thanks, that solved the problem. Got another error, probably my fault again:

Code Select Expand

        Case &H5E   'SID_WARDEN (0x5E)
            Dim sData As String
            sData = cWarden.HandleWarden(inData)
            If LenB(sData) > 0 Then
              With PacketBuf
                .InsertVOID sData
                .Send BNETSock, &H5E
              End With
            End If

That results in a runtime error '9': subscript out of range. The line "sData = cWarden.HandleWarden(inData)" is highlighted when I click on debug.

This is when I set up the keyhash for warden:

Code Select Expand

            Dim sKeyHash As String
            sKeyHash = lHashedKeyData(0) & lHashedKeyData(1) & lHashedKeyData(2) & lHashedKeyData(3) & lHashedKeyData(4)
            cWarden.StartWarden sKeyHash, "c:\progra~1\starcraft\Starcraft.exe"

Once again, thanks in advance for your time.

[Barabajagal]

InData is set to what? If each lHashKeyData is a string containing 4 characters (I assume?), why not just pass it (0)?

[Don Cullen]

InData isn't set to anything It's set to PacketData now:

Code Select Expand

Private Sub ParseBNETPacket(ByVal PacketData As String)
    Dim PacketID As Byte
    Dim lResults As Long
    Dim sReason As String
    Dim i As Integer    'Used with loops
    PacketDeBuf.SetData (PacketData)
    PacketID = PacketDeBuf.StripHeader

I'm assuming the function requires the packet in its' entireity; or is pre-processing required (stripping out header, etc)?

I highlighted where I'm getting the KeyHash from:

        Case &HC    '0x0C, BNLS_CDKEY_EX
            Dim iTotalCDKeys As Byte
            Dim iTotalSuccesses As Byte
            With PacketDeBuf
                lCookie = .rDWORD
                If lCookie <> lClientCookie Then
                    'Not our cookie.
                    Exit Sub
                End If
                iTotalCDKeys = .rByte
                iTotalSuccesses = .rByte
               
               
                Dim lBitMask As Long
                lBitMask = .rDWORD  'don't use for now
               
                lClientToken = .rDWORD
                lKeyLength = .rDWORD
                lCDKeyProdValue = .rDWORD
                lCDKeyPubValue = .rDWORD
                lUnknown = .rDWORD
                lHashedKeyData(0) = .rDWORD
                lHashedKeyData(1) = .rDWORD
                lHashedKeyData(2) = .rDWORD
                lHashedKeyData(3) = .rDWORD
                lHashedKeyData(4) = .rDWORD
            End With

            Dim sKeyHash As String
            sKeyHash = lHashedKeyData(0) & lHashedKeyData(1) & lHashedKeyData(2) & lHashedKeyData(3) & lHashedKeyData(4)
            cWarden.StartWarden sKeyHash, "c:\progra~1\starcraft\Starcraft.exe"

            With PacketBuf
                .InsertDWORD lClientToken
                .InsertDWORD lEXEVersion
                .InsertDWORD lChecksum
                .InsertDWORD &H1 '1 cdkey for now (number of cdkeys)
                .InsertDWORD &H0 'Not using spawn
               
                'for each cdkey loop goes here
               
                .InsertDWORD lKeyLength
                .InsertDWORD lCDKeyProdValue
                .InsertDWORD lCDKeyPubValue
                .InsertDWORD &H0
                For i = 0 To 4
                    .InsertDWORD lHashedKeyData(i)
                Next
                .InsertSTRING sVerChkStat
                .InsertSTRING "ABot"
                .Send BNETSock, &H51
            End With

Edit: changed code tags to quote tags so highlighting would show up...

Edit: Changed the sKeyHash line, now it says:

Code Select Expand

sKeyHash = Chr(lHashedKeyData(0)) & Chr(lHashedKeyData(1)) & Chr(lHashedKeyData(2)) & Chr(lHashedKeyData(3)) & Chr(lHashedKeyData(4))

Because I realized I was trying to set long variables to a string variable. Added Chr to each one to make it a string. Still errors out though:

"Runtime error '5': Invalid procedure call or argument"

And the sKeyHash line is highlighted when I hit debug. Ideas?

[brew]

K. Do you get that you're only supposed to pass the first four bytes of the key's hash? I'm not exactly sure how many times that's been repeated throughout this topic, and on iago's wiki, but I guestimate somewhere around a total of 20-25.

Code Select Expand


sKeyHash = Chr(lHashedKeyData(0)) & Chr(lHashedKeyData(1)) & Chr(lHashedKeyData(2)) & Chr(lHashedKeyData(3)) & Chr(lHashedKeyData(4))


Really, what's that supposed to do ..? Concatinate raw memory? No. Just no. You'd have to CopyMemory that to a string in order to get your desired result. I'm sure your packet buffer/packet debuffer has that functionality already.

As for your runtime error problem, i think that's because you're passing a negative number to chr(). so just do what i said and i think you'll be fine.

[Barabajagal]

Chr doesn't work like that... And yes, strip the FF 5E XX XX header before passing it. You can send the whole key hash if you want, the code automatically trims it to the first 4 bytes.

[Don Cullen]

Thanks. Got it working.

[brew]

You can send the whole key hash if you want, the code automatically trims it to the first 4 bytes.

That's a poor idea. What happens when the seed's length changes?

[Barabajagal]

Then the whole DLL will be useless anyway. I literally copy and pasted, added a nice ActiveX wrapper around it, and compiled it. Didn't even test it before I sent it to the guy I made it for. Since I already had it compiled and uploaded, I gave a link to it here, too.

[Ringo]

Idk why you keep releaseing all these DLL's ripple, they are very un-educational.
I'm also unsure why you read directly from the exe file, it seems very wastefull.
You hardcode the checksum values, so why not hardcode everything.

Here is a very simple vb6 example of how to handle everything apart from downloading modules. I think everything is explained well enough.
I don't want any credits in pps bots for this, you may use this code as-is or modify it how ever you like.


For parseing the 0x5E packets:
First of all, each bot/connections you have will need its own set of RC4 Keys, example:

Code Select Expand


Private wKeyIn(257) As Byte
Private wKeyOut(257) As Byte

The code below will need access to these two key variables, so you may need to modify the below code to fit around the way you have structured you're bot.

HandleBNCS0x5E() is the sub you pass the whole 0x5E packet to.
SendBNCS0x5E() is the sub where the data to be sent is passed, so this is where you build you're packet as normal.
When you build you're 0x51 packet and have access to the 1st cdkey's broken SHA1 hash, you must do the following:

Code Select Expand


    Call modWarden.WardenInit(GetDWORD(strCDKeyHash), wKeyIn(), wKeyOut())

If you are useing 0x06, 0x07 logon, then do the following:

Code Select Expand


    Call modWarden.WardenInit(0, wKeyIn(), wKeyOut())


Now this is the code where you will be handleing the warden requests, building the responces and passing them to the send0x5E sub.
Depending how you're bot is layed out, you will need to make some small modications to HandleBNCS0x5E(), HandleWardenCheck() and SendBNCS0x5E()
These modications are very simple, they just need access to the current bots wKeyIn() and wKeyOut()

Code Select Expand


Private Sub HandleBNCS0x5E(ByRef strData As String)
    Dim S As String
    S = Mid(strData, 5)
    Call modWarden.RC4Crypt(S, wKeyIn())
    If Asc(S) = 0 Then
        S = Chr(1)
        Call modWarden.RC4Crypt(S, wKeyOut())
        Call SendBNCS0x5e(S)
    ElseIf Asc(S) = 2 Then
        Call HandleWardenCheck(S)
    Else
        '##### This packet ID is not handled, so just ignore it and wait to drop. #####
    End If
End Sub
Private Sub HandleWardenCheck(ByVal S As String)
    Dim R       As String
    Dim C       As String
    Dim lngPos  As Long
    Dim lngLen  As Long
    Dim lngAddr As Long
    Dim lngCmd  As Long
    R = Chr(2) & MakeWORD(0) & MakeDWORD(0)
    lngPos = 3 'skip packet ID
    While lngPos < Len(S)
        lngCmd = GetWORD(Mid(S, lngPos, 2)): lngPos = lngPos + 2
        lngAddr = GetDWORD(Mid(S, lngPos, 4)): lngPos = lngPos + 4
        lngLen = Asc(Mid(S, lngPos, 1)): lngPos = lngPos + 1
        R = R & Chr(0)
        C = C & Right("00000000" & Hex(lngAddr), 8) & Right("00" & Hex(lngLen), 2) & " "
        R = R & GetWardenMem(lngAddr)
    Wend
    C = GetWardenChecksum(C)
    If Len(C) < 4 Then
        '#### This request has checks we don't currently support
        '#### Lets Ignore and wait to drop, it's fun ####
        Exit Sub
    End If
    Mid(R, 4, 4) = C
    Mid(R, 2, 2) = MakeWORD(Len(R) - 7)
    Call modWarden.RC4Crypt(R, wKeyOut())
    Call SendBNCS0x5E(R)
End Sub
Private Function GetWardenChecksum(ByVal S As String) As String
    Select Case S
        Case "00497FB00E 0049C33D07 004A2FF708 ": GetWardenChecksum = MakeDWORD(&H193E73E8)
        Case "0049C33D07 00497FB00E 004A2FF708 ": GetWardenChecksum = MakeDWORD(&HD6557DEF)
        Case "00497FB00E 004A2FF708 0049C33D07 ": GetWardenChecksum = MakeDWORD(&H2183172A)
        Case "0049C33D07 004A2FF708 00497FB00E ": GetWardenChecksum = MakeDWORD(&HCA841860)
        Case "004A2FF708 0049C33D07 00497FB00E ": GetWardenChecksum = MakeDWORD(&H9F2AD2C3)
        Case "004A2FF708 00497FB00E 0049C33D07 ": GetWardenChecksum = MakeDWORD(&HC04CF757)
    End Select
End Function
Private Function GetWardenMem(ByVal lngAddr As Long) As String
    Select Case lngAddr
        Case &H49C33D: GetWardenMem = HexToStr("83 00 00 00 8B 55 08")
        Case &H4A2FF7: GetWardenMem = HexToStr("A3 68 CC 59 00 E8 DF 23")
        Case &H497FB0: GetWardenMem = HexToStr("84 5E 0C 74 05 E8 F6 54 F9 FF 8B 76 04 85")
    End Select
End Function

Public Sub SendBNCS0x5E(ByVal Data As String)
    '#### This is where you build the 0x5E packet, Data contains the payload ####
End Sub






You must create a module called modWarden.
Now paste the below code into it:

Code Select Expand


Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Any, _
    ByRef Source As Any, ByVal NumBytes As Long)

Public Type RANDOMDATA
    Pos   As Long
    Data  As String * 20
    Sorc1 As String * 20
    Sorc2 As String * 20
End Type


Private bR(255) As Byte

Public Sub WardenInit(ByRef lngSeed As Long, ByRef bKeyIn() As Byte, _
    ByRef bKeyOut() As Byte)
    Dim wData       As RANDOMDATA
    Dim wHashOut    As String * 16
    Dim wHashIn     As String * 16
    Call Data_Init(wData, lngSeed)
    wHashOut = modWarden.Data_Get_Bytes(wData, 16)
    wHashIn = modWarden.Data_Get_Bytes(wData, 16)
    Call modWarden.RC4Key(wHashIn, bKeyIn)
    Call modWarden.RC4Key(wHashOut, bKeyOut)
End Sub

Public Sub RC4Key(ByRef S As String, ByRef B() As Byte)
    Dim i As Long, A As Long, C As Byte
    B(256) = 0
    B(257) = 0
    A = Len(S)
    For i = 0 To 255
        bR(i) = Asc(Mid(S, (i Mod A) + 1, 1))
        B(i) = i
    Next i
    A = 0
    For i = 0 To 255
        A = (A + B(i) + bR(i)) Mod 256
        C = B(i)
        B(i) = B(A)
        B(A) = C
    Next i
End Sub
Public Sub RC4Crypt(ByRef S As String, ByRef bK() As Byte)
    Dim A As Long, B As Long, C As Byte, i As Long
    A = bK(256)
    B = bK(257)
    For i = 1 To Len(S)
        A = (A + 1) Mod 256
        B = (B + bK(A)) Mod 256
        C = bK(A)
        bK(A) = bK(B)
        bK(B) = C
        Mid(S, i, 1) = Chr(Asc(Mid(S, i, 1)) Xor bK((CInt(bK(A)) + bK(B)) Mod 256))
    Next i
    bK(256) = A
    bK(257) = B
End Sub

Public Sub Data_Init(ByRef R As RANDOMDATA, ByVal lngSeed As Long)
    Dim S  As String * 4
    Call CopyMemory(ByVal S, lngSeed, 4)
    R.Sorc1 = BSHA1(Left(S, 2), True, True)
    R.Sorc2 = BSHA1(Right(S, 2), True, True)
    R.Data = String(20, 0)
    R.Data = BSHA1(R.Sorc1 & R.Data & R.Sorc2, True, True)
    R.Pos = 1
End Sub
Public Function Data_Get_Bytes(ByRef R As RANDOMDATA, ByVal lngBytes As Long) As String
    Dim i As Long, S As String
    S = String(lngBytes, 0)
    For i = 1 To lngBytes
        Mid(S, i, 1) = Mid(R.Data, R.Pos, 1)
        R.Pos = R.Pos + 1
        If R.Pos > 20 Then
            R.Pos = 1
            R.Data = BSHA1(R.Sorc1 & R.Data & R.Sorc2, True, True)
        End If
    Next i
    Data_Get_Bytes = S
End Function


Public Function BSHA1(ByVal S As String, _
                      Optional ByVal bRE As Boolean = False, _
                      Optional ByVal bStandard As Boolean = False) As String
   
    Dim B(21) As Long 'hash buffer
    Dim i     As Long
   
    '//Init the seeds
    B(0) = &H67452301
    B(1) = &HEFCDAB89
    B(2) = &H98BADCFE
    B(3) = &H10325476
    B(4) = &HC3D2E1F0
   
    '//Update the string buffer (to be hashed)
    Call SHA1Update(bRE, bStandard, B(), S)
   
    '//Reverse endian if needed
    If bRE Then
        For i = 0 To 4
            Call rEndian(B(i), B(i))
        Next i
    End If
   
    '//Return the broken SHA1 hash
    BSHA1 = String(20, 0)
    Call CopyMemory(ByVal BSHA1, B(0), 20)
End Function


Private Sub SHA1Update(ByVal bRE As Boolean, _
                       ByVal bS As Boolean, _
                       ByRef B() As Long, _
                       ByVal S As String)
    Dim i As Long
    Dim A As String
    If bS Then
        '//Standard SHA1 padding
        A = Chr(128) & String((128 - (Len(S) Mod 64) - 9) Mod 64, 0)
        If bRE Then
            S = S & A & String(4, 0) & StrReverse(MakeDWORD((Len(S) * 8)))
        Else
            S = S & A & MakeDWORD((Len(S) * 8)) & String(4, 0)
        End If
    Else
        If ((Len(S) Mod 64) <> 0) Then
            '//buffer the string so its divisible by 64 (0x40)
            S = S & String(64 - (Len(S) Mod 64), 0)
        End If
    End If
    For i = 1 To Len(S) Step 64
        '//copy chunk of the string into the long array to be hashed
        Call CopyMemory(B(5), ByVal Mid$(S, i, 64), 64)
        '//transform
        Call SHA1Transform(bRE, bS, B)
    Next i
End Sub


Private Sub SHA1Transform(ByVal bRE As Boolean, ByVal bS As Boolean, ByRef P() As Long)
    Dim hB(80) As Long
    Dim A      As Long
    Dim B      As Long
    Dim C      As Long
    Dim D      As Long
    Dim E      As Long
    Dim G      As Long
    Dim i      As Long
    If bRE Then 'reverse endian
        For i = 0 To 15: Call rEndian(P(i + 5), hB(i)): Next i
    Else
        For i = 0 To 15: hB(i) = P(i + 5): Next i
    End If
    If bS Then 'standard SHA1
        For i = 16 To 79
            hB(i) = LSC((hB(i - 16) Xor hB(i - 8) Xor hB(i - 14) Xor hB(i - 3)), 1)
        Next i
    Else
        For i = 16 To 79
            hB(i) = LSC(1, (hB(i - 16) Xor hB(i - 8) Xor hB(i - 14) Xor hB(i - 3)) And 31)
        Next i
    End If
    A = P(0)
    B = P(1)
    C = P(2)
    D = P(3)
    E = P(4)
    For i = 0 To 19
        G = Add(Add(Add(Add(hB(i), E), LSC(A, 5)), ((B And C) Or ((Not B) And D))), &H5A827999)
        E = D: D = C: C = LSC(B, 30): B = A: A = G
    Next i
    For i = 20 To 39
        G = Add(Add(Add(Add(hB(i), E), LSC(A, 5)), (D Xor C Xor B)), &H6ED9EBA1)
        E = D: D = C: C = LSC(B, 30): B = A: A = G
    Next i
    For i = 40 To 59
        G = Add(Add(Add(Add(hB(i), E), LSC(A, 5)), (C And B) Or (D And C) Or (D And B)), &H8F1BBCDC)
        E = D: D = C: C = LSC(B, 30): B = A: A = G
    Next i
    For i = 60 To 79
        G = Add(Add(Add(Add(hB(i), E), LSC(A, 5)), (D Xor C Xor B)), &HCA62C1D6)
        E = D: D = C: C = LSC(B, 30): B = A: A = G
    Next i
    P(0) = Add(P(0), A)
    P(1) = Add(P(1), B)
    P(2) = Add(P(2), C)
    P(3) = Add(P(3), D)
    P(4) = Add(P(4), E)
End Sub




'~~~~~~ Extra functions ~~~~~~~
Private Sub rEndian(ByVal V As Long, ByRef N As Long)
    '//dirty byte order switching
    Dim S As String * 4
    Call CopyMemory(ByVal S, V, 4)
    S = StrReverse(S)
    Call CopyMemory(N, ByVal S, 4)
End Sub
Private Function LSC(ByVal N As Long, ByVal S As Long) As Long
    'left shift circle
    LSC = (LS(N, S) Or RS(N, (32 - S)))
End Function
Private Function RS(ByVal N As Long, ByVal S As Long) As Long
    'right shift bits
    If (S < 0) Or (S > 31) Then
        RS = 0
    ElseIf (S = 0) Then
        RS = N
    Else
        If ((N And &H80000000) = &H80000000) Then
            N = (N And &H7FFFFFFF)
            If (S = 31) Then 'stop over flow when shifting 31bits
                N = N / 2147483648#
            Else
                N = N \ (2 ^ S)
            End If
            RS = N Or (2 ^ (31 - S))
        Else
           RS = Int(CDbl(N) / CDbl(2 ^ S))
        End If
    End If
End Function
Private Function LS(ByVal N As Long, ByVal S As Long) As Long
    'left shift bits
    If (S < 0) Or (S > 31) Then
        LS = 0
    ElseIf S = 0 Then
        LS = N
    Else
        N = N And (2 ^ (32 - S) - 1)
        LS = WDbl(CDbl(N) * CDbl(WDbl(2 ^ S)))
    End If
End Function
Private Function WDbl(ByVal N As Double) As Long
    'wrap a double back to a long
    If N > &H7FFFFFFF Then
        N = N - 4294967296#
    ElseIf N < &H80000000 Then
        N = N + 4294967296#
    End If
    WDbl = N
End Function
Private Function Add(ByVal N1 As Long, ByVal N2 As Long, Optional ByVal D As Double) As Long
    'add 2 longs to a double, then wrap round
    D = N1
    D = D + N2
    Add = WDbl(D)
End Function
Public Function MakeDWORD(ByVal num As Long) As String
    MakeDWORD = String(4, &H0)
    Call CopyMemory(ByVal MakeDWORD, num, 4)
End Function
Public Function HexToStr(ByVal Data As String) As String
    HexToStr = String(Len(Data) / 3, 0)
    Dim iPos As Long
    For i = 1 To Len(Data) Step 3
        iPos = iPos + 1
        Mid(HexToStr, iPos, 1) = Chr("&H" & Mid(Data, i, 2))
    Next i
End Function




If you would like to use the BSHA1() sub in modWarden for you're local hashing in the bnet logon, here is a few examples of how to do so:
lngProduct is the product value of the cdkey.
lngPublic is the public value of the cdkey.
lngPrivate is the private value of the cdkey.
S is the 20 byte hash you put into the packet.
Password is you're battle.net password.
For 0x36:

Code Select Expand


    Dim S As String * 20
    Mid(S, 1, 4) = MakeDWORD(ClientToken)
    Mid(S, 5, 4) = MakeDWORD(ServerToken)
    Mid(S, 9, 4) = MakeDWORD(lngProduct)
    Mid(S, 13, 4) = MakeDWORD(lngPublic)
    Mid(S, 17, 4) = MakeDWORD(lngPrivate)
    S = modWarden.BSHA1(S, False, False)


For 0x51:

Code Select Expand


    Dim S2 As String * 24
    Dim S As String * 20
    Mid(S2, 1, 4) = MakeDWORD(ClientToken)
    Mid(S2, 5, 4) = MakeDWORD(ServerToken)
    Mid(S2, 9, 4) = MakeDWORD(lngKeyProduct)
    Mid(S2, 13, 4) = MakeDWORD(lngKeyPublic)
    Mid(S2, 17, 4) = MakeDWORD(0)
    Mid(S2, 21, 4) = MakeDWORD(lngKeyPrivate)
    S = modWarden.BSHA1(S2, False, False)
    '#### WardenInit() with GetDWORD(S) ####


For 0x29/0x3A/0x3E:

Code Select Expand


    Dim S2 As String * 28
    Dim S As String * 20
    S2 = MakeDWORD(ClientToken) & _
         MakeDWORD(ServerToken) & _
         modWarden.BSHA1(LCase(Password), False, False)
    S = modWarden.BSHA1(S2, False, False)


For 0x3D:

Code Select Expand


    Dim S As String * 20
    S = modWarden.BSHA1(LCase(Password), False, False)


[Barabajagal]

Is it really that hard to understand? Most people have no interest in the inner workings of Battle.net. They want to work on their bot, not the protocol. If they want to learn, there's documentation. None of the bnet stuff I release is new; it's all been documented and explained on here or bnetdocs.

[brew]

Is it really that hard to understand? Most people have no interest in the inner workings of Battle.net. They want to work on their bot, not the protocol. If they want to learn, there's documentation. None of the bnet stuff I release is new; it's all been documented and explained on here or bnetdocs.

Well it seems like they have no interest in any part of their bot that doesn't say "<namehere>BoT 1.0 mAdE bY <namehere>" (read: 99.9% of battle.net rips their bots. this is the reason why there is zero innovation.)

[Barabajagal]

And 100% of your statistics are made up on the spot.

Honestly, I don't care. I wrote this DLL for someone who was trying to make the connection system an array in a somewhat complicated manner. I suggested he put the whole thing into a UserControl in order to make it easier to handle multiple connections. He was handling warden with one instance, so it was disconnecting him if he had multiple connections open. I made it into a nice ActiveX DLL so he could easily declare and handle it as an array, and I figured people would like to use it. If people want to use it, they can. If they don't, they can keep their useless opinions to themselves and skip over these posts.

Can a moderator move all the posts after Don's (Except Ringo's, though there's plenty of examples in this topic of the same thing already)?

[Warrior]

Cmon guys, let's not spoil a good thread. Both of you have contributed a great amount of work to this, for this I'm sure many appreciate your efforts. Let's not jump down each others throats over something so trivial.

[Barabajagal]

Wow... I really hope you're not being sarcastic, because that was really nice of you...