Skip to content
Permalink
Browse files

Fix friend list handling

- Converted friend list handler parsing to use a data buffer instead of
doing it manually, the old way.
- Fixed the automatic requesting of friend list updates.
- All friend list related packets are now handled. (SID_FRIENDSPOSITION
still requests the full listing)
- Changed auto update interval to 5 minutes.
- Fixed the full listing being requested twice when adding/removing
friends.
- The full list is no longer requested when receiving a normal friend
packet (add/remove/update). These packets are just handled directly.
- GAME field is ignored from SID_FRIENDSUPDATE due to server bug.
  • Loading branch information...
Davnit committed Apr 27, 2016
1 parent 96031ee commit e74d71f4d4a4ab6ddee1116ab770c98fe09c2373
Showing with 126 additions and 172 deletions.
  1. +103 −146 trunk/clsFriendlistHandler.cls
  2. +20 −23 trunk/frmChat.frm
  3. +3 −3 trunk/modEvents.bas
@@ -13,27 +13,21 @@ Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'clsClanPacketHandler - project StealthBot - authored by Stealth (stealth@stealthbot.net)

'Special thanks:
'- Ethereal packetlogger was used in my own research
'- thanks to Arta[vL] and BNetDocs (http://bnetdocs.valhallalegends.com) for additional assistance

Private Const SID_FRIENDLIST& = &H65
Private Const SID_FRIENDUPDATE& = &H66
Private Const SID_FRIENDADDED& = &H67
Private Const SID_FRIENDREMOVED& = &H68
Private Const SID_FRIENDMOVED& = &H69
Private Const SID_FRIENDSLIST& = &H65
Private Const SID_FRIENDSUPDATE& = &H66
Private Const SID_FRIENDSADD& = &H67
Private Const SID_FRIENDSREMOVE& = &H68
Private Const SID_FRIENDSPOSITION& = &H69

Public Event FriendUpdate(ByVal Username As String, ByVal FLIndex As Byte)
Public Event FriendAdded(ByVal Username As String, ByVal Product As String, ByVal Location As Byte, _
ByVal Status As Byte, ByVal Channel As String)
Public Event FriendRemoved(ByVal Username As String)
Public Event FriendListReceived(ByVal FriendCount As Byte)
Public Event FriendListEntry(ByVal Username As String, ByVal Product As String, ByVal Channel As String, _
ByVal Status As Byte, ByVal Location As Byte)
Public Event FriendMoved()


Private Sub Class_Initialize()
Set g_Friends = New Collection
End Sub
@@ -46,191 +40,143 @@ End Sub
Public Sub ParsePacket(ByVal PacketID As Long, ByRef Data As String)
On Error GoTo ERROR_HANDLER

Dim n As Integer, bytTemp As Byte
Dim s As String
Dim Position As Long
Dim pBuff As New clsDataBuffer
Dim flTemp As clsFriendObj

Position = 1
Dim n As Integer

pBuff.Data = Data

Select Case PacketID
Case SID_FRIENDLIST
Set g_Friends = New Collection

Case SID_FRIENDSLIST
'0x65 packet format
'(BYTE) Number of Entries
n = Asc(Mid$(Data, 1, 1))

'For each entry:
'(STRING) Account
'(BYTE) Status
'(BYTE) Location
'(DWORD) ProductID
'(STRING) Location name

Call ResetList

Position = 2
'Set flTemp = Nothing
n = pBuff.GetByte() ' Number of entries
RaiseEvent FriendListReceived(n)

If (n > 0) Then

'For each entry
For n = 0 To n - 1
'If (g_Friends.Count > n) Then
' Set flTemp = g_Friends(n + 1)
'Else
Set flTemp = New clsFriendObj
'End If
''debug.print DebugOutput(Mid$(Data, Position)) & vbCrLf
s = ""

Set flTemp = New clsFriendObj

With flTemp
'For each entry:
'(STRING) Account
s = KillNull(Mid$(Data, Position))
.Name = s
'debug.print "Username: " & s
Position = Position + Len(.Name) + 1 'account for chr(0) at end
'debug.print "Position incremented " & Len(.Name) + 1 & " to " & Position

'(BYTE) Status
bytTemp = Asc(Mid$(Data, Position, 1))
.Status = bytTemp
Position = Position + 1

'debug.print "Status: " & .Status
'debug.print "Position incremented 1 to " & Position

'(BYTE) Location
bytTemp = Asc(Mid$(Data, Position, 1))
.LocationID = bytTemp
Position = Position + 1

'debug.print "Location: " & .Location
'debug.print "Position incremented 1 to " & Position
.Name = pBuff.GetString() ' Account
.Status = pBuff.GetByte() ' Status
.LocationID = pBuff.GetByte() ' Location

'(DWORD) ProductID
s = Mid$(Data, Position, 4)
If Conv(s) = 0 Then
' Product ID
.Game = StrReverse(pBuff.GetRaw(4))
If Conv(.Game) = 0 Then
.Game = "OFFL"
Else
.Game = StrReverse(s)
End If
Position = Position + 4

'debug.print "ProductID: " & .Game
'debug.print "Position incremented 4 to " & Position

'(STRING) Channel
s = KillNull(Mid$(Data, Position))
Position = Position + Len(s) + 1
.Location = s
' Location name
.Location = pBuff.GetString()
End With

''debug.print "Successfully added: " & flTemp.Name

'If (g_Friends.Count > n) Then
' RaiseEvent FriendUpdate(flTemp.DisplayName, n + 1)
'Else
g_Friends.Add flTemp

