VERSION 5.00
Object = "{0E59F1D2-1FBE-11D0-8FF2-00A0D10038BC}#1.0#0"; "msscript.ocx"
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Object = "{48E59290-9880-11CF-9754-00AA00C00908}#1.0#0"; "MSINET.OCX"
Begin VB.UserControl BNCS 
   CanGetFocus     =   0   'False
   ClientHeight    =   1995
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   1410
   ClipBehavior    =   0  'None
   ClipControls    =   0   'False
   BeginProperty Font 
      Name            =   "Courier New"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   HasDC           =   0   'False
   InvisibleAtRuntime=   -1  'True
   ScaleHeight     =   1995
   ScaleWidth      =   1410
   Windowless      =   -1  'True
   Begin VB.Timer tmrEvent 
      Enabled         =   0   'False
      Interval        =   100
      Left            =   480
      Top             =   960
   End
   Begin VB.Timer tmrConnect 
      Enabled         =   0   'False
      Interval        =   500
      Left            =   0
      Top             =   480
   End
   Begin VB.Timer scTimer 
      Enabled         =   0   'False
      Interval        =   100
      Left            =   960
      Top             =   960
   End
   Begin InetCtlsObjects.Inet scInet 
      Left            =   0
      Top             =   1440
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
   End
   Begin MSScriptControlCtl.ScriptControl scVB 
      Left            =   600
      Top             =   1440
      _ExtentX        =   1005
      _ExtentY        =   1005
   End
   Begin VB.Timer tmrMinuteban 
      Enabled         =   0   'False
      Interval        =   60000
      Left            =   480
      Top             =   480
   End
   Begin VB.Timer tmrReconnect 
      Enabled         =   0   'False
      Interval        =   30000
      Left            =   960
      Top             =   480
   End
   Begin VB.Timer tmrKeepAlive 
      Enabled         =   0   'False
      Interval        =   40000
      Left            =   0
      Top             =   960
   End
   Begin MSWinsockLib.Winsock sckBnls 
      Left            =   960
      Top             =   0
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock sckBnet 
      Left            =   480
      Top             =   0
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock sckRealm 
      Left            =   0
      Top             =   0
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
End
Attribute VB_Name = "BNCS"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'-----------------------------------------------------
' MirageBot BNCS Control
' Written by Christopher Nevin (lancergli@gmail.com)
'-----------------------------------------------------

Public VerByte              As Long, _
        serverToken         As Long, _
        clientToken         As Long, _
        mpqFiletime         As String, _
        mpqFilename         As String, _
        valueString         As String, _
        digest              As String, _
        version             As Long, _
        checksum            As Long, _
        productVal          As Long, _
        publicVal           As Long, _
        curBNLS             As Integer, _
        currentBNLS         As String

'Feature Related
Public NudgeCount           As Integer, _
       Gamee                As String, _
       FloodDetected        As Boolean, _
       TickNudge            As Double, _
       TickGame             As Double, _
       TickFlood            As Double, _
       TickJoin             As Double, _
       TickTalk             As Double, _
       TickConnect          As Double, _
       TickSmart            As Double, _
       TickKeyPress         As Double, _
       FloodCounter         As Double, _
       FloodTimer           As Double

'Class Entities
Public Banned               As New clsModBanned, _
       clan                 As New clsClan, _
       Config               As New clsConfig, _
       Database             As New clsDatabase, _
       Queue                As New clsQueue, _
       Self                 As New clsSelf, _
       Users                As New clsUsers, _
       Chars                As New clsRealmChars

'Collections
Public BnetChannels         As New Collection, _
       Friends              As New Collection, _
       TimeBans             As New Collection, _
       Timers               As New Collection
 
'Variables
Public Profile              As String, _
       ProfilePath          As String, _
       IsActive             As Boolean, _
       IsHidden             As Boolean, _
       IsLoaded             As Boolean, _
       IsOnline             As Boolean, _
       IsMuted              As Boolean, _
       IsJailed             As Boolean, _
       IsConnecting         As Boolean, _
       IsRealmConnected     As Boolean, _
       IdleCounter          As Double, _
       SentPing             As Boolean

Public Cdkey1Status As CDKEYSTATUSENUM
Public Cdkey2Status As CDKEYSTATUSENUM

Public Function IsPvPGN() As Boolean
    IsPvPGN = Left$(GetServerName(Config.Server), 5) = "PvPGN"
End Function

Public Sub LastBNLS()
    curBNLS = curBNLS - 1
    If curBNLS < 0 Then
        OutputEvent ChatRTB, &HB0, , "BNLS: Looping back to end of list..."
        curBNLS = options.BNLSCount
    Else
        OutputEvent ChatRTB, &HB0, , "BNLS: Trying previous server..."
    End If
    currentBNLS = options.BNLS(curBNLS)
End Sub

Public Sub NextBNLS()
    curBNLS = curBNLS + 1
    If curBNLS > options.BNLSCount Then
        OutputEvent ChatRTB, &HB0, , "BNLS: Looping back to start of list..."
        curBNLS = 0
    Else
        OutputEvent ChatRTB, &HB0, , "BNLS: Trying next server..."
    End If
    currentBNLS = options.BNLS(curBNLS)
End Sub

Public Sub LastProxy()
    Config.CurProxy = Config.CurProxy - 1
    If Config.CurProxy < 0 Then
        OutputEvent ChatRTB, &HB0, , "PROXY: Looping back to end of list..."
        Config.CurProxy = Config.ProxyCount
    Else
        OutputEvent ChatRTB, &HB0, , "PROXY: Trying previous proxy..."
    End If
    Debug.Print Config.Proxy
End Sub

Public Sub NextProxy()
    Config.CurProxy = Config.CurProxy + 1
    If Config.CurProxy > Config.ProxyCount Then
        OutputEvent ChatRTB, &HB0, , "PROXY: Looping back to start of list..."
        Config.CurProxy = 0
    Else
        OutputEvent ChatRTB, &HB0, , "PROXY: Trying next proxy..."
    End If
    Debug.Print Config.Proxy
End Sub

Public Function IsScriptLoaded(File As String) As Boolean
On Error GoTo hErr:
    Dim I&, C&
    ' Get the script control to use
    C = scVB.Modules.Count
3   For I = 1 To C
        If InStrB(File, ".") <> 0 Then
4           If LCase$(scVB.Modules(I).Name) = LCase$(Left$(File, InStrRev(File, ".") - 1)) Then
                IsScriptLoaded = True
                Exit Function
            End If
        Else
            If LCase$(scVB.Modules(I).Name) = LCase$(File) Then
                IsScriptLoaded = True
                Exit Function
            End If
        End If
    Next I
    Exit Function
hErr:
    ErrorHandler Err.Number, Err.Description, Erl, "Bot", "IsScriptLoaded"
End Function

