• Welcome to Valhalla Legends Archive.
 

[Solved][VB] DataArrival Sub

Started by Don Cullen, September 11, 2005, 03:01 AM

Previous topic - Next topic

Don Cullen

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!!! :-)
Regards,
Don
-------

Don't wonder why people suddenly are hostile when you treat them the way they shouldn't be- it's called 'Mutual Respect'.

Eric

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.

Don Cullen

#2
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! :-)
Regards,
Don
-------

Don't wonder why people suddenly are hostile when you treat them the way they shouldn't be- it's called 'Mutual Respect'.

l2k-Shadow

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.
Quote from: replaced on November 04, 2006, 11:54 AM
I dunno wat it means, someone tell me whats ix86 and pmac?
Can someone send me a working bot source (with bnls support) to my email?  Then help me copy and paste it to my bot? ;D
Já jsem byl určenej abych tady žil,
Dával si ovar, křen a k tomu pivo pil.
Tam by ses povídaj jak prase v žitě měl,
Já nechci před nikym sednout si na prdel.

Já nejsem z USA, já nejsem z USA, já vážně nejsem z USA... a snad se proto na mě nezloběj.

Don Cullen

@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!
Regards,
Don
-------

Don't wonder why people suddenly are hostile when you treat them the way they shouldn't be- it's called 'Mutual Respect'.

Hdx

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)~-~

Proud host of the JBLS server www.JBLS.org.
JBLS.org Status:
JBLS/BNLS Server Status

Don Cullen

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!
Regards,
Don
-------

Don't wonder why people suddenly are hostile when you treat them the way they shouldn't be- it's called 'Mutual Respect'.

Eric

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

Don Cullen

Interesting stuff...

Thanks for all of the responses, it is much appreciated!
Regards,
Don
-------

Don't wonder why people suddenly are hostile when you treat them the way they shouldn't be- it's called 'Mutual Respect'.

l2k-Shadow

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
Quote from: replaced on November 04, 2006, 11:54 AM
I dunno wat it means, someone tell me whats ix86 and pmac?
Can someone send me a working bot source (with bnls support) to my email?  Then help me copy and paste it to my bot? ;D
Já jsem byl určenej abych tady žil,
Dával si ovar, křen a k tomu pivo pil.
Tam by ses povídaj jak prase v žitě měl,
Já nechci před nikym sednout si na prdel.

Já nejsem z USA, já nejsem z USA, já vážně nejsem z USA... a snad se proto na mě nezloběj.

Don Cullen

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?
Regards,
Don
-------

Don't wonder why people suddenly are hostile when you treat them the way they shouldn't be- it's called 'Mutual Respect'.