'frmChat.AddChat vbRed, flTemp.Name & ":" & flTemp.DisplayName

RaiseEvent FriendListEntry(flTemp.DisplayName, flTemp.Game, flTemp.Location, flTemp.Status, _
flTemp.LocationID)
'End If

' Add to the internal list
g_Friends.Add flTemp

RaiseEvent FriendListEntry(flTemp.DisplayName, flTemp.Game, flTemp.Location, flTemp.Status, _
flTemp.LocationID)

Set flTemp = Nothing

Next n
End If

Case SID_FRIENDUPDATE
Exit Sub

Case SID_FRIENDSUPDATE
'0x66 packet format
'(BYTE) Entry number
n = Asc(Mid$(Data, Position, 1)) + 1
'(BYTE) Status
'(BYTE) Location
'(DWORD) ProductID
'(STRING) Location name

Position = 2 ' Position + 1
n = pBuff.GetByte() + 1

With g_Friends(n)
'(BYTE) Flags
bytTemp = Asc(Mid$(Data, Position, 1))
Position = Position + 1
.Status = bytTemp
.Status = pBuff.GetByte() ' Status
.LocationID = pBuff.GetByte() ' Location

'(BYTE) Location
bytTemp = Asc(Mid$(Data, Position, 1))
Position = Position + 1
.LocationID = bytTemp

'(DWORD) Product ID
s = Mid$(Data, Position, 4)
Position = Position + 4
.Game = StrReverse(s)

'(STRING) Location str (blank = private)
s = Mid$(Data, Position)
' NOTE: There is a server bug here where, when this packet is sent automaticlaly
' (not requested), the ProductID field contains your own product instead.
' Because of this, we ignore that field completely and wait for the periodic updates
' to update the value.
' (see: https://bnetdocs.org/packet/384/sid-friendsupdate)

If (Len(s) > 1) Then
s = Left$(s, Len(s) - 1)
End If
pBuff.GetDWORD
' Product ID
'.Game = StrReverse(pBuff.GetRaw(4))
'If Conv(.Game) = 0 Then
' .Game = "OFFL"
'End If

.Location = IIf(LenB(s) > 0, s, "(private)")
' Location name
.Location = pBuff.GetString()

RaiseEvent FriendUpdate(.DisplayName, n)
End With

Case SID_FRIENDADDED
Exit Sub

Case SID_FRIENDSADD
'0x67 packet format
'(STRING) Account
'(BYTE) Status
'(BYTE) Location
'(DWORD) ProductID
'(STRING) Location name

Set flTemp = New clsFriendObj

With flTemp
'(STRING) Account
s = KillNull(Mid$(Data, Position))
Position = Position + Len(s) + 1
.Name = s

'(BYTE) Friend Status
bytTemp = Asc(Mid$(Data, Position, 1))
Position = Position + 1
.Status = bytTemp
.Name = pBuff.GetString() ' Account
.Status = pBuff.GetByte() ' Status
.LocationID = pBuff.GetByte() ' Location

'(BYTE) Friend Location
bytTemp = Asc(Mid$(Data, Position, 1))
Position = Position + 1
.LocationID = bytTemp

'(DWORD) ProductID
s = Mid$(Data, Position, 4)
Position = Position + 4
.Game = IIf(Conv(s) > 0, StrReverse(s), "OFFL")
' Product ID
.Game = StrReverse(pBuff.GetRaw(4))
If Conv(.Game) = 0 Then
.Game = "OFFL"
End If

'(STRING) Channel
s = KillNull(Mid$(Data, Position))
.Location = s
' Location name
.Location = pBuff.GetString()

RaiseEvent FriendAdded(.DisplayName, .Game, .LocationID, .Status, .Location)
End With

g_Friends.Add flTemp, flTemp.Name
' Add to the internal list
g_Friends.Add flTemp

Set flTemp = Nothing

Case SID_FRIENDREMOVED
Exit Sub

Case SID_FRIENDSREMOVE
'0x68 packet format
'(BYTE) Entry Number
bytTemp = Asc(Mid$(Data, 1, 1)) + 1

If bytTemp > 0 And bytTemp <= g_Friends.Count Then
RaiseEvent FriendRemoved(g_Friends.Item(bytTemp).DisplayName)
n = pBuff.GetByte() + 1

If n > 0 And n <= g_Friends.Count Then
RaiseEvent FriendRemoved(g_Friends.Item(n).DisplayName)

g_Friends.Remove bytTemp
g_Friends.Remove n
End If


Case SID_FRIENDMOVED
Exit Sub

'(BYTE) Old Position
'(BYTE) New Position
Case SID_FRIENDSPOSITION
'0x69 packet format
'(BYTE) Old Position
'(BYTE) New Position

Set flTemp = Nothing
RaiseEvent FriendMoved


End Select

@@ -267,6 +213,17 @@ Public Function UsernameToFLIndex(ByVal sUsername As String) As Integer
End If
End Function

' Returns true if the specified product automatically receives friend update packets.
' (SID_FRIENDSUPDATE, SID_FRIENDSADD, SID_FRIENDSREMOVE, SID_FRIENDSPOSITION)
Public Function SupportsFriendPackets(ByVal sProduct As String) As Boolean
Select Case GetProductInfo(sProduct).Code
Case PRODUCT_STAR, PRODUCT_SEXP, PRODUCT_WAR3, PRODUCT_W3XP
SupportsFriendPackets = True
Case Else
SupportsFriendPackets = False
End Select
End Function


Private Sub Class_Terminate()
Set g_Friends = Nothing

0 comments on commit e74d71f

Please sign in to comment.
You can’t perform that action at this time.