Public Sub LoadScript(Code As String, File As String)
    On Error GoTo HandleSyntaxError
    If IsScriptLoaded(File) Then Exit Sub
    Dim scModule As Object, Name As String
    Name = Left$(File, InStrRev(File, ".") - 1)
    ' Add a module to the script control
3   Set scModule = scVB.Modules.Add(Name)
    ' Add code to module
4   Call scModule.AddCode(Code)
5   If ScriptEnabled(Name) Then scProcess Name, "Event_Load"
    Exit Sub
HandleSyntaxError:
    If Not scVB Is Nothing Then
        If scVB.error.Number > 0 Then
            With scVB.error
                ErrorHandler .Number & ": " & .Description & "(Column: " & .Column & ", Line: " & .Line & ")", Erl, "Script [" & Prefix(Suffix(File, "\"), ".") & "]", "Event_Load", scVB.error
            End With
        ElseIf Err Then
            ErrorHandler Err.Number, Err.Description, Erl, "Bot", "LoadScript"
        End If
    Else
        ErrorHandler Err.Number, Err.Description, Erl, "Bot", "LoadScript"
    End If
End Sub

Public Function ScriptEnabled(ScriptName As String) As Boolean
On Error Resume Next
    Dim I As Integer, C As Integer
    C = UBound(Scripts)
    For I = 0 To C
        If InStrB(Scripts(I), "=") <> 0 Then
            Dim S() As String
            S = Split(LCase$(Scripts(I)), "=")
            If S(0) = LCase$(ScriptName) Then
                ScriptEnabled = (Val(S(1)) = 1)
                Exit Function
            End If
        End If
    Next I
End Function

Public Function PluginEnabled(PluginName As String) As Boolean
On Error Goto hErr:
    Dim I As Long, C As Long
    C = UBound(Plugins)
    For I = 0 To C
        If InStrB(Plugins(I), "=") <> 0 Then
            Dim S() As String
            S = Split(LCase$(Plugins(I)), "=")
			If UBound(S) = 1 Then
				If S(0) = LCase$(PluginName) Then
					PluginEnabled = (Val(S(1)) = 1)
					Exit Function
				End If
			End If
        End If
    Next I
	Exit Function
hErr:
	ErrorHandler Err.Number, Err.Description, Erl, "Bot", "PluginEnabled"
End Function

Public Sub ReloadPluginsScripts()
On Error GoTo hErr:
1   Plugins = ReadProfileSection("Plugins", ProfilePath)
2   Scripts = ReadProfileSection("Scripts", ProfilePath)
    Exit Sub
hErr:
    ErrorHandler Err.Number, Err.Description, Erl, "Bot", "ReloadScripts/Plugins"
End Sub

Public Sub PerformDDP(Username As String, Message As String)
On Error GoTo hErr:
1   If (DDPRequest = 0) Then DDPRequest = GetTickCount - 5001
2   If (GetTickCount - DDPRequest) > 5000 Then
3       If clan.Rank = CHIEFTAIN Then
4           Dim U As New clsUser, x As Integer
5           Set U = Users.GetByName(GetAccount(Message))
6           If Not U Is Nothing Then
                DDPRequest = GetTickCount
                ShareQ.QClear BotIndex
                Dim Shamans As Collection, I As Integer, Tick As Long
7               Set Shamans = New Collection
9               For I = 0 To clan.Count
                    With clan.GetByIndex(I)
11                      If .Online And .Rank = SHAMAN Then Shamans.Add .Username
                    End With
12              Next I
13              For I = 1 To Shamans.Count
14                  SendClanRankChange Shamans(I), GRUNT
                Next I
                Tick = GetTickCount
                Do Until (GetTickCount - Tick) > 5000
                    DoEvents
                Loop
15              SendNow "/designate " & U.Account
17              SendNow "/resign"
                Tick = GetTickCount
                Do Until (GetTickCount - Tick) > 5000
                    DoEvents
                Loop
                If Shamans.Count > 0 Then
                    For I = 1 To Shamans.Count
                        SendClanRankChange Shamans(I), SHAMAN
                    Next I
                End If
                Set Shamans = Nothing
            Else
19              SendText "Cannot designate a Username who is not in the channel!", Username
            End If
        Else
20          SendText "DDP requires chieftain rank!", Username
        End If
    Else
21      SendText "Previous DDP request was too recent, please wait a moment..", Username
    End If
    Exit Sub
hErr:
    ErrorHandler Err.Number, Err.Description, Erl, "Bot", "PerformDDP"
End Sub

Public Property Get ExposeSocket() As Object
    Set ExposeSocket = sckBnet
End Property

Public Property Let BotIndex(Value As Integer)
    mBotIndex = Value
    sckBnet.Tag = Value
    sckBnls.Tag = Value
    tmrKeepAlive.Enabled = True
    tmrReconnect.Enabled = True
    tmrMinuteban.Enabled = True
    IsLoaded = True
End Property

Public Property Get BotIndex() As Integer
    BotIndex = mBotIndex
End Property

Public Function FindFriend(Username As String) As Integer
    Dim I As Integer
    For I = 1 To Friends.Count
        If LCase$(Friends(I).Username) = LCase$(Username) Then
            FindFriend = I
            Exit Function
        End If
    Next I
    FindFriend = 0
End Function

Public Function IsRealm() As Boolean
    IsRealm = (sckRealm.State = sckConnected) And LenB(Self.Character)
End Function

Public Property Get IsLocked() As Boolean
    IsLocked = mIsLocked
End Property

Public Property Let IsLocked(ByVal V As Boolean)
    mIsLocked = V
End Property

Public Function IsConnected() As Boolean
    IsConnected = (sckBnet.State = sckConnected)
End Function

Public Function GetAccount(ByVal Username As String) As String
On Error GoTo hErr
1   If InStrB(Username, "*") <> 0 Then Username = Mid$(Username, InStrRev(Username, "*") + 1)
2   If Config.IsDiablo Then GetAccount = "*" & Username Else GetAccount = Username
    Exit Function
hErr:
    ErrorHandler Err.Number, Err.Description, Erl, "Bot", "GetAccount"
End Function

Public Sub Connect()
On Error GoTo hErr
1   If Not IsLoaded Then Exit Sub
2   If Config Is Nothing Then
3       MsgBox "Config object not initialized!"
        Exit Sub
    End If
4   If LenB(Config.ProductID) = 0 Then
5       RaiseEvent SocketInfo(0, "Please select a product to connect with!", vbFalse)
        Exit Sub
    End If
6   If LenB(Config.Username) = 0 Then
7       RaiseEvent SocketInfo(0, "Please specify a username to connect with!", vbFalse)
        Exit Sub
    End If
8   If LenB(Config.Password) = 0 Then
9       RaiseEvent SocketInfo(0, "Please specify the password associated with that username!", vbFalse)
        Exit Sub
    End If
10  If Config.Register = ChangeEmail Then
11      If LenB(Config.NewEmail) = 0 Then
12          RaiseEvent SocketInfo(0, "Please specify an new e-mail address for registration change!", vbFalse)
            Exit Sub
        End If
    End If
13  If Config.Register <> Disabled Then
14      If LenB(Config.Email) = 0 Then
15          RaiseEvent SocketInfo(0, "Please specify an e-mail address for registration!", vbFalse)
            Exit Sub
        End If
    End If
16  If Config.UseBNLS Then
17      currentBNLS = options.BNLS(curBNLS)
18      If LenB(currentBNLS) = 0 Then currentBNLS = "bnls.bnetdev.net"
    End If
19  If LenB(Config.Server) = 0 Then
20      RaiseEvent SocketInfo(0, "Please specify a Battle.Net server to connect to!", vbFalse)
        Exit Sub
    End If
21  If LenB(Config.Cdkey) = 0 Then
22      RaiseEvent SocketInfo(0, "Please specify a cdkey to connect with!", vbFalse)
        Exit Sub
    End If
23  If Config.VerByte = 0 Then
24      RaiseEvent SocketInfo(0, "Please specify the version byte for this product!", vbFalse)
        Exit Sub
    End If
25  If Config.ProductID = "D2XP" Or Config.ProductID = "W3XP" Then
26      If LenB(Config.CdkeyEx) = 0 Then
27          RaiseEvent SocketInfo(0, "Please specify an expansion cdkey to connect with!", vbFalse)
            Exit Sub
        End If
        Dim P As String
28      If Config.ProductID = "D2XP" Then P = "D2DV" Else P = "WAR3"
29      If ValidateCdkey(P, Config.Cdkey) = False Then
30          RaiseEvent SocketInfo(0, "Cdkey is invalid for this product!", vbFalse)
            Exit Sub
        End If
31      If ValidateCdkey(Config.ProductID, Config.CdkeyEx) = False Then
32          RaiseEvent SocketInfo(0, "Expansion cdkey is invalid for this product!", vbFalse)
            Exit Sub
        End If
    Else
33      If ValidateCdkey(Config.ProductID, Config.Cdkey) = False Then
34          RaiseEvent SocketInfo(0, "Cdkey is invalid for this product!", vbFalse)
            Exit Sub
        End If
    End If

35  Set B = New clsPBuffer
36  Set R = New clsPDebuffer
37  Cdkey1Status = CDKEY_UNKNOWN
38  Cdkey2Status = CDKEY_UNKNOWN
39  BufferBNCS = vbNullString
40  BufferBNLS = vbNullString
41  B.Clear
42  TickConnect = GetTickCount()
43  TryReconnect = True
44  Self.FirstChannel = False
45  Disconnect
    IsConnecting = True
46  If (Config.UseBNLS) Then
        ' BNLS
47      RaiseEvent SocketConnecting(1, currentBNLS)
        sckBnls.Close
48      sckBnls.Connect currentBNLS, 9367
    Else
        ' Local Hashing
49      VerByte = CLng(Config.VerByte)
50      If (VerByte = &H0) Then
51          RaiseEvent SocketInfo(0, "Please specify the verbyte for: " & Config.ProductID, vbFalse)
            Exit Sub
        End If
52      Select Case Config.ProxyMode
        Case 1, 2
54          If Len(Config.Proxy) > 0 Then
55              RaiseEvent SocketConnecting(2, Config.Proxy & ":" & Config.ProxyPort)
                sckBnet.Close
56              sckBnet.Connect Config.Proxy, Config.ProxyPort
            Else
57              RaiseEvent SocketConnecting(0, Config.Server)
                sckBnet.Close
58              sckBnet.Connect Config.Server, 6112
            End If
        Case Else
59          RaiseEvent SocketConnecting(0, Config.Server)
            sckBnet.Close
60          sckBnet.Connect Config.Server, 6112
        End Select
    End If
    Exit Sub
hErr:
    ErrorHandler Err.Number, Err.Description, Erl, "Bot", "Connect"
End Sub

Public Sub Disconnect(Optional Reconnect As Boolean = True)
On Error GoTo hErr
1   If Not IsLoaded Then Exit Sub
2   If sckBnls.State <> sckClosed And sckBnls.State <> sckError Then RaiseEvent SocketDisconnect(1)
3   If sckBnet.State <> sckClosed And sckBnet.State <> sckError Then
        If sckBnet.RemotePort <> 6112 Then
            RaiseEvent SocketDisconnect(2)
        Else
            RaiseEvent SocketDisconnect(0)
        End If
    End If
4   If nls.Value > 0 Then nls_free nls.Value: nls.Value = 0
5   If nls.OldValue > 0 Then nls_free nls.OldValue: nls.OldValue = 0
    IsMuted = False
    IsJailed = False
6   ToggleNagel sckBnet.SocketHandle, False
    sckBnls.Close
    sckBnet.Close
    TryReconnect = Reconnect
    IsOnline = False
    frmBot.lvUsers(BotIndex).ListItems.Clear
    frmBot.lvClan(BotIndex).ListItems.Clear
    frmBot.lvFriends(BotIndex).ListItems.Clear
15  ShareQ.QClear BotIndex
7   Set Friends = New Collection
8   Set BnetChannels = New Collection
9   Set Banned = New clsModBanned
10  Set TimeBans = New Collection
11  Set Chars = New clsRealmChars
12  Set clan = New clsClan
13  Set Users = New clsUsers
14  Set Self = New clsSelf
16  ReDim Realms(0, 0)
    IsConnecting = False
17  scProcess "", "Disconnect"
On Error Resume Next
    WardenCleanup BotIndex
    Exit Sub
hErr:
    ErrorHandler Err.Number, Err.Description, Erl, "Bot", "Disconnect"
End Sub

Public Sub Loaded()
    Set Queue = New clsQueue
    Set clan = New clsClan
    Set Users = New clsUsers
    Set Chars = New clsRealmChars
    Set TimeBans = New Collection
    Set Friends = New Collection
    Set Database = New clsDatabase
    Set Config = New clsConfig
    Set Self = New clsSelf
    Set BnetChannels = New Collection
    Set B = New clsPBuffer
    Set R = New clsPDebuffer
    Set Banned = New clsModBanned
    ReDim Realms(0, 0)
    TickKeyPress = DblTickCount
    ReloadPluginsScripts
    ImplementScripts
    tmrEvent.Enabled = True
End Sub

Public Sub ImplementScripts()
    On Error GoTo hErr:
1   Dim SSC As New clsScriptSupport
2   SSC.Index = BotIndex
3   scVB.Reset
4   Set Timers = New Collection
6   Call scVB.AddObject("Config", Config, True)
8   Call scVB.AddObject("SSC", SSC, True)
10  Call scVB.AddObject("scInet", scInet, True)
11  LoadAllScripts
    scTimer.Enabled = True
    Exit Sub
hErr:
    ErrorHandler Err.Number, Err.Description, Erl, "Bot", "ImplementScripts"
End Sub

Public Sub UpdateScript(Name As String)
    If IsOnline Then
        scProcess Name, "Event_Logon"
        If LenB(Self.Channel) Then
            Dim CE As New clsChatEvent
            CE.Message = Self.Channel
            CE.Flags = Self.ChannelFlags
            scProcessObj Name, "Event_Channel", CE
            Dim I As Integer
            For I = 0 To Users.Count
                Dim U As clsUser
                Set U = Users.GetByIndex(I)
                Set CE = New clsChatEvent
                CE.Username = U.Username
                CE.Flags = U.Flags
                CE.Ping = U.Ping
                CE.Message = U.Statstring
                scProcessObj Name, "Event_UserPresent", CE
            Next I
        End If
    End If
End Sub

Public Sub UpdateScripts()
    Dim x As Integer, C As Integer
    C = scVB.Modules.Count
    For x = 1 To C
        UpdateScript scVB.Modules(x).Name
    Next x
End Sub

Public Sub LoadAllScripts()
    Dim x As Integer, I As Integer, Files() As String, TS As TextStream, FS As New FileSystemObject, C As Long, N As Long
    Files = FileList(AppData & "Scripts\*.txt")
    C = UBound(Files)
    For I = 0 To C
        If LenB(Files(I)) > 0 Then
            If ScriptEnabled(Left$(Files(I), InStrRev(Files(I), ".") - 1)) Then
                N = scVB.Modules.Count
                For x = 1 To N
                    If LCase$(scVB.Modules(x).Name) = LCase$(Left$(Files(I), InStrRev(Files(I), ".") - 1)) Then GoTo NextFileVB:
                Next
                Set TS = FS.OpenTextFile(AppData & "Scripts\" & Files(I), ForReading, True)
                LoadScript TS.ReadAll, Files(I)
                TS.Close
            End If
NextFileVB:
        End If
    Next I
End Sub

Public Sub Unloaded()
On Error Resume Next
    plUnloaded BotIndex
    scProcess "", "Unload"
    Disconnect False
    IsActive = False
    IsHidden = False
    IsJailed = False
    IsMuted = False
    IsLoaded = False
    Profile = vbNullString
    ProfilePath = vbNullString
    If ShareQ.QCount() Then ShareQ.QClear BotIndex
    Set Queue = Nothing
    Set clan = Nothing
    Set Chars = Nothing
    Set Users = Nothing
    Set TimeBans = Nothing
    Set Friends = Nothing
    Set Database = Nothing
    Set Config = Nothing
    Set Self = Nothing
    Set BnetChannels = Nothing
    Set B = Nothing
    Set R = Nothing
    Set Banned = Nothing
    ReDim Realms(0, 0)
    scVB.Reset
    scTimer.Enabled = False
    tmrEvent.Enabled = False
    IsLoaded = False
End Sub

Public Sub SendClanDisband()
On Error GoTo hErr
    If LenB(clan.Tag) = 0 Then Exit Sub
    If clan.Rank = CLANRANKENUM.CHIEFTAIN Then
        RaiseEvent SocketInfo(0, "Disbanding Clan " & clan.Tag & "...", vbUseDefault)
        B.InsertDword GetTickCount()
        SendBnetPacket SID_CLANDISBAND
    Else
        RaiseEvent SocketInfo(0, "You are not authorized to disband the clan, only the Chieftain can perform this action!", vbFalse)
    End If
    Exit Sub
hErr:
    B.Clear
    ErrorHandler Err.Number, Err.Description, Erl, "Bot", "SendDisband"
End Sub

Public Sub SendClanRankChange(User As String, Rank As CLANRANKENUM)
On Error GoTo hErr
    If LenB(clan.Tag) = 0 Then Exit Sub
    clan.Changee = User
    clan.ChangeeRank = CByte(Rank)
    B.InsertDword GetTickCount()
    B.InsertCString clan.Changee
    B.InsertByte clan.ChangeeRank
    SendBnetPacket SID_CLANRANKCHANGE
    Exit Sub
hErr:
    B.Clear
    ErrorHandler Err.Number, Err.Description, Erl, "Bot", "SendRankChange"
End Sub

Public Sub PromoteGrunts()
    If clan.Rank = CHIEFTAIN And Config.ShamanGlitch Then
        Dim ShamanCount As Integer
        ShamanCount = clan.CountShaman
        'Search Through Users for a Suitable Grunt
        Dim XG As Integer
        For XG = 1 To Users.Count
            'Check if shaman count is not too high
            If ShamanCount < 12 Then
                With Users.GetByIndex(XG)
                    'Ensure user is not on a realm and has no #
                    If InStrB(.Username, "@") = 0 And InStrB(.Username, "#") = 0 Then
                        'Find Clan Member
                        Dim CL As Integer, SG As String
                        CL = clan.Find(.Username)
                        If CL <> -1 Then
                            'Check if User is Grunt
                            If clan.GetByIndex(CL).Rank = GRUNT Then
                                'Search For Duplicate Users
                                Dim XH As Integer, Found As Boolean
                                Found = False
                                For XH = 1 To Users.Count
                                    SG = Split(Users(XH).Username, "#")(0)
                                    If LCase$(.Username) = LCase$(SG) Then
                                        'Found Duplicate Account
                                        'Do Not Promote This User
                                        Found = True
                                        Exit For
                                    End If
                                Next XH
                                'No Duplicate Found
                                'Promote This User to Shaman
                                If Not Found Then
                                    RaiseEvent SocketInfo(0, "Promoting Grunt: " & .Username & ". [Shaman Glitch Testing]", vbUseDefault)
                                    SendClanRankChange .Username, SHAMAN
                                    'Increment Shaman Count
                                    ShamanCount = ShamanCount + 1
                                End If
                            End If
                        End If
                    End If
                End With
            End If
        Next XG
    End If
End Sub

Public Sub SendClanLeave()
On Error GoTo hErr
    If LenB(clan.Tag) = 0 Then Exit Sub
    B.InsertDword GetTickCount()
    B.InsertCString Self.Username
    SendBnetPacket SID_CLANREMOVEMEMBER
    Exit Sub
hErr:
    B.Clear
    ErrorHandler Err.Number, Err.Description, Erl, "Bot", "SendLeave"
End Sub

Public Sub SendClanMemberRemove(User As String)
On Error GoTo hErr
    If LenB(clan.Tag) = 0 Then Exit Sub
    B.InsertDword GetTickCount()
    B.InsertCString User
    SendBnetPacket SID_CLANREMOVEMEMBER
    Exit Sub
hErr:
    B.Clear
    ErrorHandler Err.Number, Err.Description, Erl, "Bot", "SendRemove"
End Sub

Public Sub SendClanMemberChieftain(ByVal User As String)
On Error GoTo hErr
    B.InsertDword GetTickCount()
    B.InsertCString User
    SendBnetPacket SID_CLANMAKECHIEFTAIN
    Exit Sub
hErr:
    B.Clear
    ErrorHandler Err.Number, Err.Description, Erl, "Bot", "SendMakeChieftain"
End Sub

Public Sub SendClanMOTD()
On Error GoTo hErr
    If LenB(clan.Tag) = 0 Then Exit Sub
    B.InsertDword GetTickCount()
    SendBnetPacket SID_CLANMOTD
    Exit Sub
hErr:
    B.Clear
    ErrorHandler Err.Number, Err.Description, Erl, "Bot", "SendMOTD"
End Sub

Public Sub SendClanSetMOTD(Message As String)
On Error GoTo hErr
    If LenB(clan.Tag) = 0 Then Exit Sub
    B.InsertDword GetTickCount()
    B.InsertCString Message
    SendBnetPacket SID_CLANSETMOTD
    RaiseEvent ClanNeutral("Changing Clan Message to: " & Message & "...")
    Exit Sub
hErr:
    B.Clear
    ErrorHandler Err.Number, Err.Description, Erl, "Bot", "SendSetMOTD"
End Sub

Public Sub SendClanMemberList()
On Error GoTo hErr
    If LenB(clan.Tag) = 0 Then Exit Sub
    B.InsertDword GetTickCount()
    SendBnetPacket SID_CLANMEMBERLIST
    RaiseEvent ClanNeutral("Requesting list of clan members...")
    Exit Sub
hErr:
    B.Clear
    ErrorHandler Err.Number, Err.Description, Erl, "Bot", "SendMemberList"
End Sub

Public Sub SendClanInvitation(ByVal User As String)
On Error GoTo hErr
    clan.Invitee = User
    clan.Cookie = GetTickCount()
    B.InsertDword clan.Cookie
    B.InsertCString clan.Invitee
    SendBnetPacket SID_CLANINVITATION
    RaiseEvent ClanNeutral("Invite sent to " & User & " to join the Clan...")
    Exit Sub
hErr:
    B.Clear
    ErrorHandler Err.Number, Err.Description, Erl, "Bot", "SendInvitation"
End Sub

Public Sub SendWriteUserData(Keys())
On Error GoTo hErr
    Dim I As Integer, Count As Long
    Count = UBound(Keys)
    B.InsertDword &H1
    B.InsertDword Count + 1
    B.InsertCString Self.Username
    For I = 0 To Count
        B.InsertCString CStr(Keys(I, 0))
    Next I
    For I = 0 To Count
        Dim K As String
        K = CStr(Keys(I, 1))
        K = Replace$(K, "%ping", Self.Ping)
        K = Replace$(K, "%channel", Self.Channel)
        K = Replace$(K, "%version", frmBot.Title)
        K = Replace$(K, "%sysup", modDateTime.DateTimeToShortString(ConvertTickCount(DblTickCount)))
        K = Replace$(K, "%botup", modDateTime.DateTimeToShortString(ConvertTickCount(DblTickCount - TickLaunch)))
        B.InsertCString K
    Next I
    SendBnetPacket SID_WRITEUSERDATA
    Exit Sub
hErr:
    B.Clear
    ErrorHandler Err.Number, Err.Description, Erl, "Bot", "SendWriteProfile"
End Sub

Public Sub SendText(ByVal strText As String, Optional Username As String)
On Error GoTo hErr:
    If LenB(strText) = 0 Then Exit Sub
    'Replace Bad Characters
26  strText = Replace$(strText, vbCr, vbNullString)
27  strText = Replace$(strText, vbLf, vbNullString)
28  strText = Replace$(strText, vbNullChar, vbNullString)
1   Dim B As BNCS
2   If Left$(strText, 1) = "/" Then
        'Command Handling
3       Select Case Mid$(strText, 2, 1)
        Case "/"
            'Second Command Handler
            Do Until Left$(strText, 1) <> "/" Or Len(strText) = 0
                strText = Mid$(strText, 2)
            Loop
4           For Each B In frmBot.Bot
5               If B.IsLoaded Then B.SendText "/" & strText, Username
            Next B
            Exit Sub
        Case "~"
7           For Each B In frmBot.Bot
8               If B.IsLoaded And B.Self.IsOperator Then B.SendText "/" & Mid$(strText, 3), Username
            Next B
            Exit Sub
        Case "`"
10          For Each B In frmBot.Bot
11              If B.IsLoaded And Not B.Self.IsOperator Then B.SendText "/" & Mid$(strText, 3), Username
            Next B
            Exit Sub
        Case "@"
            Dim Gate As String
13          Gate = GetServerName(Config.Server)
14          For Each B In frmBot.Bot
15              If B.IsLoaded And GetServerName(B.Config.Server) = Gate Then B.SendText "/" & Mid$(strText, 3), Username
            Next B
            Exit Sub
        Case Else
17          Dim CS As New clsCommandSettings
18          CS.Username = GetAccount(Username)
19          CS.Index = BotIndex
24          CS.Display = IIf(LenB(CS.Username) = 0, 3, 0)
            If InStr(strText, "; ") <> 0 Then
                Dim S() As String, I As Integer, Ran As Boolean
                S = Split(Mid$(strText, 2), "; ")
                For I = 0 To UBound(S)
                    CS.Command = S(I)
                    If InStr(CS.Command, " ") <> 0 Then
                        CS.Message = Split(CS.Command, " ", 2)(1)
                        CS.Command = Split(CS.Command, " ", 2)(0)
                    End If
                    If Not cp_RunCommand(CS) Then
                        SendAway "/" & S(I)
                    End If
                Next I
                Exit Sub
            Else
20              CS.Command = Mid$(strText, 2)
21              If InStrB(CS.Command, " ") <> 0 Then
22                  CS.Message = Split(CS.Command, " ", 2)(1)
23                  CS.Command = Split(CS.Command, " ", 2)(0)
                End If
25              If cp_RunCommand(CS) Then Exit Sub
            End If
        End Select
    End If
    'Finally Send Away
29  If Len(strText) > 200 Then
30      SendAway Left$(strText, 200)
31      SendText Mid$(strText, 201)
    Else
32      SendAway strText
    End If
Exit Sub
hErr:
    ErrorHandler Err.Number, Err.Description, Erl, "Bot", "SendText"
End Sub

Public Sub SendNow(strText As String)
On Error GoTo hErr:
1   If LenB(strText) = 0 Then Exit Sub
2   If Left$(strText, 1) = "/" Then
3       Dim T() As String, U() As String
        If LenB(strText) < 2 Then Exit Sub
        If InStrB(strText, " ") Then
4           T = Split(Mid$(strText, 2), " ", 2)
			If UBound(T) = 0 Then Exit Sub
            Select Case LCase(T(0))
            Case "ban", "kick", "unban"
16              U = Split(T(1), " ", 2)
17              If UBound(U) = 1 Then
18                  strText = "/" & LCase$(T(0)) & " " & GetAccount(U(0)) & " " & U(1)
                Else
19                  strText = "/" & LCase$(T(0)) & " " & GetAccount(U(0))
                End If
            Case "sweep"
5               If Self.IsOperator = False Then Exit Sub
6               Sweep.Mode = 0
7               Sweep.Tick = GetTickCount()
8               Sweep.Channel = T(1)
9               strText = "/who " & T(1)
            Case "ipsweep"
10              If Self.IsOperator = False Then Exit Sub
11              Sweep.Mode = 1
12              Sweep.Tick = GetTickCount()
13              Sweep.Channel = T(1)
14              strText = "/who " & T(1)
            Case "nudgesweep"
                Sweep.Mode = 2
                Sweep.Tick = GetTickCount()
                Sweep.Channel = T(1)
                strText = "/who " & T(1)
            Case "whisper", "designate", "w", "message", "m", "whois", "where", "ignore", "unignore", "squelch", "unsquelch"
20              U = Split(T(1), " ", 2)
21              If UBound(U) = 1 Then
22                  strText = "/" & LCase$(T(0)) & " " & GetAccount(U(0)) & " " & U(1)
                Else
23                  strText = "/" & LCase$(T(0)) & " " & GetAccount(U(0))
                End If
            End Select
24          Erase T
25          Erase U
        End If
    End If
26  If options.DisableUTF8Encode Then
27      B.Buffer = strText & vbNullChar
    Else
28      B.Buffer = UTF8Encode(strText & vbNullChar)
    End If
29  B.SendBnetPacket sckBnet, &HE
30  Self.TickActive = DblTickCount
31  RaiseEvent BotTalk(strText)
    Exit Sub
hErr:
    ErrorHandler Err.Number, Err.Description, Erl, "Bot", "SendNow"
End Sub

Public Sub SendAway(ByVal strText As String)
On Error GoTo hErr
    Dim Share As Boolean
    'Check if Command is Shareable
    If LenB(strText) = 0 Then Exit Sub
2   If Left$(strText, 1) = "/" And InStrB(strText, " ") Then
        If LenB(strText) < 2 Then Exit Sub
        Dim Comm As String
3       Comm = LCase$(Prefix(Mid$(strText, 2), " "))
        Select Case Comm
        Case "ban", "kick", "unban": Share = True
        End Select
    End If
4   ShareQ.QAdd strText, Share, BotIndex
5   scProcessArg "", "Event_SendMessage", strText
    If frmBot.tmrShareQ.Enabled = False Then frmBot.tmrShareQ.Enabled = True
    Exit Sub
hErr:
    ErrorHandler Err.Number, Err.Description, Erl, "Bot", "SendAway"
End Sub

Public Sub SendLines(Text As String, Optional Prefix As String = vbNullString)
On Error GoTo hErr
    If InStrB(Text, vbNewLine) <> 0 Then
        Dim I As Integer, S() As String, Count As Long
        S = Split(Text, vbNewLine)
        Count = UBound(S)
        For I = 0 To Count
            If LenB(S(I)) <> 0 Then SendText Prefix & S(I)
        Next I
    Else
        If LenB(Text) <> 0 Then SendText Prefix & Text
    End If
    Exit Sub
hErr:
    ErrorHandler Err.Number, Err.Description, Erl, "Bot", "SendLines"
End Sub

Public Sub SendEnterChat()
On Error GoTo hErr
    RaiseEvent SocketInfo(0, "Entering chat environment...", vbUseDefault)
    B.InsertCString Config.Username
    B.InsertByte &H0
    SendBnetPacket SID_ENTERCHAT
    SendGetBnetChannels
    SendJoinChannel "The Void", &H1, False
    Self.TickOnline = DblTickCount()
    Exit Sub
hErr:
    B.Clear
    ErrorHandler Err.Number, Err.Description, Erl, "Bot", "SendEnterChat"
End Sub

Public Sub SendGetBnetChannels()
    B.InsertDword &H0
    SendBnetPacket SID_GETBnetChannels
End Sub

Public Sub ProfileLookup(Username As String, Send As Boolean, Optional Client As String)
On Error GoTo hErr
    Username = Suffix(Username)
    Dim Keys() As String, P As String
    Select Case UCase$(Client)
    Case "STAR", "SEXP", "W2BN", "D2DV", "D2XP", "WAR3", "W3XP", _
        "DRTL", "DSHR", "SSHR", "JSTR"
        P = UCase$(Client)
    End Select
    If LenB(P) = 0 Then
        Dim U As clsUser
        Set U = Users.GetByName(Username)
        If Not U Is Nothing Then
            P = U.Client
        Else
            P = Self.ProductID
        End If
    End If
    Select Case P
    Case "D2DV", "D2XP", "DRTL", "DSHR", "CHAT"
        ReDim Keys(3)
    Case "WAR3", "W3XP"
        If Not Self.IsWarCraft3 Then
            ReDim Keys(15)
        Else
            ReDim Keys(3)
        End If
    Case "W2BN"
        ReDim Keys(23)
    Case Else
        ReDim Keys(15)
    End Select
    
    ProfileReq.ProductID = P
    
    Keys(0) = "profile\age"
    Keys(1) = "profile\sex"
    Keys(2) = "profile\location"
    Keys(3) = "profile\description"
    If UBound(Keys) > 3 Then
        Keys(4) = "record\" & P & "\0\wins"
        Keys(5) = "record\" & P & "\0\losses"
        Keys(6) = "record\" & P & "\0\disconnects"
        Keys(7) = "record\" & P & "\0\last game"
        Keys(8) = "record\" & P & "\0\last game result"
        Keys(9) = "record\" & P & "\1\wins"
        Keys(10) = "record\" & P & "\1\losses"
        Keys(11) = "record\" & P & "\1\disconnects"
        Keys(12) = "record\" & P & "\1\last game result"
        Keys(13) = "record\" & P & "\1\rating"
        Keys(14) = "record\" & P & "\1\high rating"
        Keys(15) = "DynKey\" & P & "\1\rank"
        If UBound(Keys) > 15 Then
            Keys(16) = "record\" & P & "\3\wins"
            Keys(17) = "record\" & P & "\3\losses"
            Keys(18) = "record\" & P & "\3\disconnects"
            Keys(19) = "record\" & P & "\3\last game"
            Keys(20) = "record\" & P & "\3\last game result"
            Keys(21) = "record\" & P & "\3\rating"
            Keys(22) = "record\" & P & "\3\high rating"
            Keys(23) = "DynKey\" & P & "\3\rank"
        End If
    End If
    SendReadUserData Username, Keys, Send
    Exit Sub
hErr:
    ErrorHandler Err.Number, Err.Description, Erl, "Bot", "ProfileLookup"
End Sub

Public Sub SendClanMemberInfo(Username As String, ClanTag As String)
    If LenB(Username) = 0 Then Exit Sub
    ProfileReq.Username = Username
    If LenB(ClanTag) = 0 Then
        Dim U As clsUser
        Set U = Users.GetByName(ProfileReq.Username)
        If Not U Is Nothing Then
            ProfileReq.ClanTag = GetClanName(U.Statstring)
            If LenB(ProfileReq.ClanTag) Then
                ProfileReq.ClanTag = StrReverse$(Left$(ProfileReq.ClanTag & String$(4, vbNullChar), 4))
            End If
        End If
        If LenB(ProfileReq.ClanTag) = 0 Then
            Dim C As clsClanMember
            Set C = clan.GetByName(ProfileReq.Username)
            If Not C Is Nothing Then
                ProfileReq.ClanTag = clan.Tag
                If LenB(ProfileReq.ClanTag) Then
                    ProfileReq.ClanTag = StrReverse$(Left$(ProfileReq.ClanTag & String$(4, vbNullChar), 4))
                End If
            End If
        End If
    Else
        ProfileReq.ClanTag = StrReverse$(Left$(ClanTag & String$(4, vbNullChar), 4))
    End If
    If Len(ProfileReq.ClanTag) = 4 Then
        CMCookie = 0
        B.InsertDword GetTickCount
        B.InsertFixedString ProfileReq.ClanTag
        B.InsertCString ProfileReq.Username
        SendBnetPacket SID_CLANMEMBERINFORMATION
    End If
End Sub

Public Sub SendReadUserData(Username As String, Keys() As String, Send As Boolean, Optional RequestID As Long = 0)
On Error GoTo hErr
    Dim Count As Long
    Count = UBound(Keys)
    B.InsertDword &H1
    B.InsertDword Count + 1
    B.InsertDword GetTickCount()
    B.InsertCString Username
    Dim I As Integer
    For I = 0 To Count
        B.InsertCString Keys(I)
    Next I
    SendBnetPacket SID_READUSERDATA
    ProfileReq.RequestID = RequestID
    ProfileReq.Send = Send
    ProfileReq.Username = Username
    ProfileReq.Self = False
    Exit Sub
hErr:
    B.Clear
    ErrorHandler Err.Number, Err.Description, Erl, "Bot", "SendReadProfile"
End Sub

Public Sub SendReadAccountKeys()
On Error GoTo hErr
    Dim rk() As String, U As Integer, I As Integer
    
    ReDim rk(0)
    
    If Not options.FilterAccount Then
        'account (5 keys)
        ReDim Preserve rk(4)
        rk(0) = "system\username"
        rk(1) = "system\account created"
        rk(2) = "system\last logon"
        rk(3) = "system\last logoff"
        rk(4) = "system\time logged"
    End If
    
    If UBound(rk) = 0 Then Exit Sub
    U = UBound(rk)
    B.InsertDword &H1
    B.InsertDword U + 1
    B.InsertDword GetTickCount()
    B.InsertCString Self.Username
    For I = 0 To U
        B.InsertCString rk(I)
    Next I
    SendBnetPacket SID_READUSERDATA
    ProfileReq.Send = False
    ProfileReq.Username = Self.Username
    ProfileReq.Self = True
    Exit Sub
hErr:
    B.Clear
    ErrorHandler Err.Number, Err.Description, Erl, "Bot", "SendReadAccountKeys"
End Sub

Public Sub SendJoinChannel(Channel As String, Optional Flags As Long = &H0, Optional Leave As Boolean = True)
On Error GoTo hErr
    If Leave Then SendBnetPacket SID_LEAVECHAT
    If Flags = &H1 Then
        If (Left$(Config.ProductID, 2) = "D2") Then
            B.InsertDword &H5
        Else
            B.InsertDword &H1
        End If
    Else
        B.InsertDword Flags
    End If
    B.InsertCString Channel
    SendBnetPacket SID_JOINCHANNEL
    Exit Sub
hErr:
    B.Clear
    ErrorHandler Err.Number, Err.Description, Erl, "Bot", "SendJoinChannel"
End Sub

Public Sub SendGameList(Conditions As String, Optional RequestID As Long = 0)
    Dim Condition1 As Integer
    Select Case UCase$(Conditions)
        Case "MELEE":       Condition1 = &H2
        Case "FFA":         Condition1 = &H3
        Case "1V1":         Condition1 = &H4
        Case "CTF":         Condition1 = &H5
        Case "GREED":       Condition1 = &H6
        Case "SLAUGHTER":   Condition1 = &H7
        Case "SUDDEN":      Condition1 = &H8
        Case "LADDER":      Condition1 = &H9
        Case "IRONMAN":     Condition1 = &H10
        Case "UMS":         Condition1 = &HA
        Case "TEAM MELEE":  Condition1 = &HB
        Case "TEAM FFA":    Condition1 = &HC
        Case "TEAM CTF":    Condition1 = &HD
        Case "TVB":         Condition1 = &HF
        Case Else:          Condition1 = &H0
    End Select

    B.Clear
    B.InsertWord Condition1
    B.InsertWord &H0
    B.InsertDword &H0
    B.InsertDword &H0
    B.InsertDword &HFF
    B.InsertCString vbNullString
    B.InsertCString vbNullString
    B.InsertCString vbNullString
    B.SendBnetPacket sckBnet, &H9
    GameRequestID = RequestID
    
'(WORD) Product-specific condition 1
'(WORD) Product-specific condition 2
'(DWORD) Product-specific condition 3
'(DWORD) Product-specific condition 4
'(DWORD) List count
'(STRING) Game name
'(STRING) Game password
'(STRING) Game stats
End Sub

Public Sub SendRealmGameList()
    On Error GoTo hErr
1   RaiseEvent SocketInfo(3, "REALM: Requesting list of games...", vbUseDefault)
2   B.Clear
3   B.InsertWord 0
4   B.InsertDword 0
5   B.InsertByte 0
6   B.SendRealmPacket sckRealm, &H5
    Exit Sub
hErr:
    ErrorHandler Err.Number, Err.Description, Erl, "Bot", "SendRealmGameList"
End Sub

Public Sub SendFriendsList()
    B.Clear
    SendBnetPacket &H65
End Sub

Public Sub PerformBan(ByVal Username As String, ByVal Message As String)
    If Not Self.IsOperator Then Exit Sub
    If IsOnGateway(Username) Then
        SendText "/ban " & Username & " " & Message
    Else
        SendText "/ban " & Username & "@" & GetServerName(Config.Server, Config.IsWarCraft3) & " " & Message
    End If
End Sub

Public Sub ModerateUser(ByVal CE As clsChatEvent)
On Error GoTo hErr:
    'Check if Operator
    If Not Self.IsOperator Then Exit Sub
    'Check if Safe
    If cp_GetAccess2(CE.Username, CE.Index).Safe Then Exit Sub
    'Check if User is Operator
    If (CE.Flags And &H2) Then Exit Sub
    'Check if Bannable
    Dim U As clsUser, P As String, IG As Boolean
    Set U = Users.GetByName(CE.Username)
    IG = (CE.Flags And USER_SQUELCHED)
    If Not U Is Nothing Then
        P = U.Client
        If Not U.IsBannable Then Exit Sub
    End If
    Set U = Nothing
    
    Dim Rank As RankingStruct
    Rank = cp_GetAccess2(CE.Username, CE.Index)
    
    If LenB(Rank.RankName) Then
        If Rank.Flagged Then
            With Rank
                If LenB(.Message) Then
                    Dim M As String, S() As String, SN As Integer
                    M = .Message
                    M = Replace$(M, "%u", CE.Username)
                    M = Replace$(M, "%t", Config.Trigger)
                    M = Replace$(M, "%f", CE.Flags)
                    M = Replace$(M, "%p", CE.Ping)
                    S = Split(M, "; ")
                    For SN = 0 To UBound(S)
                        SendText S(SN)
                    Next
                    Erase S
                End If
            End With
        End If
    End If
     
    With Config.Op
23      If .IPBan And IG Then PerformBan CE.Username, "IP": Exit Sub
24      If .NextBan Then PerformBan CE.Username, "Next": .NextBan = False: Exit Sub
25      If .LockDown Then PerformBan CE.Username, "Lockdown": Exit Sub
26      If .HashBan And InStrB(CE.Username, "#") <> 0 Then PerformBan CE.Username, "#": Exit Sub
27      If .RandomBan Then
            Dim RBUser As String
            RBUser = StripGateway(Suffix(CE.Username))
            If IsRandom(RBUser) Or IsRandomNum(RBUser) Then
                PerformBan CE.Username, "Random"
                Exit Sub
            End If
        End If
        If CE.EID = EID_JOIN Or CE.EID = EID_SHOWUSER Then
            If .StatBan Then
                Dim SM As String
                If .StatMatch(CE.Message, SM) Then
                    PerformBan CE.Username, "StatBan=>" & SM
                End If
            End If
        End If
28      If CE.EID = EID_JOIN Then
            If clan.Count <> 0 And Len(clan.Tag) <> 0 Then
                If .OutsiderBan Then If LCase$(GetClanName(CE.Message)) <> LCase$(clan.Tag) Then PerformBan CE.Username, "Outsider": Exit Sub
            End If
            If .ClanBan Then
                Dim CLN As String
                CLN = GetClanName(CE.Message)
                Dim N() As String, NI As Integer
                N = Split(.GetClans, ",")
                'Search Through Clans
                For NI = 0 To UBound(N)
                    If LenB(N(NI)) Then
                        'If Found Ban
                        If LCase$(N(NI)) = LCase$(CLN) Then
                            PerformBan CE.Username, "Clan " & CLN: Exit Sub
                        End If
                    End If
                Next
            End If
29          If .DodgeBan Then
30              If Banned.IsBanned(CE.Username) Then PerformBan CE.Username, "Dodge": Exit Sub
            End If
            Static Counter As Long
31          If .LoadBan Then
                Dim I As Integer
                If (Counter > 5) Then
32                  For I = 0 To 5
                        RecentUsers(I) = vbNullString
                        RecentTicks(I) = 0
                    Next I
33                  Counter = 0
                End If
34              RecentUsers(Counter) = CE.Username: RecentTicks(Counter) = GetTickCount
35              Counter = Counter + 1
36              If (RecentTicks(5) > 0) Then
37                 If (RecentTicks(5) - RecentTicks(0)) < 3000 Then
38                     For I = 0 To 3
                            If Not cp_GetAccess2(RecentUsers(I), CE.Index).Safe Then PerformBan RecentUsers(I), "Load"
                       Next I
                   End If
                End If
             End If
        End If
    End With
    
    CE.Index = BotIndex
    CE.EID = EID_MODERATEUSER
40  plChat CE
Exit Sub
hErr:
    ErrorHandler Err.Number, Err.Description, Erl, "Bot", "moderateUser"
End Sub

Public Sub CheckChannel()
On Error GoTo hErr
    If Self.IsOperator Then
        Dim I As Integer
        For I = 0 To Users.Count
            Dim CE As New clsChatEvent
            CE.Username = Users.GetByIndex(I).Account
            CE.Flags = Users.GetByIndex(I).Flags
            CE.Ping = Users.GetByIndex(I).Ping
            CE.Message = Users.GetByIndex(I).Statstring
            CE.Index = BotIndex
            ModerateUser CE
        Next I
    End If
    Exit Sub
hErr:
    ErrorHandler Err.Number, Err.Description, Erl, "Bot", "CheckChannel"
End Sub

Public Sub VetoQueuedItem()
On Error Resume Next
    If Not ShareQ.QV Is Nothing Then
        ShareQ.QDelete ShareQ.QV.Text, ShareQ.QV.Index
    End If
End Sub

Public Sub SendBnetPacket2(id As Byte, Data As String)
    'Check for packet debugging
    If id = SID_CHATCOMMAND And IsConnected Then
        SendText Data
        Exit Sub
    End If
    B.Buffer = Data
    Select Case id
    Case SID_WRITEUSERDATA, SID_READUSERDATA, SID_LEAVECHAT
        If IsOnline And IsConnected Then B.SendBnetPacket sckBnet, id
    Case Else
        B.SendBnetPacket sckBnet, id
    End Select
End Sub

Public Sub SendBnetPacket(id As Byte)
    'Check if outgoing packet is overridden
    On Error Resume Next
    Dim VP As clsPlugPacket, P As New clsPlug, C As Integer, Buf As String
    Buf = B.Buffer
    For Each VP In OutPackets
        If VP.PacketID = id Then
            For C = 0 To UBound(modPlugins.Plugins())
                Set P = modPlugins.Plugins(C)
                If LCase$(P.Name) = LCase$(VP.Plugin) Then
                    If PluginEnabled(P.Name) Then
                        Debug.Print P.Name & " overrides outgoing packet " & id
                        CallByName P.Client, VP.Routine, VbMethod, _
                            BotIndex, id, Buf
                        If VP.Override Then B.Clear: Exit Sub
                    End If
                End If
            Next
        End If
    Next
    B.Buffer = Buf
    
    'Check for packet debugging
    If id = SID_CHATCOMMAND And IsConnected Then
        Dim M As String
        M = UTF8Decode(CStr(Split(B.Buffer, vbNullChar)(0)))
        RaiseEvent BotTalk(M)
        Self.TickActive = DblTickCount()
    End If
    Select Case id
    Case SID_CHATCOMMAND, SID_WRITEUSERDATA, SID_READUSERDATA, SID_LEAVECHAT
        If IsOnline And IsConnected Then B.SendBnetPacket sckBnet, id
    Case Else
        B.SendBnetPacket sckBnet, id
    End Select
End Sub