What's the best way to handle DataArrivals? IIRC, the packets can be separated by popping all incoming data into buffer, and passing packet along to a parser upon getting FF, and that the two bits next to FF is the length of the packet, although AFAIK, wouldn't it be easier to just wait til next FF, and then parse, instead of check to see if the buffer has reached that length and pass it along to parser? Just wondering.
In any case, here's my code so far:
Private Sub bnet_DataArrival(ByVal bytesTotal As Long)
Static PktBuff As String 'Packet Buffer
Dim Incoming As String
Dim PacketLength As Long
BNET.GetData Incoming, vbString
PktBuff = PktBuff & Incoming
AddC vbWhite, "Data recieved."
End Sub
I know what to do when it's the case of coding a chat bot- very easy- just parse for line feeds, as soon as a linefeed is found, pass to parser, remove that line from buffer, and continue feeding the buffer until the process repeats. But in this case (coding a binary bot), I presume it's different. So how would you suggest this be done?
Also, I'd like to apologize in advance if I seem dense- it's my first time coding a binary bot-- once again, thanks in advance for the advice!!! :-)
Quotewouldn't it be easier to just wait til next FF, and then parse, instead of check to see if the buffer has reached that length
That would work fine until a packet was received which contained a 0xFF byte outside of it's header.
I see. I didn't know such a case could happen. Alright, so that idea's out. How can I handle incoming data then? How can I split them up as to pass each packet along to the packet parser?
[Edit: Figured it out, now seeking comments/suggestions on how to improve the sub...]
What do you guys think of this sub, and how can it be improved?:
Private Sub bnet_DataArrival(ByVal bytesTotal As Long)
Static PktBuff As String 'Packet Buffer
Dim Incoming As String
Dim PacketLength As Long
BNET.GetData Incoming, vbString
PktBuff = PktBuff & Incoming
While Len(PktBuff) > 4
PacketLength = Val("&H" & StrToHex(StrReverse(Mid(PktBuff, 3, 2))))
If Len(PktBuff) < PacketLength Then Exit Sub
ParsePacket (Left(PktBuff, PacketLength))
PktBuff = Mid(PktBuff, PacketLength + 1)
Wend
End Sub
This is my first time coding a binary bot, so please pardon me if I seem a bit dense.
This is my bnetparser code-- I've gotten as far as sending 0x50, and am now trying to figure out how to recieve 0x50 and send 0x51 accordingly:
Public Sub ParsePacket(ByVal PacketData As String)
PacketID = Asc(Mid(PacketData, 2, 1))
Select Case PacketID
Case &H0
AddC vbYellow, "BNET: This is null."
P0x0
AddC vbYellow, "DMBOT: Yep."
Case &H25
AddC vbYellow, "BNET: Ping?"
P0x25
AddC vbYellow, "DMBot: Pong!"
Case &H50
AddC vbRed, "BNET is requesting authenication information."
BNETDiscReq = True
DMBot.BNET.Close
AddC vbWhite, "Dumping packet..."
AddC vbGreen, StrToHex(PacketData), vbwhite, " :: ", vbblue, PacketData
AddC vbWhite, "End of packet dump."
AddC vbWhite, "Forced Disconnect to avoid ipban since we haven't done S->C 0x50 nor 0x51 yet."
Call DMBot.BNET_Close
End Select
End Sub
This is what it outputs to the RTF box:
QuoteDMBot activated at [9/11/2005 4:49:05 AM] .
Loading configuration...
Username: Kyro[DM]
Password: *******
CDKey: *************
Client: Starcraft: Brood War
Client VerByte: CD
BNET Server: useast.battle.net
BNET Port: 6112
BNET Default Channel: Clan DM
Config loaded.
Connecting to port 6112 at the useast.battle.net server...
Connected!
Initating packetage...
Notifying server of emulation...
0x01 protocol packet sent.
Server notification done.
Assembling 0x50 Protocol packet...
0x50 SID_AUTH_INFO packet sent.
BNET: Ping?
Assembling 0x25 SID_PING Packet...
0x25 SID_PING packet sent.
DMBot: Pong!
BNET is requesting authenication information.
Dumping packet...
FF 50 63 00 00 00 00 00 06 14 8C 80 87 2C 07 00 00 D9 72 44 25 0B C5 01 49 58 38 36 76 65 72 36 2E 6D 70 71 00 41 3D 37 32 35 35 39 39 32 35 35 20 42 3D 35 39 32 30 39 37 34 33 34 20 43 3D 35 32 38 32 38 39 38 30 35 20 34 20 41 3D 41 2B 53 20 42 3D 42 2B 43 20 43 3D 43 5E 41 20 41 3D 41 5E 42 00 :: ÿPc
End of packet dump.
Forced Disconnect to avoid ipban since we haven't done S->C 0x50 nor 0x51 yet.
Local Disconnect Confirmation.
Thoughts? Constructive criticism, suggestions, and comments are all welcome-- thanks in advance for all input! :-)
Private Sub bnet_DataArrival(ByVal bytesTotal As Long)
Static PktBuff As String 'Packet Buffer
Dim Incoming As String
Dim PacketLength As Long
BNET.GetData Incoming, vbString, bytesTotal
PktBuff = PktBuff & Incoming
While Len(PktBuff) > 3
'PacketLength = Val("&H" & StrToHex(StrReverse(Mid(PktBuff, 3, 2)))) <~ NEWB CODE!!!
'PacketLength = GetWORD(Mid$(PktBuff, 3, 2)) <~ If you don't have that function use the
'CopyMemory (RtlMoveMemory) declare.
RtlMoveMemory PacketLength, ByVal Mid$(PktBuff, 3, 2), 2
If Len(PktBuff) < PacketLength Then Exit Sub
ParsePacket Left$(PktBuff, PacketLength)
PktBuff = Mid$(PktBuff, PacketLength + 1)
Wend
End Sub
Have fun.
@l2k-Shadow-
I noticed you chose to put len at > 3:
While Len(PktBuff) > 3
instead of > 4:
While Len(PktBuff) > 4
If I may ask, what is the difference?
Also, are those functions what you're saying I should use?:
Public Function GetWord(ByVal strVal As String) As Long
Dim Lo As Long
Dim Hi As Long
Lo = Asc(Mid(strVal, 1, 1))
Hi = Asc(Mid(strVal, 2, 1))
GetWord = (Lo * 256) + Hi
End Function
Public Function GetDWord(ByVal strVal As String) As Double
Dim LoWord As Single
Dim HiWord As Single
LoWord = GetWord(Mid(strVal, 1, 2))
HiWord = GetWord(Mid(strVal, 3, 2))
GetDWord = (LoWord * 65536) + HiWord
End Function
I'm asking because I just tried using GetWord, and the DataArrival code doesn't for some reason pass ANYTHING to the parser. This is DataArrival code after your suggested changes:
Private Sub BNET_DataArrival(ByVal bytesTotal As Long)
Static PktBuff As String 'Packet Buffer
Dim Incoming As String
Dim PacketLength As Long
BNET.GetData Incoming, vbString, bytesTotal
PktBuff = PktBuff & Incoming
While Len(PktBuff) > 3
PacketLength = GetWord(Mid$(PktBuff, 3, 2))
If Len(PktBuff) < PacketLength Then Exit Sub
ParsePacket (Left(PktBuff, PacketLength))
PktBuff = Mid(PktBuff, PacketLength + 1)
Wend
End Sub
And this is what I'm getting in the RTF text box output:
QuoteDMBot activated at [9/11/2005 12:28:55 PM] .
Loading configuration...
Username: Kyro[DM]
Password: ********
CDKey: **************
Client: Starcraft: Brood War
Client VerByte: CD
BNET Server: useast.battle.net
BNET Port: 6112
BNET Default Channel: Clan DM
Config loaded.
Connecting to port 6112 at the useast.battle.net server...
Connected!
Initating packetage...
Notifying server of emulation...
0x01 protocol packet sent.
Server notification done.
Assembling 0x50 Protocol packet...
0x50 SID_AUTH_INFO packet sent.
After the 0x50 packet is sent, it simply stays silent, indicating nothing was passed to the parser, thus indicating there's something wrong with the GetWord function I obtained...
Thanks for your help thus far!
your getWORD function is faulty.
Public Function GetWord(ByVal strVal As String) As Long
Dim Lo As Long
Dim Hi As Long
Lo = Asc(Mid(strVal, 1, 1))
Hi = Asc(Mid(strVal, 2, 1))
GetWord = (Lo * 256) + Hi
End Function
Should be
Public Function GetWord(ByVal strVal As String) As Long
Dim Lo As Intager
Dim Hi As Intager
Lo = Asc(Mid(strVal, 1, 1))
Hi = Asc(Mid(strVal, 2, 1))
GetWord = (Hi * 256) + Lo
End Function
Why you dont jsut use CopyMemory.. I dont know.
You were switching the Lo and Hi in the last line from what nthey should be.
also the reason he used 3 insted of 4 is cuz some BNCS packes are only 4 in klengeth. And >4 would ignore those. >3 is the same thing as >=4
~-~(HDX)~-~
Understood. And my bot already uses CopyMemory-- I just want to use the GetWord and GetDWord functions, because the more I can make myself think in terms of binary, the easier it is for me to understand this stuff-- it's my first time coding a binary bot after all.
@HdxBmx27-
Based on the changes you made, would that also mean my GetDWord function is faulty, and as thus should be changed to:
Public Function GetDWord(ByVal strVal As String) As Double
Dim LoWord As Single
Dim HiWord As Single
LoWord = GetWord(Mid(strVal, 1, 2))
HiWord = GetWord(Mid(strVal, 3, 2))
GetDWord = (HiWord * 65536) + LoWord
End Function
Thanks again for the such prompt responses- this forum, and you people are very excellent, and extremely helpful!
Public Type BNCSPKT
bytPktHdr As Byte
bytPktID As Byte
intPktLen As Integer
strPktData As String
End Type
' Removes individual packets from the incoming TCP/IP stream and passes them to functions to parse them
Public Sub PreParse(ByRef strData As String, ByVal lngLen As Long)
Dim pkt As modBNCS.BNCSPKT
lngLstBeat = GetTickCount()
bMsdBeats = 0
' Store incoming data stream in buffer
With PktInBuf
.InsertRAW strData
If (.LastErr() > 0) Then
.ClearBuf
Exit Sub
End If
' Remove packet(s) from buffer
While (.BufSize() >= 4)
If (.PeekBYTE() <> &HFF) Then
' Packet has an invalid header
.ClearBuf
Exit Sub
End If
pkt.intPktLen = .PeekWORD(3)
If (pkt.intPktLen > .BufSize()) Then
' Incomplete packet
Exit Sub
End If
Call CopyMemory(pkt, ByVal .GetRAW(4), 4)
pkt.strPktData = .GetRAW((pkt.intPktLen - 4))
Call ParsePkt(pkt)
Wend
End With
End Sub
Interesting stuff...
Thanks for all of the responses, it is much appreciated!
I Use While Len(Buffer) > 3 because some packets are blank (0x00), meaning they will only be 4 characters long and I assume you'd like to parse those too, no? ;P
lol yeah... :) i changed it to 3 now. the dataarrival part is done, it's the 0x51 packet i'm struggling with. and i'm afraid to test it once I get it assembled, because i don't want to get ipbanned...
know of any server i can test bot on without gettin ipbanned?