Skip to content
Permalink
Browse files

Implement /leaveclan and /removemember; handle clan command server resp

* Fix a compile error in Event_UserJoin: didn't rename a variable...
* Fix casing on member variables in ClanMember and Friend objects
* Implement /leaveclan, internal command
* Implement /removemember <Username>, internal command
* /promote, /demote, /disbandclan, /makechieftain, and .invite now use
  the server requests system and the Result code to parse and return
  errors that the server responds with
* This affects those actions in the user list UI and clan list UI
* Now handles all the clan response codes that are known
* Implement the ability to send and handle SID_CLANMEMBERINFORMATION:
  SSC.Clan.RequestMemberInfo(Username, ClanTag)
  -> Event_ClanMemberInfo(Result, Username, ClanTag, ClanName, Rank, JoinDate)

  Note that ClanTag is case-sensitive as this is used after the result
  of SID_PROFILE for W3 clients.

  The arguments besides Username and ClanTag will be blank if Result is not 0 (success).
  • Loading branch information...
nmbook committed Mar 27, 2017
1 parent fc1ba3f commit 266c7a64aba8c95d04325020d0c2e5ba6ee65f59
@@ -43,7 +43,7 @@ Public Property Let Rank(ByVal i As enuClanRank)
End Property

Public Property Get RankName() As String
RankName = frmChat.ClanHandler.GetRank(CByte(m_Rank))
RankName = frmChat.ClanHandler.GetRankName(CByte(m_Rank))
End Property

Public Property Get JoinTime() As Date
@@ -16,78 +16,87 @@ Attribute VB_Exposed = False

Option Explicit

Private m_pi As Boolean
Private m_picookie As Long
Private m_pmotd As Boolean
Private m_inclan As Boolean
Private m_myrank As Byte
Private m_name As String
Private m_motd As String
Private m_members As Collection
Private m_PI As Boolean
Private m_PICookie As Long
Private m_PMOTD As Boolean
Private m_InClan As Boolean
Private m_MyRank As Byte
Private m_Tag As String
Private m_Name As String
Private m_MOTD As String
Private m_Members As Collection

Private Sub Class_Initialize()
Set m_members = New Collection
Set m_Members = New Collection
End Sub

Private Sub Class_Terminate()
Set m_members = Nothing
Set m_Members = Nothing
End Sub

Public Property Get Name() As String
Name = m_name
Name = m_Tag
End Property

Public Property Let Name(str As String)
m_name = str
m_Tag = str
End Property

' alias for Name
Public Property Get Tag() As String
Tag = m_name
Tag = m_Tag
End Property

Public Property Let Tag(str As String)
m_name = str
m_Tag = str
End Property

Public Property Get FullName() As String
FullName = m_Name
End Property

Public Property Let FullName(str As String)
m_Name = str
End Property

Public Property Get MOTD() As String
MOTD = m_motd
MOTD = m_MOTD
End Property

Public Property Let MOTD(str As String)
m_motd = str
m_MOTD = str
End Property

Public Property Get InClan() As Boolean
InClan = m_inclan
InClan = m_InClan
End Property

Public Property Let InClan(bool As Boolean)
m_inclan = bool
m_InClan = bool
End Property

Public Property Get PendingInvitation() As Boolean
PendingInvitation = m_pi
PendingInvitation = m_PI
End Property

Public Property Let PendingInvitation(bool As Boolean)
m_pi = bool
m_PI = bool
End Property

Public Property Get PendingInvitationCookie() As Long
PendingInvitationCookie = m_picookie
PendingInvitationCookie = m_PICookie
End Property

Public Property Let PendingInvitationCookie(lng As Long)
m_picookie = lng
m_PICookie = lng
End Property

Public Property Get PendingClanMOTD() As Boolean
PendingClanMOTD = m_pmotd
PendingClanMOTD = m_PMOTD
End Property

Public Property Let PendingClanMOTD(bool As Boolean)
m_pmotd = bool
m_PMOTD = bool
End Property

Public Property Get Self() As clsClanMemberObj
@@ -105,7 +114,7 @@ Public Property Get Self() As clsClanMemberObj
End Property

Public Property Get Members() As Collection
Set Members = m_members
Set Members = m_Members
End Property

Public Property Get Chieftain() As clsClanMemberObj
@@ -235,7 +244,7 @@ Public Function GetUserIndexEx(ByVal Username As String) As Integer
End Function

Public Sub Clear()
Set m_members = New Collection
Set m_Members = New Collection
End Sub

Public Sub Disband()
@@ -271,6 +280,10 @@ Public Sub RequestMOTD()
Call frmChat.ClanHandler.RequestClanMOTD(reqScriptingCall)
End Sub

Public Sub RequestMemberInfo(ByVal Username As String, ByVal ClanTag As String)
Call frmChat.ClanHandler.RequestClanMemberInfo(Username, ClanTag, reqScriptingCall)
End Sub

