http://ersan.us/src/bnetdocs/content636a.html?Section=m&Code=380
I give up on this one for today.
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 If0000: 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]..........Quote[01:13:20][Clan] Your clan has 39 members.
[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]
[01:13:20]Error #-2147220303: Trying to read past end of packet.
[01:13:20]Error: Invalid Battle.Net packet received, ignoring...
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.
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:
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
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
HandlePacketBNCS goes to a big case statement that calls subroutines depending on the Packet ID byte.
Data arrives...
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
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...
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
which then parses the data.
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
I think the error is somewhere in the handoff.
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:
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
It's in the proxy section only. You need to rewrite it.
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 ^^.