[VB] First Locally Hashed Bot

AC_Drkan · January 29, 2005, 10:46 PM

Hey i just finished my Locally Hashed but and im getting this error:


10053 Connection is aborted due to timeout or other failure

I.P. Ban Correct?

Disconnected and reconnected to the internet.

Got the same thing.
I used BNET Docs as a basis for creating the bot.

I check out every locally hashed bot i could get my hands on adn they all say my coding is correct.
Here's the Code:

Code Select


Function GetVerByte(Product As String)
    Select Case LCase(Product)
        Case "pxes":
            VerByte1 = "C5"
        Case "sexp":
            VerByte1 = "C5"
        Case "rats":
            VerByte1 = "C5"
        Case "star":
            VerByte1 = "C5"
        Case Else
            VerByte1 = "C5"
    End Select
    GetVerByte = VerByte1
End Function

Function GetProduct(Product As String)
    Select Case LCase(Product)
        Case "pxes":
            Product2 = "PXES"
        Case "sexp":
            Product2 = "PXES"
        Case "rats":
            Product2 = "RATS"
        Case "star":
            Product2 = "RATS"
        Case Else
            Product2 = "PXES"
    End Select
    GetProduct = Product2
End Function

Function SendProtocolHeader()
On Error Resume Next
'Send What Game your Trying to Connect As
    Dim Product1 As String
    Dim Product2 As String
    Dim VerByte1 As String
    Product1 = ReadINI("Main", "Product", "\" & "config.ini")
    'Get The Version Byte and The Product CORRECTLY!
    VerByte1 = GetVerByte(Product2)
    Product2 = GetProduct(Product1)
    
    frmMain.sckBnet.SendData Chr(1)
    With pbuffer
        .InsertDWORD 0
        .InsertDWORD 0
        .InsertDWORD 0
        .InsertDWORD 0
        .InsertDWORD 0
        .InsertNTString "."
        .InsertNTString "."
        .SendPacket &H1E
        .InsertNonNTString "68XI" & Product2
        .InsertDWORD "&H" & VerByte1
        .InsertDWORD 0
        .SendPacket &H6
        .InsertDWORD &H0
        .SendPacket &H25
    End With
    MsgBox "Sent Protocol Header"
End Function

Sub NullTruncString(ByRef Text As String)
    Dim i As Integer
    i = InStr(Text, Chr(0))
    If i = 0 Then Exit Sub
    Text = Left(Text, i - 1)
End Sub

Function SendCheckRevision(ByVal data As String)
    D = data
    Dim Product1 As String
    Product1 = ReadINI("Main", "Product", "\" & "config.ini")
    'Get The Version Byte and The Product CORRECTLY!
    Product2 = GetProduct(Product1)
    mpqname = Mid(D, InStr(D, "I"), Len(D) - InStr(InStr(D, "I"), D, Chr(0)))
    mpqend = InStr(InStr(D, "I"), D, Chr(0))
    mpqname = Left(mpqname, InStr(mpqname, Chr(0)) - 1)
    Hash = Mid(D, mpqend + 1, InStr(mpqend + 1, D, Chr(0)) - 1)
    Hash = Left(Hash, InStr(Hash, Chr(0)) - 1)
    Dim version As Long
    Dim Checksum As Long
    Dim ExeInfo As String
    Dim Result As Long
    pbuffer.InsertNonNTString "68XI" & Product2
    pbuffer.InsertDWORD "&HC5"
    ExeInfo = Space(256)
    
    Result = CheckRevision(varFiles & "Starcraft.exe", varFiles & "storm.dll", varFiles & "battle.snp", Hash, version, Checksum, ExeInfo, mpqname)
    pbuffer.InsertDWORD version
    pbuffer.InsertDWORD Checksum
    NullTruncString ExeInfo
    pbuffer.InsertNTString ExeInfo
    If ExeInfo = Space(256) Then
        Clear
        Debug.Print "Check Revision Failed"
        Exit Function
    End If
    pbuffer.SendPacket 7
End Function

Sub SendCDKey(CDKey As String)
On Error Resume Next
    Dim lngSeed As Long, lngKey As Long, lngProdID As Long, lngValue1 As Long, lngValue2 As Long, lngValue3 As Long
    Dim dblProdID As Double, dblValue1 As Double, dblValue2 As Double, dblSeed As Double, dblkey As Double
    dblSeed = Val("&h" & StrToHex(StrReverse(serverhash)))
    dblkey = X1
    lngSeed = CLng(dblSeed)
    lngKey = CLng(dblkey)
    Call DecodeCDKey(CDKey, dblProdID, dblValue1, dblValue2)
    lngProdID = CLng(dblProdID)
    lngValue1 = CLng(dblValue1)
    lngValue2 = CLng(dblValue2)
    Call HashCDKey(lngKey, lngSeed, lngProdID, lngValue1, lngValue2)

    pbuffer.InsertDWORD &H0
    pbuffer.InsertDWORD Len(CDKey)
    pbuffer.InsertDWORD CLng(dblProdID)
    pbuffer.InsertDWORD CLng(dblValue1)
    pbuffer.InsertDWORD CLng(dblSeed)
    pbuffer.InsertDWORD CLng(dblkey)
    pbuffer.InsertDWORD lngKey
    pbuffer.InsertDWORD lngSeed
    pbuffer.InsertDWORD lngProdID
    pbuffer.InsertDWORD lngValue1
    pbuffer.InsertDWORD lngValue2
    pbuffer.InsertNTString "- BoX BoT -"
    pbuffer.SendPacket &H36
End Sub

Function DecodeStarcraftKey(ByVal sKey As String) As String
On Error Resume Next
    Dim R As Double, n As Double, n2 As Double, v As Double, _
    v2 As Double, keyvalue As Double, c1 As Byte, c2 As Byte, c As Byte, _
    bValid As Boolean, i As Integer, aryKey(0 To 12) As String
    For i = 1 To 13
        aryKey(i - 1) = Mid$(sKey, i, 1)
    Next i
    v = 3
    For i = 0 To 11
        c = aryKey(i)
        n = Val(c)
        n2 = v * 2
        n = n Xor n2
        v = v + n
    Next i
    v = v Mod 10
    If Hex(v) = aryKey(12) Then
        bValid = True
    End If
    v = 194
    For i = 11 To 0 Step -1
        If v < 7 Then GoTo continue
        c = aryKey(i)
        n = CInt(v / 12)
        n2 = v Mod 12
        v = v - 17
        c2 = aryKey(n2)
        aryKey(i) = c2
        aryKey(n2) = c
    Next i
continue:
    v2 = &H13AC9741
    For i = 11 To 0 Step -1
        c = UCase$(aryKey(i))
        aryKey(i) = c
        If Asc(c) <= Asc("7") Then
            v = v2
            c2 = v And &HFF
            c2 = c2 And 7
            c2 = c2 Xor c
            v = RShift(CLng(v), 3)
            aryKey(i) = c2
            v2 = v
        ElseIf Asc(c) < 65 Then
            c2 = CByte(i)
            c2 = c2 And 1
            c2 = c2 Xor c
            aryKey(i) = c2
        End If
    Next i
    DecodeStarcraftKey = Join(aryKey, "")
    Erase aryKey()
End Function

Private Sub DecodeCDKey(ByVal sCDKey As String, ByRef dProductId As Double, ByRef dValue1 As Double, ByRef dValue2 As Double)
    If Len(sCDKey) = 13 Then sCDKey = DecodeStarcraftKey(sCDKey) Else: Exit Sub
    dProductId = Val("&H" & Left$(sCDKey, 2))
    If Len(sCDKey) = 13 Then
        dValue1 = Val(Mid$(sCDKey, 3, 7))
        dValue2 = Val(Mid$(sCDKey, 10, 3))
    End If
End Sub

Function StrToHex(ByVal String1 As String) As String
On Error Resume Next
    Dim strTemp As String, strReturn As String, i As Long
    For i = 1 To Len(String1)
    strTemp = Hex(Asc(Mid(String1, i, 1)))
    If Len(strTemp) = 1 Then strTemp = "0" & strTemp
    strReturn = strReturn & " " & strTemp
    Next i
    StrToHex = strReturn
End Function

Private Sub SendUsernamePassword()
    Dim dbseed As Double
    Dim dblkey As Double
    Dim dblSeed As Double
    Dim lngSeed As Long
    Dim lngKey As Long
    Dim lngValue1 As Long
    Dim lngValue2 As Long
    Dim lngValue3 As Long
    Dim Name As String, Pass As String
    Name = ReadINI("Main", "Username", "\" & "config.ini")
    Pass = ReadINI("Main", "Password", "\" & "config.ini")
    Randomize
    AAA = Int(Rnd * 5000)
    dblSeed = Val("&h" & StrToHex(StrReverse(serverhash)))
    dblkey = AAA
    lngSeed = CLng(dblSeed)
    lngKey = CLng(dblkey)
    HashPass Pass, Len(Pass), lngKey, lngSeed, lngValue1, lngValue2, lngValue3
    With pbuffer
        .InsertDWORD CLng(dblkey)
        .InsertDWORD CLng(dblSeed)
        .InsertDWORD lngKey
        .InsertDWORD lngSeed
        .InsertDWORD lngValue1
        .InsertDWORD lngValue2
        .InsertDWORD lngValue3
        .InsertNTString User
        .SendPacket , &H29
    End With
    MsgBox "Sent Username"
End Sub

Public Sub ParseBnet(ByVal data As String)
On Error Resume Next
    MsgBox "Parsing " & Mid(data, 5, 1)
    Debug.Print "::..:: " & Hex(Asc(Mid(data, 5, 1)))
    Dim D As String
    Dim tmp As String
    Dim mpqend As Long
    
    Select Case PacketID
        Case &HF
            Check data
        Case &H6
            SendCheckRevision data
        Case &H25
            frmMain.sckBnet.SendData data
        Case &H7
            strData = Mid(data, 5, 1)
            Select Case strData
                Case Chr(2)
                    With pbuffer
                        .SendPacket &H2D
                        '.InsertNonNTString "tenb"
                        '.SendPacket &H14
                    End With
                Case Chr(0)
                    MsgBox "Local Hashing Failed"
                Case Else
                    MsgBox "Bad Client"
            End Select
        Case &H1D
            serverhash = Right(data, 4)
        Case &H2D
            Dim CDKey As String
            CDKey = User = ReadINI("Main", "CD-Key", "\" & "config.ini")
            SendCDKey CDKey
        Case &H30, &H36
            Select Case Mid(data, 5, 1)
                Case Chr(1)
                    SendUsernamePassword
                Case Chr(2)
                    MsgBox "CDKey Invalid Your IPBANNED!": Exit Sub
                Case Chr(3)
                    MsgBox "CDKey Invalid Your IPBANNED!": Exit Sub
                Case Chr(4)
                    MsgBox "CDKey BANNED!": Exit Sub
                Case Chr(5)
                    MsgBox "CDKey in use.": Exit Sub
            End Select
        Case &H29
            If Mid(data, 5, 1) = Chr(1) Then
                Dim User2 As String, Password As String
                User2 = ReadINI("Main", "Username", "\" & "config.ini")
                Pass = ReadINI("Main", "Password", "\" & "config.ini")
                pbuffer.InsertNTString User2
                pbuffer.InsertBYTE 0
                pbuffer.SendPacket &HA
            Else
                MsgBox "Login Failed! -" & User & " / " & Pass
                    Dim Server1 As String
                    Dim Port1 As String
                    Server1 = ReadINI("Main", "Server", "\" & "config.ini")
                    Port1 = ReadINI("Main", "Port", "\" & "config.ini")
                    frmMain.sckBnet.Close
                    frmMain.sckBnet.Connect Server1, Port1
                    MsgBox "Attempting to Connect..."
                Exit Sub
            End If
            Dim Home As String
            Home = ReadINI("Main", "Home Channel", "\" & "config.ini")
            pbuffer.InsertDWORD 2
            pbuffer.InsertNTString Home
            pbuffer.SendPacket &HC
        Case &HA
            Dim spltn() As String
            spltn() = Split(data, Chr(0), 5)
    End Select
Exit Sub
End Sub

Private Sub Check(ByVal DataBuf As String)
MsgBox DataBuf
End Sub

Srry about the Length.
Thats where all winsock events are handled. Its inside of a Module.

EDIT:
Thanks, Changed it but i still get connection forcefully rejected. I think i made an error somewheres in my coding.

Here is the Exact Error And how's its printed:

Code Select


10053 Connection is aborted due to timeout or other failure -2146818235 C:\Program Files\BG3\mswinsck.ocx  0

Printed:

Code Select


Debug.Print Number & " " & Description & " " & Scode & " " & Source & " " & HelpFile & " " & HelpContext

Falcon[anti-yL] · January 29, 2005, 10:50 PM

Quote from: AC_Drkan on January 29, 2005, 10:46 PM
Code Select Expand
Function GetVerByte(Product As String) Select Case LCase(Product) Case "pxes": VerByte1 = "C5" Case "sexp": VerByte1 = "C5" Case "rats": VerByte1 = "C5" Case "star": VerByte1 = "C5" Case Else VerByte1 = "C5" End Select GetVerByte = VerByte1 End Function

The verbyte for SC and BW is C9.

Eric · January 30, 2005, 05:18 PM

You managed to program an entire binary bot without fully understanding Winsock?

iago · January 30, 2005, 05:26 PM

No, that's not an ip ban. It failed when trying to connect to the server. It might be getting blocked at a firewall or router, or you may have mis-typed the server.

Dyndrilliac · January 30, 2005, 05:45 PM

Or he may have idled off/had the connection time-out.

AC_Drkan · January 30, 2005, 10:18 PM

Quote from: LoRd[nK] on January 30, 2005, 05:18 PM
You managed to program an entire binary bot without fully understanding Winsock?

Negarory on that.
I have written about 10 chatbots and they all connected. One my fav's is 1 that joins public channels and spams a 3 line message INDEFINITELY.

Quote from: Dyndrilliac on January 30, 2005, 05:45 PM
Or he may have idled off/had the connection time-out.

Timeout in what way?

Here's the rest of the code

Code Select


Private Sub mnuConnect_Click()
    Dim Server1 As String
    Dim Port1 As String
    Server1 = ReadINI("Main", "Server", "\" & "config.ini")
    Port1 = ReadINI("Main", "Port", "\" & "config.ini")
    frmMain.sckBnet.Close
    frmMain.sckBnet.Connect Server1, Port1
    MsgBox "Attempting to Connect..."
End Sub

Private Sub sckBnet_Connect()
    frmMain.sckBnet.SendData Chr(1)
    SendProtocolHeader
    MsgBox "Connected.."
End Sub

Private Sub sckBnet_DataArrival(ByVal bytesTotal As Long)
Debug.Print bytesTotal
On Error Resume Next
    Dim sS1 As Long
    Dim sS2 As String
    Dim sS3 As String
    Dim i As Integer
    Static strBuffer As String
    Dim strReturn As String
    Dim strTemp As String, lngLen As Long, sVal1 As String
    sckBnet.GetData strTemp, vbString
    strBuffer = strBuffer & strTemp
    While Len(strBuffer) > 4
        lngLen = Val("&H" & StrToHex(StrReverse(Mid(strBuffer, 3, 2))))
        If Len(strBuffer) < lngLen Then Exit Sub
            data = (Left(strBuffer, lngLen))
            PacketID = Asc(Mid(data, 2, 1))
            ParseBnet data
WSDEnd:
            strBuffer = Mid(strBuffer, lngLen + 1)
    Wend
Exit Sub
End Sub

Private Sub sckBnet_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
Debug.Print Number & " " & Description & " " & Scode & " " & Source & " " & HelpFile & " " & HelpContext
End Sub

is in frmmain

Packetbuffer:

Code Select


Private Buffer As String

Public Function InsertDWORD(data As Long)
    Buffer = Buffer & MakeDWORD(data)
End Function
Public Function InsertWORD(data As Integer)
    Buffer = Buffer & MakeWORD(data)
End Function
Public Function InsertBYTE(data As Integer)
    Buffer = Buffer & Chr(data)
End Function
Public Function InsertNTString(data As String)
    Buffer = Buffer & data & Chr(0)
End Function
Public Function InsertNonNTString(data As String)
    Buffer = Buffer & data
End Function
Function MakeDWORD(Value As Long) As String
    Dim Result As String * 4
    CopyMemory ByVal Result, Value, 4
    MakeDWORD = Result
End Function
Function MakeWORD(Value As Integer) As String
    Dim Result As String * 2
    CopyMemory ByVal Result, Value, 2
    MakeWORD = Result
End Function
Public Function Clear()
    Buffer = ""
End Function
Public Function SendPacket(PacketID As Byte)
    frmMain.sckBnet.SendData Chr(&HFF)
    frmMain.sckBnet.SendData Chr(PacketID)
    frmMain.sckBnet.SendData MakeWORD(Len(Buffer) + 4)
    frmMain.sckBnet.SendData Buffer
    Clear
End Function

EDIT To Prevent Double Posting:
I believe the error lies somewhere's in this code:

Code Select


Function SendProtocolHeader()
On Error Resume Next
'Send What Game your Trying to Connect As
    Dim Product1 As String
    Dim Product2 As String
    Dim VerByte1 As String
    Product1 = ReadINI("Main", "Product", "\" & "config.ini")
    'Get The Version Byte and The Product CORRECTLY!
    VerByte1 = GetVerByte(Product2)
    Product2 = GetProduct(Product1)
    
    frmMain.sckBnet.SendData Chr(1)
    With pbuffer
        .InsertDWORD 0
        .InsertDWORD 0
        .InsertDWORD 0
        .InsertDWORD 0
        .InsertDWORD 0
        .InsertNTString "."
        .InsertNTString "."
        .SendPacket &H1E
        .InsertNonNTString "68XI" & Product2
        .InsertDWORD "&H" & VerByte1
        .InsertDWORD 0
        .SendPacket &H6
        .InsertDWORD &H0
        .SendPacket &H25
    End With
    MsgBox "Sent Protocol Header"
End Function

Reason being, is because i downloaded pvpgn to help me in the bot making.
This is the error from pvpgn that i got:

Code Select


Jan 31 08:15:07 [debug] handle_udp_packet: [192] got UDPTEST packet from 127.0.0.1:6112 (myself?)
Jan 31 08:15:07 [error] packet_get_size: packet has bad size 7710
Jan 31 08:15:07 [debug] handle_udp_packet: [192] got UDPTEST packet from 127.0.0.1:6112 (myself?)
Jan 31 08:15:07 [error] packet_get_size: packet has bad size 7710
Jan 31 08:15:07 [warn ] net_recv_packet: [236] corrupted packet received (total_size=0 currsize=4) (closing connection)
Jan 31 08:15:07 [debug] sd_tcpinput: [236] read FAILED (closing connection)
Jan 31 08:15:07 [info ] conn_destroy: [236] closed bnet connection

Joe[x86] · February 04, 2005, 07:08 AM

127.0.0.1:6112 is a localhost battle.net server.
127.0.0.1:xxxxxx is your bot.

LordNevar · February 04, 2005, 08:09 AM

Your correct this entire code structure is wrong. You need to compare this to a packet log, and you will see why.

Code Select

Function SendProtocolHeader()
On Error Resume Next
'Send What Game your Trying to Connect As
    Dim Product1 As String
    Dim Product2 As String
    Dim VerByte1 As String
    Product1 = ReadINI("Main", "Product", "\" & "config.ini")
    'Get The Version Byte and The Product CORRECTLY!
    VerByte1 = GetVerByte(Product2)
    Product2 = GetProduct(Product1)
    
    frmMain.sckBnet.SendData Chr(1)
    With pbuffer
        .InsertDWORD 0
        .InsertDWORD 0
        .InsertDWORD 0
        .InsertDWORD 0
        .InsertDWORD 0
        .InsertNTString "."
        .InsertNTString "."
        .SendPacket &H1E
        .InsertNonNTString "68XI" & Product2
        .InsertDWORD "&H" & VerByte1
        .InsertDWORD 0
        .SendPacket &H6
        .InsertDWORD &H0
        .SendPacket &H25
    End With
    MsgBox "Sent Protocol Header"
End Function

QwertyMonster · February 04, 2005, 08:14 AM

AC_Drkan, if you dont mind me asking, did you code ALL of that yourself?

The DecodeStarcraftCDKEY function seems so like GamerBot source, and so does alot of it.

(Dont mean to offend you

)

Your error is sometimes IPBAN, because i get it alot.

Quote from: JoeTheOdd on February 04, 2005, 07:08 AM
127.0.0.1:6112 is a localhost battle.net server.
127.0.0.1:xxxxxx is your bot.

As Joe said, try putting the correct sc server?

LordNevar · February 04, 2005, 10:57 AM

Quote from: QwertyMonster on February 04, 2005, 08:14 AM
AC_Drkan, if you dont mind me asking, did you code ALL of that yourself?

The DecodeStarcraftCDKEY function seems so like GamerBot source, and so does alot of it.

(Dont mean to offend you )

Your error is sometimes IPBAN, because i get it alot.
Quote from: JoeTheOdd on February 04, 2005, 07:08 AM
127.0.0.1:6112 is a localhost battle.net server.
127.0.0.1:xxxxxx is your bot.

As Joe said, try putting the correct sc server?

He does have the correct server, that info your starring at is from a PVPGN server. Which he stated before that's what he's using to test with. So he's obviously not getting ipbanned if he's running the server from his own machine, which would make it localhost at 127.0.0.1. He's having problems cause as I pointed out before, that packet structure he stated had the problem was correct, that entire packet structure is ate up from the floor up.