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:
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:
10053 Connection is aborted due to timeout or other failure -2146818235 C:\Program Files\BG3\mswinsck.ocx 0
Printed:
Debug.Print Number & " " & Description & " " & Scode & " " & Source & " " & HelpFile & " " & HelpContext
Quote from: AC_Drkan on January 29, 2005, 10:46 PM
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.
You managed to program an entire binary bot without fully understanding Winsock?
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.
Or he may have idled off/had the connection time-out.
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
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:
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:
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:
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
127.0.0.1:6112 is a localhost battle.net server.
127.0.0.1:xxxxxx is your bot.
Your correct this entire code structure is wrong. You need to compare this to a packet log, and you will see why.
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
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?
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.