Public Sub SetMOTD(ByVal MOTD As String)
Call frmChat.ClanHandler.SetClanMOTD(MOTD, reqScriptingCall)
End Sub
@@ -35,6 +35,7 @@ Public Event PromoteUserReply(ByVal Cookie As Long, ByVal Result As enuClanRespo
Public Event RemoveMemberReply(ByVal Cookie As Long, ByVal Result As enuClanResponseValue)
Public Event GetMemberList(ByVal Cookie As Long, ByVal Members As Collection)
Public Event GetMOTD(ByVal Cookie As Long, ByVal Message As String)
Public Event GetMemberInfo(ByVal Cookie As Long, ByVal Result As enuClanResponseValue, ByVal ClanName As String, ByVal Rank As enuClanRank, ByVal JoinDate As Date)
Public Event UnknownClanEvent(ByVal PacketID As Byte, ByVal Data As String)

Public LastRemoval As Currency
@@ -231,6 +232,9 @@ Public Sub ParseClanPacket(ByVal PacketID As Byte, ByVal inBuf As clsDataBuffer)
Case SID_CLANMEMBERRANKCHANGE
RaiseEvent MyRankChange(OldRank, NewRank, Username)

Case SID_CLANMEMBERINFORMATION
RaiseEvent GetMemberInfo(Cookie, Result, ClanName, Rank, JoinDate)

Case Else
RaiseEvent UnknownClanEvent(PacketID, inBuf.DebugOutput)

@@ -251,6 +255,35 @@ Public Function IsW3() As Boolean

End Function

Public Sub RequestClanMemberInfo(ByVal Username As String, ByVal ClanTag As String, Optional ByVal eType As enuServerRequestHandlerType = reqScriptingCall, Optional ByVal Command As clsCommandObj)
Dim pBuf As clsDataBuffer
Dim oRequest As udtServerRequest
Dim Cookie As Long

If (LenB(Username) = 0) Then Exit Sub
If (LenB(ClanTag) = 0 Or Len(ClanTag) > 4) Then Exit Sub

With oRequest
.ResponseReceived = False
.HandlerType = eType
Set .Command = Command
.PacketID = SID_CLANMEMBERINFORMATION
.PacketCommand = 0
.Tag = Array(Username, ClanTag)
End With

Cookie = SaveServerRequest(oRequest)

Set pBuf = New clsDataBuffer
With pBuf
.InsertDWord Cookie
.InsertDWord StringToDWord(ClanTag)
.InsertNTString Username
.SendPacket SID_CLANMEMBERINFORMATION
End With
Set pBuf = Nothing
End Sub

Public Sub RequestClanList(Optional ByVal eType As enuServerRequestHandlerType = reqScriptingCall)
Dim pBuf As clsDataBuffer
Dim oRequest As udtServerRequest
@@ -541,14 +574,33 @@ Public Sub MakeMemberChieftain(ByVal Username As String, Optional ByVal eType As
Set pBuf = Nothing
End Sub

Public Function GetRank(ByVal i As enuClanRank) As String
Public Function GetRankName(ByVal i As enuClanRank) As String
Select Case i
Case clrankChieftain: GetRankName = "Chieftain" 'Chief
Case clrankShaman: GetRankName = "Shaman" 'Shaman
Case clrankGrunt: GetRankName = "Grunt" 'Grunt
Case clrankPeon: GetRankName = "Peon" 'Peon
Case clrankRecruit: GetRankName = "Recruit" 'Recruit
Case Else: GetRankName = "Unknown 0x" & ZeroOffset(i, 2)
End Select
End Function

Public Function GetClanResponseText(ByVal i As enuClanResponseValue) As String
Select Case i
Case clrankChieftain: GetRank = "Chieftain" 'Chief
Case clrankShaman: GetRank = "Shaman" 'Shaman
Case clrankGrunt: GetRank = "Grunt" 'Grunt
Case clrankPeon: GetRank = "Peon" 'Peon
Case clrankRecruit: GetRank = "Recruit" 'Recruit
Case Else: GetRank = "Unknown"
Case clresSuccess: GetClanResponseText = "success"
Case clresNameInUse: GetClanResponseText = "name in use"
Case clresTooSoon: GetClanResponseText = "you must wait for the 7 day probation period to end"
Case clresNotEnoughMembers: GetClanResponseText = "not enough members"
Case clresDecline: GetClanResponseText = "declined"
Case clresUnavailable: GetClanResponseText = "user not available"
Case clresAccept: GetClanResponseText = "accepted"
Case clresNotAuthorized: GetClanResponseText = "you must have the required rank"
Case clresNotAllowed: GetClanResponseText = "you cannot do that"
Case clresIsFull: GetClanResponseText = "clan is full"
Case clresBadTag: GetClanResponseText = "invalid clan tag"
Case clresBadName: GetClanResponseText = "invalid clan name"
Case clresUserNotFound: GetClanResponseText = "user not found"
Case Else: GetClanResponseText = "unknown message 0x" & ZeroOffset(i, 2)
End Select
End Function

@@ -20,42 +20,42 @@ Attribute VB_Exposed = False

Option Explicit

Private m_Username As String
Private m_status As Byte
Private m_location_id As Byte
Private m_location As String
Private m_game As String
Private m_Username As String
Private m_Status As Byte
Private m_LocationID As Byte
Private m_Location As String
Private m_Game As String

Public Property Get Location() As String
Location = m_location
Location = m_Location
End Property

Public Property Let Location(ByVal sChannel As String)
m_location = sChannel
m_Location = sChannel
End Property

Public Property Get game() As String
game = m_game
Public Property Get Game() As String
Game = m_Game
End Property

Public Property Let game(ByVal sProduct As String)
m_game = KillNull(sProduct)
Public Property Let Game(ByVal sProduct As String)
m_Game = KillNull(sProduct)
End Property

Public Property Get LocationID() As Byte
LocationID = m_location_id
LocationID = m_LocationID
End Property

Public Property Let LocationID(ByVal byLocation As Byte)
m_location_id = byLocation
m_LocationID = byLocation
End Property

Public Property Get Status() As Byte
Status = m_status
Status = m_Status
End Property

Public Property Let Status(ByVal byStatus As Byte)
m_status = byStatus
m_Status = byStatus
End Property

Public Property Get IsMutual() As Boolean
@@ -98,7 +98,7 @@ Public Function Clone() As Object
Set Clone = New clsFriendObj

Clone.Name = Name
Clone.game = game
Clone.Game = Game
Clone.Status = Status
Clone.LocationID = LocationID
Clone.Location = Location

0 comments on commit 266c7a6

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