MemberInfo.txt

Script("Name") = "Member Info"
Script("Author") = "PyroManiac"
Script("Major") = 1
Script("Minor") = 1
    
'Requests information on a member of a clan.
'This script uses Battle.net packets instead of the website, so it's better. ;p

'REQUIRES DEV 38 OR HIGHER

'Example: .mi Pyro[BoT]

Const MI_COMMAND = "mi"
Const MI_USER = "username"

Public RequestDelay

Private reqDic
Private lastRequest
Private lastRequestObj

Sub Event_Load()
	Set reqDic = CreateObject("Scripting.Dictionary")
    
    Call InitCommands()
    
    s = GetSettingsEntry("RequestDelay")
    RequestDelay = Int(IIf(Len(s) = 0, "10", s))
End Sub


Sub Event_Command(Command)
    If Command.Name <> MI_COMMAND Then Exit Sub
    
    If DateDiff("s", lastRequest, Now) < RequestDelay Then
        Command.Respond "You must wait " & RequestDelay & " seconds before requesting another profile."
        Exit Sub
    End If
    
    If Not RequestUserInfo(Command.Argument(MI_USER), Command) Then
        Command.Respond "A request for that user is already queued. Please wait."
    End If
End Sub

Function RequestUserInfo(TargetUser, Command)
	e = False
	For Each r In reqDic.Items()
		If Match(TargetUser, r.Name, True) Then
			RequestUserInfo = False
			Exit Function
		End If
	Next
	
    Set req = New ProfileRequest
	req.Name = TargetUser
	req.Cookie = GetNextRequestCookie()
	Set req.Command = Command
	
	req.Status = 1
	
	reqDic.Add req.Cookie, req
	
	RequestClanTag req.Name, req.Cookie
	lastRequest = Now
    
    RequestUserInfo = True
End Function

Function GetNextRequestCookie()
	x = 0
	Do
		If Not reqDic.Exists(x) Then
			GetNextRequestCookie = x
			Exit Function
		End If
		x = x + 1
	Loop			
End Function

Sub RequestClanTag(name, cookie)
	DataBuffer.InsertDWORD cookie
	DataBuffer.InsertNTString CStr(name)
	DataBuffer.SendPacket &H35
End Sub

Sub RequestClanMemberInfo(name, tag, cookie)
	DataBuffer.InsertDWORD cookie	
	DataBuffer.InsertDWORD tag
	DataBuffer.InsertNTString CStr(name)
	DataBuffer.SendPacket &H82
End Sub

Sub Event_PacketReceived(Protocol, ID, Length, Data)
	If Protocol = "BNCS" Then		
		If ID = &H35 Then
			Set pak = DataBufferEx()
			pak.Data = Data
			pak.Position = 4
			
			cookie = pak.GetDWORD
			status = pak.GetByte
			
			If Not reqDic.Exists(cookie) Then Exit Sub
            
            Set req = reqDic(cookie)
			
			If status = &H0 Then
				pDes = pak.GetString
				pLoc = pak.GetString
				dTag = pak.GetDWORD
				
				If dTag = &H0 Then 
					req.Status = 7
					req.Command.Respond req.Name & " is not in a clan."
                    req.Command.SendResponse
					reqDic.Remove req.Cookie
					Exit Sub
				End If
				
				hTag = Hex(dTag)				
				sTag = vbNullString
				For x = 1 To (4 * 2) Step 2
					i = Int("&H" & Mid(hTag, x, 2))
					If i <> 0 Then
						sTag = sTag & Chr(i)
					End If
				Next
				
                req.ClanTag = sTag
				req.Status = 2
				RequestClanMemberInfo req.Name, dTag, req.Cookie
			Else
				req.Status = 8
				req.Command.Respond "A profile could not be retreived for " & req.Name & "."
                req.Command.SendResponse
				reqDic.Remove req.Cookie
			End If
		ElseIf ID = &H82 Then
			Set pak = DataBufferEx()
			pak.Data = Data
			pak.Position = 4
			
			cookie = pak.GetDWORD
			status = pak.GetByte
			
			If Not reqDic.Exists(cookie) Then Exit Sub
				
            Set req = reqDic(cookie)
			
			If status = &H0 Then
				req.ClanName = pak.GetString
				req.ClanRankByte = pak.GetByte
				
				req.ClanJoinDate = FileTimeToDate(pak.GetDWORD, pak.GetDWORD)
                
				req.Status = 3
				dt = Split(req.ClanJoinDate, " ")

				req.Command.Respond StringFormat("{0} is a {1} in Clan '{2}' ({3}). They joined on {4} at {5} {6}.", req.Name, req.ClanRank, req.ClanName, req.ClanTag, dt(0), dt(1), dt(2))
			Else
				req.Status = 6
				req.Command.Respond "An error occurred. A clan tag was returned ( " & req.ClanTag & ") but the user was not found in that clan."
			End If
            
            reqDic.Remove req.Cookie
            req.Command.SendResponse
			Set lastRequestObj = req
		End If
	End If
End Sub

Sub InitCommands()
    Set cmd = OpenCommand(MI_COMMAND)
    If cmd Is Nothing Then
        Set cmd = CreateCommand(MI_COMMAND)
        With cmd
            .RequiredRank = 20
            .RequiredFlags = "G"
            .Description = "Gets the WarCraft 3 clan information for a user."
            
            .Parameters.Add .NewParameter(MI_USER, False, "word")
            
            .Save
        End With
        Set cmd = Nothing
    End If
End Sub

Class ProfileRequest
	Private requestStartTime
	
	Private Sub Class_Initialize()
		requestStartTime = Now
	End Sub
	
	Public Name
	Public Cookie
	
	Public Status
	Public Command
	
	Public ClanTag
	Public ClanName
	Public ClanRankByte
	Public ClanJoinDate
	
	Public Property Get ClanRank
		Select Case ClanRankByte
			Case &H0: ClanRank = "Peon (on probation)"
			Case &H1: ClanRank = "Peon"
			Case &H2: ClanRank = "Grunt"
			Case &H3: ClanRank = "Shaman"
			Case &H4: ClanRank = "Chieftain"
			Case Else:
				ClanRank = "Unknown (0x" & Right("00" & Hex(ClanRankByte), 2) & ")"
		End Select
	End Property
	
	Public Property Get RequestTime
		RequestTime = DateDiff("s", requestStartTime, Now)
	End Property
End Class