| Author | Message | Time |
|---|---|---|
| raylu | http://ersan.us/src/bnetdocs/content636a.html?Section=m&Code=380 I give up on this one for today. [code] Case &H7D 'SID_CLANMEMBERLIST Dim numMembers As Integer, User As String, Rank As String, Status As String, cMem As Integer P.Skip 4 'cookie numMembers = P.GetByte If DisClan Then frmMain.AddChat "[Clan] Your clan has " & numMembers & " members.", LBlue frmMain.lstClan.ListItems.Clear 'clear clan list Dim cl As New ClanList Dim Index As Integer, shamanIndex As Integer, shamanCount As Integer, gruntCount As Integer 'used to keep track of how to place users in the clan tab shamanIndex = 1 cMem = 0 While (cMem < numMembers) And (P.Position < P.LenData) User = P.GetString AddChat User Rank = getRank(P.GetByte) Status = getStatus(P.GetByte) P.GetString 'ignore location If autoClanRank Then clanAccessCheck User, Rank, Status 'add to clan listview With frmMain.lstClan Select Case Rank 'pick place in clan list based on rank Case "Chieftan" Index = 1 shamanIndex = 2 'bump back placement for shaman Case "Shaman" Index = shamanIndex shamanCount = shamanCount + 1 Case "Grunt" gruntCount = gruntCount + 1 Index = shamanIndex + shamanCount Case "Peon" Index = shamanIndex + shamanCount + gruntCount Case Else Index = .ListItems.count + 1 End Select .ListItems.add Index, , User, Rank, Rank .ListItems.Item(Index).ListSubItems.add , , , Status, Status .ListItems.Item(Index).tag = Rank .ListItems.Item(Index).ToolTipText = "(" & Rank & ") " & User & " - " & Status cl.addMember User End With cMem = cMem + 1 Wend If autoClanRank Then Dim c() As String c = cl.getClanList If numMembers > 0 Then clearNotInClan c End If[/code] [code]0000: FF 7D 50 02 6D AE C0 01 27 42 65 72 7A 65 72 6B ÿ}Pm®À'Berzerk 0010: 65 72 2D 54 65 63 68 00 04 00 00 42 65 72 7A 65 er-Tech...Berze 0020: 72 6B 65 72 2D 74 65 63 68 32 00 02 00 00 44 72 rker-tech2...Dr 0030: 61 63 6F 5B 48 44 5D 00 02 00 00 54 65 63 68 2D aco[HD]...Tech- 0040: 44 72 61 63 6F 00 02 00 00 53 42 53 50 50 52 54 Draco...SBSPPRT 0050: 43 52 45 41 54 49 4E 00 01 00 00 53 42 53 43 52 CREATIN...SBSCR 0060: 45 41 54 49 4E 47 52 4F 46 4C 00 01 00 00 53 42 EATINGROFL...SB 0070: 53 43 52 45 41 54 49 4E 47 4C 4D 41 4F 00 01 00 SCREATINGLMAO.. 0080: 00 69 64 69 61 74 2D 54 65 63 68 00 02 00 00 51 .idiat-Tech...Q 0090: 75 69 6B 48 65 6C 70 00 02 00 00 76 68 6F 6C 7A uikHelp...vholz 00A0: 61 69 78 00 02 00 00 4C 75 43 31 46 72 2D 54 65 aix...LuC1Fr-Te 00B0: 63 68 00 02 01 00 54 65 63 68 2D 52 65 74 61 69 ch..Tech-Retai 00C0: 6E 00 02 00 00 44 69 73 74 61 6E 74 2E 45 63 68 n...Distant.Ech 00D0: 6F 00 03 01 00 47 6F 64 5F 4F 66 5F 53 6C 61 59 o..God_Of_SlaY 00E0: 65 72 53 00 02 00 00 54 65 63 68 2D 4A 61 63 6B erS...Tech-Jack 00F0: 29 00 03 01 00 54 65 63 68 2D 53 68 6F 74 47 75 )..Tech-ShotGu 0100: 6E 00 02 00 00 76 68 6F 6C 73 65 78 00 02 00 00 n...vholsex... 0110: 54 65 63 68 2D 53 77 65 6E 74 00 03 00 00 54 65 Tech-Swent...Te 0120: 63 68 2D 49 72 4F 6E 4D 61 4E 00 02 00 00 5A 65 ch-IrOnMaN...Ze 0130: 72 67 54 65 63 68 49 00 02 00 00 48 65 6C 70 42 rgTechI...HelpB 0140: 6F 74 5B 53 42 73 5D 00 02 00 00 4A 6F 65 2D 54 ot[SBs]...Joe-T 0150: 65 63 68 00 02 00 00 55 77 46 2E 53 6B 75 6C 6C ech...UwF.Skull 0160: 00 02 00 00 48 64 78 47 6E 6F 6D 69 65 00 02 00 ...HdxGnomie.. 0170: 00 74 65 63 68 2D 76 68 6F 6C 7A 61 69 78 00 02 .tech-vholzaix. 0180: 00 00 53 74 65 61 6C 74 68 00 03 00 00 57 61 72 ..Stealth...War 0190: 54 61 6E 6B 73 2D 54 65 63 68 00 02 00 00 42 61 Tanks-Tech...Ba 01A0: 72 30 6E 56 30 6E 50 30 30 70 00 02 00 00 54 65 r0nV0nP00p...Te 01B0: 63 68 2D 48 61 73 74 65 00 02 00 00 43 49 41 50 ch-Haste...CIAP 01C0: 72 6F 64 75 63 74 69 6F 6E 73 00 02 00 00 54 65 roductions...Te 01D0: 63 68 2D 72 61 79 6C 75 00 03 01 00 54 65 63 68 ch-raylu..Tech 01E0: 2D 54 69 4E 4D 61 4E 00 02 00 00 6C 33 65 72 7A -TiNMaN...l3erz 01F0: 65 72 6B 65 72 00 02 00 00 53 42 73 2D 72 61 79 erker...SBs-ray 0200: 6C 75 5B 31 5D 00 02 00 00 53 42 73 2D 72 61 79 lu[1]...SBs-ray 0210: 6C 75 5B 32 5D 00 02 00 lu[2]..........[/code] [quote][color=blue][01:13:20][Clan] Your clan has 39 members.[/color] [01:13:20]Berzerker-Tech [01:13:20]Berzerker-tech2 [01:13:20]Draco[HD] [01:13:20]Tech-Draco [01:13:20]SBSPPRTCREATIN [01:13:20]SBSCREATINGROFL [01:13:20]SBSCREATINGLMAO [01:13:20]idiat-Tech [01:13:20]QuikHelp [01:13:20]vholzaix [01:13:20]LuC1Fr-Tech [01:13:20]Tech-Retain [01:13:20]Distant.Echo [01:13:20]God_Of_SlaYerS [01:13:20]Tech-Jack) [01:13:20]Tech-ShotGun [01:13:20]vholsex [01:13:20]Tech-Swent [01:13:20]Tech-IrOnMaN [01:13:20]ZergTechI [01:13:20]HelpBot[SBs] [01:13:20]Joe-Tech [01:13:20]UwF.Skull [01:13:20]HdxGnomie [01:13:20]tech-vholzaix [01:13:20]Stealth [01:13:20]WarTanks-Tech [01:13:20]Bar0nV0nP00p [01:13:20]Tech-Haste [01:13:20]CIAProductions [01:13:20]Tech-raylu [01:13:20]Tech-TiNMaN [01:13:20]l3erzerker [01:13:20]SBs-raylu[1] [01:13:20]SBs-raylu[2] [color=red][01:13:20]Error #-2147220303: Trying to read past end of packet. [01:13:20]Error: Invalid Battle.Net packet received, ignoring...[/color][/quote] According to, http://www.battle.net/war3/ladder/war3-clan-profile.aspx?Gateway=Azeroth&ClanTag=SBs, there are indeed 39 members. However, the packet only gave me 35 of them. | March 21, 2007, 6:15 AM |
| Barabajagal | I have the feeling your packet buffer is screwed up. The packet header says it's 0x250 (592) bytes. I count 536 bytes in your log. Edit: This may be of help. This is how I handle packets: [code]Private Sub wsBNCS_DataArrival(ByVal bytesTotal As Long) Dim strData As String On Error GoTo Erred wsBNCS.GetData strData, vbString, bytesTotal DataArrivalBNCS strData Exit Sub Erred: RaiseEvent CritError(Err.Description, Err.Number, Err.Source, "wsBNCS DataArrival") End Sub[/code] [code]Private Sub DataArrivalBNCS(ByVal strTemp As String) Static strBuffer As String Dim lngLen As Long Dim bytPacketType As Byte Dim bytPacketID As Byte On Error GoTo Erred If Len(strTemp) = 0 Then Exit Sub If Len(strTemp) = 8 And IsOnline = False And Config.Proxy.UseProxy And Config.Proxy.Socks = Socks4 Then If (Asc(Left$(strTemp, 1)) = &H0) Or (Asc(Left$(strTemp, 1)) = &H4) Then HandleBNCSSOCKS4 Asc(Mid$(strTemp, 2, 1)) Exit Sub End If End If If Len(strTemp) > 1 And (Asc(Left$(strTemp, 1)) = &H5) And IsOnline = False And Config.Proxy.UseProxy And Config.Proxy.Socks = Socks5 Then HandleBNCSSOCKS5 Asc(Mid$(strTemp, 2, 1)) Exit Sub End If strBuffer = strBuffer & strTemp While Len(strBuffer) > 2 lngLen = Val("&H" & StringToHex(StrReverse(Mid$(strBuffer, 3, 2)))) If (Len(strBuffer) < lngLen) Or (lngLen < 0) Then Exit Sub Packet.SetData Left$(strBuffer, lngLen) strBuffer = Mid$(strBuffer, lngLen + 1) bytPacketType = Packet.GetByte bytPacketID = Packet.GetByte lngLen = Packet.GetWORD If bytPacketType = &HFF Then HandlePacketBNCS bytPacketID Else RaiseEvent Error("Unrecognized packet " & Packet.PeekPacket) End If Wend Exit Sub Erred: RaiseEvent CritError(Err.Description, Err.Number, Err.Source, "DataArrivalBNCS") End Sub[/code] HandlePacketBNCS goes to a big case statement that calls subroutines depending on the Packet ID byte. | March 21, 2007, 6:33 AM |
| raylu | Data arrives... [code]Private Sub sckBnet_DataArrival(ByVal bytesTotal As Long) ipBanned = False Dim strTemp As String, lnglen As Long If UseProxy Then Static strbuffer As String If TCP.dbug Then AddChat "BNETData:" & strTemp sckBnet.GetData strTemp, vbString Select Case Mid$(strTemp, 1, 2) Case Chr(&H0) & Chr(&H5A) AddChat "SOCKS request granted!", vbGreen TCP.SendHeader TCP.Send0x50 Exit Sub Case Chr(&H0) & Chr(&H5B) AddChat "SOCKS request rejected or failed.", Orange sckBnet.Close Timer1.enabled = False Exit Sub Case Chr(&H0) & Chr(&H5C) AddChat "SOCKS request rejected because SOCKS server could not IDENT the client (not a public server?).", Orange sckBnet.Close Timer1.enabled = False Exit Sub Case Chr(&H0) & Chr(&H5D) AddChat "SOCKS request rejected Because the client program and the IDENT report different IDs (why are you running a IDENT server?).", Orange sckBnet.Close Timer1.enabled = False Exit Sub End Select strbuffer = strbuffer & strTemp 'bnet w/ proxy While Len(strbuffer) > 4 lnglen = Val("&H" & StrToHex(StrReverse(Mid$(strbuffer, 3, 2)))) If Len(strbuffer) < lnglen Then Exit Sub TCP.ParseBNET Left$(strbuffer, lnglen), lnglen strbuffer = Mid$(strbuffer, lnglen + 1) Wend Else 'normal bnet sckBnet.GetData strTemp, vbString TCP.ParseBNET strTemp, bytesTotal End If End Sub[/code] I hand it to the ParseBNET sub, which has 2 select cases (for normal stuff and connection stuff). If it determines it still hasn't been parsed, it hands it to the WC3 parser... [code]Public Sub ParseBNET(Data As String, Length As Long) On Error GoTo parseError: Dim parsed As Boolean Dim Position As Long, P As Packet, PacketID As Byte, PacketLength As Long Set P = New Packet P.SetData Data 'P.RaiseOverflowErrors = True Do While Position < Length If (P.GetByte() <> &HFF) Then AddChat "Error: Invalid Battle.Net packet received, ignoring...", Orange Exit Sub End If PacketID = P.GetByte PacketLength = P.GetWORD parsed = True Select Case PacketID Case &H0 'SID_NULL PB.SendBNCSPacket &H0 [etc...] Case Else parsed = False End Select If parsed Then GoTo nextPacket parsed = True 'Connection sequence Select Case PacketID Case &HA 'SID_ENTERCHAT cUsername = KillNull(P.GetString) Call onLogon P.GetString 'ignore P.GetString [etc...] Case Else parsed = False End Select If Not parsed Then If Not (war3 Is Nothing) Then parsed = war3.ParseClanInfo(P, PacketID) If dbug Then parsed = True If (Not parsed) And Beta Then DebugLog "BNET: Unknown packet ID:" & Hex(PacketID) DebugLog DebugOutput(Data) AddChat "BNET: Unknown packet ID:" & Hex(PacketID), Orange AddChat DebugOutput(Data), vbYellow End If End If nextPacket: Position = Position + PacketLength Loop Exit Sub parseError: If err.Number = 53 Then 'file not found error>most likely Bnetauth If InStr(LCase(err.Description), "bncsutil.dll") > 0 Then AddChat "Error: BNCSutil.dll not found! You must place bncsutil.dll in your bot folder in order to complete account logons. " & err.Description, Orange Exit Sub End If End If AddChat "Error #" & err.Number & ": " & err.Description & vbCrLf, Orange DebugLog "Error #" & err.Number & ": " & err.Description & vbCrLf DebugLog DebugOutput(Data) End Sub[/code] which then parses the data. [code]Function ParseClanInfo(ByRef P As Packet, ByVal PID As Byte) P.RaiseOverflowErrors = True ParseClanInfo = True AddChat DebugOutput(P.GetData) Dim oRank As String, Stat As String Select Case PID Case &H70 'SID_CLANFINDCANDIDATES Dim statusByte As Integer, userCount As Integer, clanUsers() As String With P .Skip 4 'cookie statusByte = .GetByte userCount = .GetByte clanUsers = .GetStringArray(userCount) [etc...] Case Else ParseClanInfo = False End Select End Function[/code] I think the error is somewhere in the handoff. | March 21, 2007, 5:19 PM |
| Barabajagal | If the entire packet isn't sent in one thing, it doesn't look like you store it up until the whole packet's there. Not all packets are sent in one big thing. If the packet length is greater than the packet you have, you need to expect more data. Edit: Found your problem while talking to HDX about it: your strBuffer: [code] While Len(strbuffer) > 4 lnglen = Val("&H" & StrToHex(StrReverse(Mid$(strbuffer, 3, 2)))) If Len(strbuffer) < lnglen Then Exit Sub TCP.ParseBNET Left$(strbuffer, lnglen), lnglen strbuffer = Mid$(strbuffer, lnglen + 1) Wend[/code] It's in the proxy section only. You need to rewrite it. | March 21, 2007, 9:24 PM |
| raylu | Thanks. I thought it might be that, but it never happened for any other packets and I didn't want to deal with it. I actually managed to fix the code on my first try ^^. | March 22, 2007, 7:26 PM |