Skip to content

Commit

Permalink
Update friends listview event handling and display
Browse files Browse the repository at this point in the history 
* Redo FriendslistHandler to be similar to ClanPacketHandler.
* Handle all friends events completely, including update, add, remove,
  and position.
* Update listview items in place for these events, including position.
* Use a hidden column and sort on that, much like Clan list, so that
  reordering and updates can be done without removing and re-adding
  listview items, or worse, refreshing the entire list
  (no more re-requesting it!)
* Handle Config.FriendsListTab and Config.ShowOfflineFriends when
  updating the listview this way.
  • Loading branch information
@nmbook
nmbook committed Mar 28, 2017
1 parent 97da695 commit 796073f
Show file tree
Hide file tree
Showing 3 changed files with 298 additions and 296 deletions.
223 changes: 67 additions & 156 deletions trunk/clsFriendlistHandler.cls
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,181 +13,92 @@ Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

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

Public Sub RequestFriendsList()
Dim pBuf As clsDataBuffer
Set pBuf = New clsDataBuffer
pBuf.SendPacket SID_FRIENDSLIST
Set pBuf = Nothing
End Sub
Public Event FriendsListReply(ByVal Friends As Collection)
Public Event FriendsUpdate(ByVal EntryNumber As Byte, ByVal FriendObj As clsFriendObj)
Public Event FriendsAdd(ByVal FriendObj As clsFriendObj)
Public Event FriendsRemove(ByVal EntryNumber As Byte)
Public Event FriendsPosition(ByVal EntryNumber As Byte, ByVal NewPosition As Byte)

Public Sub ParsePacket(ByVal PacketID As Long, ByVal pBuff As clsDataBuffer)
Public Sub ParsePacket(ByVal PacketID As Long, ByVal inBuf As clsDataBuffer)
On Error GoTo ERROR_HANDLER

Dim flTemp As clsFriendObj
Dim n As Integer

Dim FriendObj As clsFriendObj
Dim Friends As Collection
Dim i As Integer
Dim Count As Byte
Dim EntryNum As Byte
Dim NewPos As Byte

Select Case PacketID
Case SID_FRIENDSLIST
'0x65 packet format
'(BYTE) Number of Entries
'For each entry:
'(STRING) Account
'(BYTE) Status
'(BYTE) Location
'(DWORD) ProductID
'(STRING) Location name

Call ResetList

n = pBuff.GetByte() ' Number of entries
RaiseEvent FriendListReceived(n)

If (n > 0) Then

'For each entry
For n = 0 To n - 1
Set flTemp = New clsFriendObj

With flTemp
.Name = pBuff.GetString() ' Account
.Status = pBuff.GetByte() ' Status
.LocationID = pBuff.GetByte() ' Location

' Product ID
.Game = DWordToString(pBuff.GetDWord)

' Location name
.Location = pBuff.GetString(UTF8)
End With

' 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_FRIENDSUPDATE
'0x66 packet format
'(BYTE) Entry number
'(BYTE) Status
'(BYTE) Location
'(DWORD) ProductID
'(STRING) Location name

n = pBuff.GetByte() + 1

With g_Friends(n)
.Status = pBuff.GetByte() ' Status
.LocationID = pBuff.GetByte() ' Location

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

pBuff.GetDWord
' Product ID
'.Game = DWordToString(pBuff.GetDWORD)

' Location name
.Location = pBuff.GetString(UTF8)

RaiseEvent FriendUpdate(.DisplayName, n)
Case SID_FRIENDSLIST ' no-cookie server request
Count = inBuf.GetByte ' (BYTE) Friend count
Set Friends = New Collection ' (MEMBER[]) Members
For i = 1 To Count
Set FriendObj = New clsFriendObj
With FriendObj
.Name = inBuf.GetString ' (STRING) Username
.Status = inBuf.GetByte ' (BYTE) Status
.LocationID = inBuf.GetByte ' (BYTE) Location
.Game = DWordToString(inBuf.GetDWord) ' (DWORD) Product
.Location = inBuf.GetString ' (STRING) Location name
End With
Friends.Add FriendObj
Set FriendObj = Nothing
Next i

RaiseEvent FriendsListReply(Friends)

Case SID_FRIENDSUPDATE ' information event
EntryNum = inBuf.GetByte ' (BYTE) Entry number
Set FriendObj = New clsFriendObj
With FriendObj
.Status = inBuf.GetByte ' (BYTE) Status
.LocationID = inBuf.GetByte ' (BYTE) Location
.Game = DWordToString(inBuf.GetDWord) ' (DWORD) Product
.Location = inBuf.GetString ' (STRING) Location name
End With

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

Set flTemp = New clsFriendObj

With flTemp
.Name = pBuff.GetString() ' Account
.Status = pBuff.GetByte() ' Status
.LocationID = pBuff.GetByte() ' Location

' Product ID
.Game = DWordToString(pBuff.GetDWord)

' Location name
.Location = pBuff.GetString(UTF8)

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

RaiseEvent FriendsUpdate(EntryNum, FriendObj)

Case SID_FRIENDSADD ' information event
Set FriendObj = New clsFriendObj
With FriendObj
.Name = inBuf.GetString ' (STRING) Username
.Status = inBuf.GetByte ' (BYTE) Status
.LocationID = inBuf.GetByte ' (BYTE) Location
.Game = DWordToString(inBuf.GetDWord) ' (DWORD) Product
.Location = inBuf.GetString ' (STRING) Location name
End With

' Add to the internal list
g_Friends.Add flTemp

Set flTemp = Nothing

RaiseEvent FriendsAdd(FriendObj)

Case SID_FRIENDSREMOVE
'0x68 packet format
'(BYTE) Entry Number

n = pBuff.GetByte() + 1

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

g_Friends.Remove n
End If

EntryNum = inBuf.GetByte ' (BYTE) Entry number

RaiseEvent FriendsRemove(EntryNum)

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

Set flTemp = Nothing
RaiseEvent FriendMoved

EntryNum = inBuf.GetByte ' (BYTE) Entry number
NewPos = inBuf.GetByte ' (BYTE) New position

RaiseEvent FriendsPosition(EntryNum, NewPos)

End Select

Set flTemp = Nothing

Exit Sub

ERROR_HANDLER:
frmChat.AddChat RTBColors.ErrorMessageText, "Error: " & Err.Description & " in ParsePacket()."
frmChat.AddChat RTBColors.ErrorMessageText, "Error: " & Err.Description & " in clsFriendlistHandler.ParsePacket()."

Exit Sub

'debug.print "Error " & Err.Number & " (" & Err.Description & ") in procedure ParsePacket of Class Module clsFriendListHandler"

End Sub

Public Sub ResetList()
'frmChat.lvFriendList.ListItems.Clear

Set g_Friends = Nothing
Set g_Friends = New Collection
Public Sub RequestFriendsList()
Dim pBuf As clsDataBuffer
Set pBuf = New clsDataBuffer
pBuf.SendPacket SID_FRIENDSLIST
Set pBuf = Nothing
End Sub

Public Function UsernameToFLIndex(ByVal sUsername As String) As Integer
Expand Down
Loading

0 comments on commit 796073f

Please sign in to comment.