VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "mswinsck.ocx"
Begin VB.UserControl BNCS 
   ClientHeight    =   1155
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   915
   BeginProperty Font 
      Name            =   "Courier New"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   InvisibleAtRuntime=   -1  'True
   ScaleHeight     =   1155
   ScaleWidth      =   915
   Windowless      =   -1  'True
   Begin MSWinsockLib.Winsock sckRealm 
      Left            =   0
      Top             =   360
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.Timer tmrIdle 
      Interval        =   60000
      Left            =   480
      Top             =   360
   End
   Begin VB.Timer tmrKeepAlive 
      Interval        =   40000
      Left            =   480
      Top             =   720
   End
   Begin VB.Timer tmrQueue 
      Interval        =   10
      Left            =   0
      Top             =   720
   End
   Begin MSWinsockLib.Winsock sckBnls 
      Left            =   480
      Top             =   0
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSWinsockLib.Winsock sckBnet 
      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
Option Explicit

Event ChannelListing(Channels() As String)
Event AddChat(Color As Long, Message As String)
Event BnlsConnecting()
Event BnlsConnected()
Event BnlsDisconnect()
Event BnlsError(Number As Integer, Description As String)
Event BnetConnecting()
Event BnetConnected()
Event BnetDisconnect()
Event BnetError(Number As Integer, Description As String)
Event ChatEnterChannel(Channel As String, Flags As Long)
Event ChatUserEmote(Username As String, Message As String, Ping As Long, Flags As Long)
Event ChatUserHere(Username As String, statstring As String, Ping As Long, Flags As Long)
Event ChatUserJoin(Username As String, statstring As String, Ping As Long, Flags As Long)
Event ChatUserLeave(Username As String)
Event ChatUserTalk(Username As String, Message As String, Ping As Long, Flags As Long)
Event ChatUserUpdate(Username As String, Message As String, Ping As Long, Flags As Long)
Event ChatUserWhisper(Username As String, Message As String, Ping As Long, Flags As Long)
Event ChatUserWhisperFrom(Username As String, Message As String, Ping As Long, Flags As Long)
Event ChatInformation(Message As String)
Event ChatError(Message As String)
Event ChatBroadcast(Username As String, Message As String)
Event ChatMessageSent(Message As String)
Event CharacterListing(Count As Long, Characters() As String, Classes() As String, Levels() As String, Expiry() As Date)
Event RealmListing(Count As Long, Realms() As String)
Event RealmConnecting()
Event RealmConnected()
Event RealmDisconnect()
Event RealmError(Number As Integer, Description As String)

Event ClanDisband(Result As Byte)
Event ClanInfo(Rank As String, Tag As String)
Event ClanInvitation(Result As Byte, User As String)
Event ClanInvitationResponse(Name As String, Tag As String, Inviter As String)
Event ClanMakeChieftain(Result As Byte)
Event ClanQuitNotify()
Event ClanRankChange(Result As Byte)
Event ClanRemoveMember(Result As Byte)
Event ClanFindCandidates(Cookie As Long, Result As Byte, Count As Byte, Candidates() As String)
Event ClanInviteMultiple(Result As Byte, Candidates() As String)
Event ClanCreationInvitation(Name As String, Tag As String, Inviter As String, Count As Byte, Candidates() As String)

Private Database() As New clsDbUser
Private Users() As New clsUser, ClanMembers() As New clsClanMember
Private TryReconnect As Boolean, ConnectingTick As Long
Private QueueTick As Long, QueueDelay As Long, Queue As New Collection
Private Cookie As Long, InviteTag As Long, InviteName As String, Inviter As String, InviteTagStr As String
Private InviteUser As String, InviteCookie As Long, InviteTick As Long
Private FirstChannel As Boolean, Chunk1 As String, Chunk2 As String
Private ProfileSend As Boolean, ProfileUser As String

Public NudgeTick As Long
Public NudgeCount As Integer
Public BeepTick As Long
Public BeepCount As Integer

Public JoinTick As Long
Public JoinUser As String
Public PendingTicTacToe As String
Public LastTicTacToeRequest As Long
Public ChannelList As New Collection
Public BotIndex As Integer
Public Profile As String
Public DbFile As String
Public IsLoaded As Boolean
Public Config As New clsConfig
Public Self As New clsSelf
Public Verbyte As Long
Public IsOnline As Boolean
Public IsActive As Boolean

Private b As New clsPacketBuffer, r As New clsPacketDebuffer, Realm As New clsRealm
Private serverToken As Long, clientToken As Long, mpqFiletime As String, mpqFilename As String, _
    valueString As String, digest As String, version As Long, checksum As Long, nls_used As Boolean, _
    nls As Long, nls_A As String * 32, nls_s As String, nls_B As String, nls_M1 As String * 20, _
    nls_buf As String * 84, nls_old As Long, nls_new As Long, nls_M2 As String

Public Sub ClearDatabase()
    ReDim Database(0)
End Sub
Public Function AddMember(ByVal Member As String, ByVal Attributes As String) As Boolean
    On Error GoTo hErr:
    If (FindMemberAttributes(Member) = 0) Then
        If LenB(Database(0).Member) = 0 Then
            Database(0).Member = Member
            Database(0).Attributes = StringToAttribute(Attributes)
        Else
            ReDim Preserve Database(UBound(Database) + 1)
            Database(UBound(Database)).Member = Member
            Database(UBound(Database)).Attributes = StringToAttribute(Attributes)
        End If
        AddMember = True
        SaveDatabase
    End If
    Exit Function
hErr:
    ErrorHandler "Bot", "AddMember"
End Function
Public Function FindMemberAttributes(ByVal Member As String) As Long
    On Error GoTo hErr:
    Dim I As Integer, r As Integer
    For I = 0 To UBound(Database)
        If LCase$(GetAccount(Database(I).Member)) = LCase$(GetAccount(Member)) Then
            FindMemberAttributes = Database(I).Attributes
            Exit Function
        End If
    Next
    Exit Function
hErr:
    ErrorHandler "Bot", "FindMemberAttributes"
End Function
Public Function RemoveMember(ByVal Member As String) As Boolean
    On Error GoTo hErr:
    Dim I As Integer, r As Integer
    For I = 0 To UBound(Database)
        If LCase$(Database(I).Member) = LCase$(Member) Then
            'PROBLEMATIC!!!!!!!!!!!!!
            If UBound(Database) > 0 Then
                For r = I To UBound(Database) - 1
                    Database(r) = Database(r + 1)
                Next r
                ReDim Preserve Database(UBound(Database) - 1)
            Else
                ReDim Database(0)
            End If
            RemoveMember = True
            SaveDatabase
            Exit Function
        End If
    Next
    Exit Function
hErr:
    ErrorHandler "Bot", "RemoveMember"
End Function
Public Sub ReloadDatabase()
    On Error GoTo hErr:
    Dim strLine As String
    ClearDatabase
    If fso.FileExists(DbFile) = False Then fso.CreateTextFile DbFile
    Open DbFile For Input As #1
    Do Until EOF(1)
    Line Input #1, strLine
        If InStrB(strLine, "\") > 0 Then
            Dim Member As String, Attributes As Long
            Member = Trim$(Left$(strLine, InStr(strLine, "\") - 1))
            Attributes = StringToAttribute(Trim$(Mid$(strLine, InStr(strLine, "\") + 1)))
            If (LenB(Member) > 0) And (Attributes > 0) Then
                If (LenB(Database(0).Member) = 0) Then
                    Database(0).Member = Member
                    Database(0).Attributes = Attributes
                Else
                    ReDim Preserve Database(UBound(Database) + 1)
                    Database(UBound(Database)).Member = Member
                    Database(UBound(Database)).Attributes = Attributes
                End If
            End If
        End If
    Loop
    Close #1
    Exit Sub
hErr:
    ErrorHandler "Bot", "ReloadDatabase"
End Sub
Public Sub SaveDatabase()
    On Error GoTo hErr:
    Dim ff As Integer: ff = FreeFile
    If fso.FileExists(DbFile) = False Then fso.CreateTextFile DbFile
    Open DbFile For Output As #ff
        Dim I As Integer
        For I = 0 To UBound(Database)
            If LenB(Database(I).Member) > 0 And Database(I).Attributes > 0 Then
                Print #1, Database(I).Member & "\" & Database(I).AttributeString
            End If
        Next
    Close #ff
    Exit Sub
hErr:
    ErrorHandler "Bot", "SaveDatabase"
End Sub

Public Sub ClearClanMembers()
    ReDim ClanMembers(0)
End Sub
Public Function IsRealmOnline() As Boolean
    IsRealmOnline = (sckRealm.State = sckConnected)
End Function
Public Function IsConnected() As Boolean
    IsConnected = (sckBnet.State = sckConnected)
End Function
Public Function GetAccount(ByVal Username As String) As String
    On Error GoTo hErr
    If InStrB(Username, "*") > 0 Then
        Username = Mid$(Username, InStrRev(Username, "*") + 1)
    End If
    If IsDiablo Then
        GetAccount = "*" & Username
    Else
        GetAccount = Username
    End If
    Exit Function
hErr:
    ErrorHandler "Bot", "GetAccount"
End Function
Public Function ClanMemberRank(ByRef Username As String) As CLANRANKENUM
    On Error GoTo hErr
    If Self.Clanned Then
        Dim I As Integer
        For I = 1 To UBound(ClanMembers)
            If Username = ClanMembers(I).Username Then
                ClanMemberRank = ClanMembers(I).Rank
                Exit Function
            End If
        Next I
    End If
    Exit Function
hErr:
    ErrorHandler "Bot", "ClanMemberRank"
End Function
Public Function ClanMemberStatus(ByRef Username As String) As Byte
    On Error GoTo hErr
    If Self.Clanned Then
        Dim I As Integer
        For I = 1 To UBound(ClanMembers)
            If Username = ClanMembers(I).Username Then
                ClanMemberStatus = ClanMembers(I).Online
                Exit Function
            End If
        Next I
    End If
    Exit Function
hErr:
    ErrorHandler "Bot", "ClanMemberStatus"
End Function
Public Function ClanMemberLocation(ByRef Username As String) As String
    On Error GoTo hErr
    If Self.Clanned Then
        Dim I As Integer
        For I = 1 To UBound(ClanMembers)
            If Username = ClanMembers(I).Username Then
                ClanMemberLocation = ClanMembers(I).Location
                Exit Function
            End If
        Next I
    End If
    Exit Function
hErr:
    ErrorHandler "Bot", "ClanMemberLocation"
End Function
Public Function UserRepresentative(ByRef Username As String) As Boolean
    On Error GoTo hErr
    Dim I As Integer
    For I = 0 To UBound(Users)
        If (Suffix(Username) = Users(I).Account) Then
            UserRepresentative = Users(I).Representative
            Exit Function
        End If
    Next I
    Exit Function
hErr:
    ErrorHandler "Bot", "UserRepresentative"
End Function
Public Function UserOperator(ByRef Username As String) As Boolean
    On Error GoTo hErr
    Dim I As Integer
    For I = 0 To UBound(Users)
        If (Suffix(Username) = Users(I).Account) Then
            UserOperator = Users(I).Operator
            Exit Function
        End If
    Next I
    Exit Function
hErr:
    ErrorHandler "Bot", "UserOperator"
End Function
Public Function UserInvisible(ByRef Username As String) As Boolean
    On Error GoTo hErr
    Dim I As Integer
    For I = 0 To UBound(Users)
        If (Suffix(Username) = Users(I).Account) Then
            UserInvisible = Users(I).Invisible
            Exit Function
        End If
    Next I
    Exit Function
hErr:
    ErrorHandler "Bot", "UserInvisible"
End Function
Public Function UserUptime(ByRef Username As String) As Double
    On Error GoTo hErr
    Dim I As Integer
    For I = 0 To UBound(Users)
        If (Suffix(Username) = Users(I).Account) Then
            UserUptime = Users(I).JoinTick
            Exit Function
        End If
    Next I
    UserUptime = -1
    Exit Function
hErr:
    UserUptime = -1
    ErrorHandler "Bot", "UserUptime"
End Function
Public Function UserTalked(ByRef Username As String) As Long
    On Error GoTo hErr
    Dim I As Integer
    For I = 0 To UBound(Users)
        If (Suffix(Username) = Users(I).Account) Then
            UserTalked = Users(I).TalkTick
            Exit Function
        End If
    Next I
    UserTalked = -1
    Exit Function
hErr:
    UserTalked = -1
    ErrorHandler "Bot", "UserTalked"
End Function
Public Function UserIndex(ByRef Username As String) As Integer
    On Error GoTo hErr
    Dim I As Integer
    For I = 0 To UBound(Users)
        If (Suffix(Username) = Users(I).Account) Then
            UserIndex = I
            Exit Function
        End If
    Next I
    UserIndex = -1
    Exit Function
hErr:
    UserIndex = -1
    ErrorHandler "Bot", "UserIndex"
End Function
Public Function UserFlags(ByRef Username As String) As Long
    On Error GoTo hErr
    Dim I As Integer
    For I = 0 To UBound(Users)
        If (Suffix(Username) = Users(I).Account) Then
            UserFlags = Users(I).Flags
            Exit Function
        End If
    Next I
    UserFlags = -1
    Exit Function
hErr:
    UserFlags = -1
    ErrorHandler "Bot", "UserFlags"
End Function
Public Function UserPing(ByRef Username As String) As Long
    On Error GoTo hErr
    Dim I As Integer
    For I = 0 To UBound(Users)
        If (Suffix(Username) = Users(I).Account) Then
            UserPing = Users(I).Ping
            Exit Function
        End If
    Next I
    UserPing = -1
    Exit Function
hErr:
    UserPing = -1
    ErrorHandler "Bot", "UserPing"
End Function
Public Function UserStatstring(ByRef Username As String) As String
    On Error GoTo hErr
    Dim I As Integer
    For I = 0 To UBound(Users)
        If (Suffix(Username) = Users(I).Account) Then
            UserStatstring = Users(I).statstring
            Exit Function
        End If
    Next I
    Exit Function
hErr:
    ErrorHandler "Bot", "UserStatstring"
End Function

Private Sub ClearUsers()
    ReDim Users(0)
End Sub

Private Sub AddUser(Username As String, statstring As String, Flags As Long, Ping As Long, Optional Invisible As Boolean = False)
    On Error GoTo hErr
    If UBound(Users) > 0 Or Users(0).Account = Suffix(Username) Then RemoveUser Username
    Dim u As New clsUser
    u.Username = Username
    u.statstring = statstring
    u.Flags = Flags
    u.Ping = Ping
    u.JoinTick = NowTickCount()
    u.TalkTick = 0
    u.Invisible = Invisible
    If LCase$(Suffix(Username)) = LCase$(Self.Username) Then
        Self.Ping = Ping
        Self.Flags = Flags
        Self.statstring = statstring
    End If
    If (LenB(Users(0).Username) = 0) Then
        Set Users(0) = u
    Else
        ReDim Preserve Users(UBound(Users) + 1)
        Set Users(UBound(Users)) = u
    End If
    Exit Sub
hErr:
    ErrorHandler "Bot", "AddUser"
End Sub

Private Sub RemoveUser(Username As String)
    On Error GoTo hErr
    Dim I As Integer, r As Integer
    For I = 0 To UBound(Users)
        If (Suffix(Username) = Users(I).Account) Then
            If I = 0 Then
                Set Users(0) = New clsUser
            Else
                For r = I To UBound(Users) - 1
                    Set Users(r) = Users(r + 1)
                Next
                ReDim Preserve Users(UBound(Users) - 1)
            End If
            Exit Sub
        End If
    Next I
    Exit Sub
hErr:
    ErrorHandler "Bot", "RemoveUser"
End Sub

Private Sub UpdateUser(Username As String, Flags As Long, Ping As Long)
    On Error GoTo hErr
    If LCase$(Suffix(Username)) = LCase$(Self.Username) Then
        Self.Ping = Ping
        Self.Flags = Flags
    End If
    Dim I As Integer
    For I = 0 To UBound(Users)
        If (Suffix(Username) = Users(I).Account) Then
            Users(I).Flags = Flags
            Users(I).Ping = Ping
            Users(I).Username = Username
            Exit Sub
        End If
    Next I
    Exit Sub
hErr:
    ErrorHandler "Bot", "UpdateUser"
End Sub

Private Sub AddChat(Color As Long, Message As String)
    RaiseEvent AddChat(Color, Message)
End Sub

Public Property Get IsWarCraft() As Boolean
    IsWarCraft = (Config.ProductID = "WAR3" Or Config.ProductID = "W3XP")
End Property

Public Property Get IsDiablo() As Boolean
    IsDiablo = (Config.ProductID = "D2DV" Or Config.ProductID = "D2XP")
End Property

Public Property Get IsExpansion() As Boolean
    IsExpansion = (Config.ProductID = "D2XP" Or Config.ProductID = "W3XP")
End Property

Private Sub HandleBnlsPacket(id As Byte)
    On Error GoTo hErr
    Select Case id
        Case BNLS_REQUESTVERSIONBYTE
            If (r.ReadInt32() <> &H0) Then
                Verbyte = r.ReadInt32()
                sckBnet.Close
                If Config.Proxy.UseProxy = True Then
                    AddChat vbYellow, StrEval$("Connecting to proxy ({0}:{1})...", Config.Proxy.Proxy, Config.Proxy.Port)
                    sckBnet.Connect Config.Proxy.Proxy, Config.Proxy.Port
                Else
                    RaiseEvent BnetConnecting
                    sckBnet.Connect Config.Server, 6112
                End If
            Else
                AddChat vbRed, StrEval$("Cannot get version byte. BNLS does not support: {0}!", Config.ProductID)
            End If
        Case BNLS_VERSIONCHECKEX2
            If (r.ReadInt32() <> &H0) Then
                version = r.ReadInt32()
                checksum = r.ReadInt32()
                digest = r.ReadCString()
                SendAuthCheck
            Else
                AddChat vbRed, "CheckRevision failed on BNLS/JBLS server!"
            End If
    End Select
    Exit Sub
hErr:
    ErrorHandler "Bot", "HandleBnlsPacket"
End Sub

Private Sub HandleRealmPacket(id As Byte)
    On Error GoTo hErr
    Select Case id
    Case MCP_STARTUP
        ReceiveRealmStartup
    Case MCP_CHARLIST2
        ReceiveRealmCharList2
    Case MCP_CHARLOGON
        ReceiveRealmCharLogon
    Case MCP_CHARDELETE
        ReceiveRealmCharDelete
    Case MCP_CHARUPGRADE
        ReceiveRealmCharUpgrade
    Case MCP_CHARCREATE
        ReceiveRealmCharCreate
    Case MCP_MOTD
        ReceiveRealmMOTD
    End Select
    Exit Sub
hErr:
    ErrorHandler "Bot", "HandleRealmPacket"
End Sub

Private Sub HandleBnetPacket(id As Byte)
    On Error GoTo hErr
    Select Case id
        Case SID_AUTH_INFO
            ReceiveAuthInfo
        Case SID_AUTH_CHECK
            ReceiveAuthCheck
        Case SID_AUTH_ACCOUNTLOGON
            ReceiveAuthAccountLogon
        Case SID_AUTH_ACCOUNTLOGONPROOF
            ReceiveAuthAccountLogonProof
        Case SID_AUTH_ACCOUNTCREATE
            ReceiveAuthAccountCreate
        Case SID_AUTH_ACCOUNTCHANGE
            ReceiveAuthAccountChange
        Case SID_AUTH_ACCOUNTCHANGEPROOF
            ReceiveAuthAccountChangeProof
        Case SID_AUTH_ACCOUNTUPGRADE
            ReceiveAuthAccountUpgrade
        Case SID_AUTH_ACCOUNTUPGRADEPROOF
            ReceiveAuthAccountUpgradeProof
            
        Case SID_READUSERDATA
            ReceiveReadUserData
        
        Case SID_CHANGEPASSWORD
            ReceiveChangePassword
        Case SID_CREATEACCOUNT2
            ReceiveCreateAccount2
        Case SID_LOGONRESPONSE2
            ReceiveLogonResponse2
        Case SID_ENTERCHAT
            ReceiveEnterChat
        Case SID_GETCHANNELLIST
            ReceiveGetChannelList
        Case SID_PING
            ReceivePing
        
        Case SID_LOGONREALMEX
            ReceiveLogonRealmEx
        Case SID_QUERYREALMS2
            ReceiveQueryRealms2
        
        Case SID_CLANINFO
            ReceiveClanInfo
        Case SID_CLANQUITNOTIFY
            ReceiveClanQuitNotify
        Case SID_CLANMOTD
            ReceiveClanMOTD
        Case SID_CLANMEMBERLIST
            ReceiveClanMemberList
        Case SID_CLANDISBAND
            ReceiveClanDisband
        Case SID_CLANMAKECHIEFTAIN
            ReceiveClanMakeChieftain
        Case SID_CLANREMOVEMEMBER
            ReceiveClanRemoveMember
        Case SID_CLANMEMBERREMOVED
            ReceiveClanMemberRemoved
        Case SID_CLANMEMBERSTATUSCHANGE
            ReceiveClanMemberStatusChange
        Case SID_CLANMEMBERRANKCHANGE
            ReceiveClanMemberRankChange
        Case SID_CLANRANKCHANGE
            ReceiveClanRankChange
        
        Case SID_CLANCREATIONINVITATION
            ReceiveClanCreationInvitation
        Case SID_CLANINVITEMULTIPLE
            ReceiveClanInviteMultiple
        Case SID_CLANFINDCANDIDATES
            ReceiveClanFindCandidates
        Case SID_CLANINVITATION
            ReceiveClanInvitation
        Case SID_CLANINVITATIONRESPONSE
            ReceiveClanInvitationResponse
        
        Case SID_FLOODDETECTED
            AddChat vbRed, "Battle.net has terminated your connection for flooding!"
            Disconnect
        Case SID_MESSAGEBOX
            r.Skip 4
            AddChat vbRed, r.ReadCString()
        Case SID_WARDEN
            AddChat vbRed, "Battle.Net expects a reply to Warden packet (0x5E) however the bot cannot respond at this stage, you will be disconnected within the next 2 minutes."
        Case SID_SETEMAIL
            AddChat vbYellow, "Battle.Net requested that you bind an e-mail address with this account..."
            SendSetEmail
        Case SID_CHATEVENT
            ReceiveChatEvent
    End Select
    Exit Sub
hErr:
    ErrorHandler "Bot", "HandleBnetPacket"
End Sub

Public Sub Connect()
    On Error GoTo hErr
    If Not IsLoaded Then Exit Sub
    If LenB(Config.ProductID) = 0 Then
        AddChat vbRed, "Please select a product to connect with!"
        Exit Sub
    End If
    If LenB(Config.Username) = 0 Then
        AddChat vbRed, "Please specify a username to connect with!"
        Exit Sub
    End If
    If LenB(Config.Password) = 0 Then
        AddChat vbRed, "Please specify the password associated with that username!"
        Exit Sub
    End If
    If LenB(Config.BnlsServer) = 0 Then
        AddChat vbRed, "Please specify a BNLS server to connect to!"
        Exit Sub
    End If
    If LenB(Config.Server) = 0 Then
        AddChat vbRed, "Please specify a Battle.Net server to connect to!"
        Exit Sub
    End If
    If LenB(Config.Channel) = 0 Then
        AddChat vbRed, "Please specify a channel to join upon login!"
        Exit Sub
    End If
    If LenB(Config.Cdkey) = 0 Then
        AddChat vbRed, "Please specify a cdkey to connect with!"
        Exit Sub
    End If
    If (Config.BnlsProduct = &H6 Or Config.BnlsProduct = &H8) Then
        If LenB(Config.CdkeyEx) = 0 Then
            AddChat vbRed, "Please specify an expansion cdkey to connect with!"
            Exit Sub
        End If
    End If
    
    ConnectingTick = GetTickCount()
    TryReconnect = True
    FirstChannel = False
    Disconnect
    
    If (Config.UseBNLS) Then
        RaiseEvent BnlsConnecting
        sckBnls.Connect Config.BnlsServer, 9367
    Else
        Verbyte = CLng(Config.Verbyte)
        If (Verbyte = &H0) Then
            AddChat vbRed, StrEval$("Please specify the verbyte for: {0}!", Config.ProductID)
            Exit Sub
        End If
        If Config.Proxy.UseProxy = True Then
            AddChat vbYellow, StrEval$("Connecting to proxy ({0}:{1})...", Config.Proxy.Proxy, Config.Proxy.Port)
            sckBnet.Connect Config.Proxy.Proxy, Config.Proxy.Port
        Else
            RaiseEvent BnetConnecting
            sckBnet.Connect Config.Server, 6112
        End If
    End If
    Exit Sub
hErr:
    ErrorHandler "Bot", "Connect"
End Sub

Public Sub Disconnect()
    On Error GoTo hErr
    If Not IsLoaded Then Exit Sub
    If sckBnls.State <> sckClosed Then RaiseEvent BnlsDisconnect
    If sckBnet.State <> sckClosed Then RaiseEvent BnetDisconnect
    If nls > 0 Then nls_free nls: nls = 0
    If nls_old > 0 Then nls_free nls_old: nls_old = 0
    sckBnls.Close
    sckBnet.Close
    TryReconnect = False
    IsOnline = False
    Set Self = New clsSelf
    frmBot.mnuInClan.Visible = False
    frmBot.mnuClan.Visible = False
    Exit Sub
hErr:
    ErrorHandler "Bot", "Disconnect"
End Sub

Private Sub sckBnet_Close()
    RaiseEvent BnetDisconnect
End Sub

Private Sub sckBnet_Connect()
    On Error GoTo hErr
    sckBnet.Tag = vbNullString
    If Config.Proxy.UseProxy = True And sckBnet.RemotePort <> 6112 Then
        If UBound(Split(Config.Server, ".")) < 3 Then
            Config.Server = GetIPFromHostName(Config.Server)
            Debug.Print "Changed server to " & Config.Server
        End If
        If Config.Proxy.Socks = Socks4 Then
            AddChat vbGreen, "Proxy connected!"
            RaiseEvent BnetConnecting
            sckBnet.SendData Chr$(&H4) & Chr$(&H1) & CreateInt16(htons(6112)) & _
                CreateInt32(inet_addr(Config.Server)) & _
                Config.Proxy.Ident & vbNullChar
        Else
            AddChat vbYellow, "Proxy connected!"
            AddChat vbGreen, "Proxy is authorizing client..."
            sckBnet.SendData Chr$(&H5) & Chr$(&H1) & vbNullChar
            sckBnet.Tag = "AUTH"
        End If
    Else
        RaiseEvent BnetConnected
        SendAuthInfo
    End If
    Exit Sub
hErr:
    ErrorHandler "Bot", "BnetConnect"
End Sub

Private Sub sckBnet_DataArrival(ByVal bytesTotal As Long)
    On Error GoTo hErr
    Static strBuffer As String
    Dim strData As String, lngPacketLen As Long, bytPacketID As Byte
    sckBnet.GetData strData
    If LenB(strData) = 0 Then Exit Sub
    If Len(strData) = 8 And Not IsOnline And Config.Proxy.UseProxy And Config.Proxy.Socks = Socks4 Then
        If (Asc(Left$(strData, 1)) = &H0) Or (Asc(Left$(strData, 1)) = &H4) Then
            Select Case Asc(Mid$(strData, 2, 1))
            Case &H5A
                AddChat vbGreen, "Proxy request granted!"
                SendAuthInfo
                Exit Sub
            Case &H5B
                AddChat vbRed, "Proxy request rejected or failed!"
                Disconnect
                TryReconnect = True
                Exit Sub
            Case &H5C
                AddChat vbRed, "Proxy request failed because client is not running identd (or not reachable from the server)!"
                Disconnect
                TryReconnect = True
                Exit Sub
            Case &H5D
                AddChat vbRed, "Proxy request failed because client's identd could not confirm the user ID string in the request!"
                Disconnect
                TryReconnect = True
                Exit Sub
            End Select
        End If
    End If
    If Len(strData) > 1 And (Asc(Left$(strData, 1)) = &H5) And Not IsOnline And Config.Proxy.UseProxy And Config.Proxy.Socks = Socks5 Then
        Select Case Asc(Mid$(strData, 2, 1))
        Case &H0
            If sckBnet.Tag = "AUTH" Then
                sckBnet.Tag = "ACCEPT"
                sckBnet.SendData Chr$(&H5) & Chr$(&H1) & _
                    vbNullChar & Chr$(&H1) & CreateInt32(inet_addr(Config.Server)) & _
                            CreateInt16(htons(6112))
                AddChat vbGreen, "Proxy authorization passed!"
                RaiseEvent BnetConnecting
            Else
                AddChat vbGreen, "Proxy request granted!"
                SendAuthInfo
            End If
            Exit Sub
        Case &H1
            AddChat vbRed, "Proxy request rejected!"
            Disconnect
            TryReconnect = True
            Exit Sub
        Case &H2
            AddChat vbRed, "Proxy connection not allowed by ruleset!"
            Disconnect
            TryReconnect = True
            Exit Sub
        Case &H3
            AddChat vbRed, "Proxy could not connect, the network is unreachable!"
            Disconnect
            TryReconnect = True
            Exit Sub
        Case &H4
            AddChat vbRed, "Proxy could not connect, the host is unreachable!"
            Disconnect
            TryReconnect = True
            Exit Sub
        Case &H5
            AddChat vbRed, "Proxy connection refused by destination host!"
            Disconnect
            TryReconnect = True
            Exit Sub
        Case &H6
            AddChat vbRed, "Proxy could not connect, TTL expired!"
            Disconnect
            TryReconnect = True
            Exit Sub
        Case &H7
            AddChat vbRed, "Proxy could not connect, command not supported or protocol error!"
            Disconnect
            TryReconnect = True
            Exit Sub
        Case &H8
            AddChat vbRed, "Proxy address type not supported!"
            Disconnect
            TryReconnect = True
            Exit Sub
        End Select
    End If
    strBuffer = strBuffer & strData
    While Len(strBuffer) > 3
        lngPacketLen = ExtractInt16(Mid$(strBuffer, 3, 2))
        If (Len(strBuffer) < lngPacketLen) Or (lngPacketLen < 0) Then Exit Sub
        r.SetDebuffer Left$(strBuffer, lngPacketLen)
        strBuffer = Mid$(strBuffer, lngPacketLen + 1)
        Dim bytProtocol As Long
        bytProtocol = r.ReadByte()
        If (bytProtocol = &HFF) Then
            bytPacketID = r.ReadByte()
            lngPacketLen = r.ReadInt16()
            HandleBnetPacket bytPacketID
        Else
            AddChat vbRed, "Battle.Net protocol violation: " & ByteToHex(bytProtocol) & "!"
            Disconnect
        End If
    Wend
    Exit Sub
hErr:
    ErrorHandler "Bot", "BnetDataArrival"
End Sub

Private Sub sckBnet_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
    RaiseEvent BnetError(Number, Description)
    Disconnect
    TryReconnect = True
End Sub

Private Sub sckBnls_Close()
    RaiseEvent BnlsDisconnect
End Sub

Private Sub sckBnls_Connect()
    On Error GoTo hErr
    RaiseEvent BnlsConnected
    AddChat vbYellow, "Requesting version byte for: " & Config.ProductID
    b.InsertInt32 Config.BnlsProduct
    b.SendBnlsPacket sckBnls, BNLS_REQUESTVERSIONBYTE
    Exit Sub
hErr:
    ErrorHandler "Bot", "BnlsConnect"
End Sub

Private Sub sckBnls_DataArrival(ByVal bytesTotal As Long)
    On Error GoTo hErr
    Static strBuffer As String
    Dim strData As String, lngPacketLen As Long, bytPacketID As Byte
    sckBnls.GetData strData
    If LenB(strData) = 0 Then Exit Sub
    strBuffer = strBuffer & strData
    While Len(strBuffer) > 2
        lngPacketLen = ExtractInt16(Left$(strBuffer, 2))
        If (Len(strBuffer) < lngPacketLen) Or (lngPacketLen < 0) Then Exit Sub
        r.SetDebuffer Left$(strBuffer, lngPacketLen)
        strBuffer = Mid$(strBuffer, lngPacketLen + 1)
        lngPacketLen = r.ReadInt16()
        bytPacketID = r.ReadByte()
        HandleBnlsPacket bytPacketID
    Wend
    Exit Sub
hErr:
    ErrorHandler "Bot", "BnlsDataArrival"
End Sub

Private Sub sckBnls_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
    RaiseEvent BnlsError(Number, Description)
End Sub

Private Sub SendPing(value As Long)
    On Error GoTo hErr
    b.InsertInt32 value
    SendBnetPacket sckBnet, SID_PING
    Exit Sub
hErr:
    b.Clear
    ErrorHandler "Bot", "SendPing"
End Sub

Private Sub ReceivePing()
    On Error GoTo hErr
    SendPing r.ReadInt32()
    Exit Sub
hErr:
    ErrorHandler "Bot", "ReceivePing"
End Sub

Private Sub SendAuthInfo()
    On Error GoTo hErr
    AddChat vbYellow, "Authenticating client..."
    AddChat vbGrayText, "Verbyte: " & ByteToHex(CByte(Verbyte))
    AddChat vbGrayText, "Product ID: " & Config.ProductID
    
    sckBnet.SendData Chr$(&H1)                              'Specify Game Protocol
    b.InsertInt32 &H0                                       'Protocol ID
    b.InsertInt32 ARCH_IX86                                 'Platform ID
    b.InsertFixedString StrReverse$(Config.ProductID)       'Product ID
    b.InsertInt32 Verbyte                                   'Version Byte
    b.InsertInt32 GetRegion                                 'Region
    b.InsertInt32 inet_addr(sckBnet.LocalIP)                'Local IP for NAT compatibility
    b.InsertInt32 TimeZoneBias                              'Time zone Bias
    b.InsertInt32 GetUserDefaultLCID                        'Locale ID
    b.InsertInt32 GetUserDefaultLangID                      'Language ID
    b.InsertCString GetLocaleInfo(LOCALE_SABBREVCTRYNAME)   'Country abbreviation
    b.InsertCString GetLocaleInfo(LOCALE_SENGCOUNTRY)       'Country
    SendBnetPacket sckBnet, SID_AUTH_INFO
    SendPing &H0
    Exit Sub
hErr:
    b.Clear
    ErrorHandler "Bot", "SendAuthInfo"
End Sub

Private Sub ReceiveAuthInfo()
    On Error GoTo hErr
    Dim logonType As Long, udpValue As Long, serverSignature As String
    logonType = r.ReadInt32()
    serverToken = r.ReadInt32()
    udpValue = r.ReadInt32()
    mpqFiletime = r.ReadFixedString(8)
    mpqFilename = r.ReadCString()
    valueString = r.ReadCString()
    clientToken = GetTickCount()
    digest = String$(256, vbNullChar)
    
    Select Case logonType
        Case &H0
            nls_used = False
        Case &H1
            AddChat vbRed, "WarCraft III Beta (NLS Version 1) not supported by this bot!"
            Disconnect
            Exit Sub
        Case &H2
            nls_used = True
            serverSignature = r.ReadFixedString(32)
        Case Else
            AddChat vbRed, "Unsupported logon type: " & LongToHex(logonType) & "!"
            Disconnect
            Exit Sub
    End Select
    
    AddChat vbGrayText, "Version check archive: " & mpqFilename
    AddChat vbGrayText, "Value string: " & StrToHex(valueString)
    
    If (Config.UseBNLS) Then
        AddChat vbYellow, "Requesting hash values from BNLS/JBLS..."
        b.InsertInt32 Config.BnlsProduct
        b.InsertInt32 &H0
        b.InsertInt32 serverToken
        b.InsertFixedString mpqFiletime
        b.InsertCString mpqFilename
        b.InsertCString valueString
        b.SendBnlsPacket sckBnls, BNLS_VERSIONCHECKEX2
    Else
        Dim Hashes(2) As String
        Select Case Config.ProductID
            Case "STAR", "SEXP"
                Hashes(0) = App.Path & "\Binaries\STAR\StarCraft.exe"
                Hashes(1) = App.Path & "\Binaries\STAR\Storm.dll"
                Hashes(2) = App.Path & "\Binaries\STAR\Battle.snp"
            Case "W2BN"
                Hashes(0) = App.Path & "\Binaries\W2BN\WarCraft II BNE.exe"
                Hashes(1) = App.Path & "\Binaries\W2BN\Storm.dll"
                Hashes(2) = App.Path & "\Binaries\W2BN\Battle.snp"
            Case "D2DV"
                Hashes(0) = App.Path & "\Binaries\D2DV\Game.exe"
                Hashes(1) = App.Path & "\Binaries\D2DV\Bnclient.dll"
                Hashes(2) = App.Path & "\Binaries\D2DV\D2client.dll"
            Case "D2XP"
                Hashes(0) = App.Path & "\Binaries\D2XP\Game.exe"
                Hashes(1) = App.Path & "\Binaries\D2XP\Bnclient.dll"
                Hashes(2) = App.Path & "\Binaries\D2XP\D2client.dll"
            Case "WAR3", "W3XP"
                Hashes(0) = App.Path & "\Binaries\WAR3\War3.exe"
                Hashes(1) = App.Path & "\Binaries\WAR3\Storm.dll"
                Hashes(2) = App.Path & "\Binaries\WAR3\Game.dll"
        End Select
        If (InStrB(mpqFilename, "lockdown") > 0) Then
            If (CheckRevisionLD(Hashes(0), Hashes(1), Hashes(2), valueString, version, checksum, _
                    digest, App.Path & "\Binaries\Lockdown\" & Replace$(mpqFilename, ".mpq", ".dll"), _
                    App.Path & "\Binaries\Lockdown\lockdown-IX86-01.dll", _
                    App.Path & "\Binaries\Lockdown\" & Config.ProductID & ".bin") <> 1) Then
                AddChat vbRed, "CheckRevision failed!"
                Disconnect
                Exit Sub
            End If
        Else
            If (CheckRevisionA(valueString, Hashes, extractMPQNumber(mpqFilename), _
                    checksum) = False) Then
                AddChat vbRed, "CheckRevision failed!"
                Disconnect
                Exit Sub
            End If
            version = getExeInfo(Hashes(0), digest)
            If (version = 0) Then
                AddChat vbRed, "Invalid version!"
                Disconnect
                Exit Sub
            End If
        End If
        SendAuthCheck
    End If
    Exit Sub
hErr:
    ErrorHandler "Bot", "ReceiveAuthInfo"
End Sub

Private Function HashCdkey(ByVal Cdkey As String, ByRef h As String, ByRef productVal As Long, ByRef publicVal As Long) As Boolean
    On Error GoTo hErr
    Dim kd As Long, hashLength As Long, hash As String
    If (InStrB(digest, vbNullChar) > 0) Then digest = Split(digest, vbNullChar)(0)
    kd = kd_create(Cdkey, Len(Cdkey))
    If (kd = -1) Then
        AddChat vbRed, "Cannot initialize cdkey decoder!"
        Disconnect
        Exit Function
    End If
    hashLength = kd_calculateHash(kd, clientToken, serverToken)
    If (hashLength = 0) Then
        AddChat vbRed, "Cannot calculate cdkey hash length!"
        Disconnect
        Exit Function
    End If
    If kd_isValid(kd) = 0 Then
        AddChat vbRed, "Cdkey did not pass installer check!"
        Disconnect
        Exit Function
    End If
    hash = Space$(hashLength)
    kd_getHash kd, hash
    h = hash
    productVal = kd_product(kd)
    publicVal = kd_val1(kd)
    kd_free kd
    HashCdkey = True
    Exit Function
hErr:
    ErrorHandler "Bot", "HashCdkey"
End Function

Private Sub SendAuthCheck()
    On Error GoTo hErr
    AddChat vbGreen, "CheckRevision passed!"
    AddChat vbYellow, "Authenticating version information..."
    
    If (InStrB(digest, vbNullChar) > 0) Then digest = Left$(digest, InStr(digest, vbNullChar) - 1)
    
    AddChat vbGrayText, "Digest: " & StrToHex(digest)
    AddChat vbGrayText, "Version: " & LongToHex(version)
    AddChat vbGrayText, "Checksum: " & LongToHex(checksum)
    
    b.InsertInt32 clientToken
    b.InsertInt32 version
    b.InsertInt32 checksum
    If (Config.ProductID = "D2XP" Or Config.ProductID = "W3XP") Then
        b.InsertInt32 &H2
    Else
        b.InsertInt32 &H1
    End If
    b.InsertInt32 &H0
    
    Dim hash As String, productVal As Long, publicVal As Long
    If HashCdkey(Config.Cdkey, hash, productVal, publicVal) = True Then
        b.InsertInt32 Len(Config.Cdkey)
        b.InsertInt32 productVal
        b.InsertInt32 publicVal
        b.InsertInt32 &H0
        b.InsertFixedString hash
    Else
        Exit Sub
    End If
    
    If (IsExpansion) Then
        If HashCdkey(Config.CdkeyEx, hash, productVal, publicVal) = True Then
            b.InsertInt32 Len(Config.CdkeyEx)
            b.InsertInt32 productVal
            b.InsertInt32 publicVal
            b.InsertInt32 &H0
            b.InsertFixedString hash
        Else
            Exit Sub
        End If
    End If
    
    b.InsertCString digest
    b.InsertCString Config.Username
    SendBnetPacket sckBnet, SID_AUTH_CHECK
    Exit Sub
hErr:
    b.Clear
    ErrorHandler "Bot", "SendAuthCheck"
End Sub

Private Sub ReceiveAuthCheck()
    On Error GoTo hErr
    Dim Result As Long, MoreInfo As String
    Result = r.ReadInt32()
    MoreInfo = r.ReadCString()
    Select Case Result
    Case &H0
        AddChat vbGreen, "Client information authorized!"
        If (Config.Register = ChangeEmail) Then
            SendChangeEmail
        ElseIf (Config.Register = RequestPassword) Then
            SendResetPassword
        Else
            If (LenB(Config.NewPassword) > 0) Then
                If (nls_used) Then
                    SendAuthAccountChange
                Else
                    SendChangePassword
                End If
            Else
                If (nls_used) Then
                    SendAuthAccountLogon
                Else
                    SendLogonResponse2
                End If
            End If
        End If
        Exit Sub
    Case &H100: AddChat vbRed, "Client version is too old (" & MoreInfo & ")!"
    Case &H101: AddChat vbRed, "Client version is invalid!"
    Case &H102: AddChat vbRed, "Client version is too new (" & MoreInfo & ")!"
    Case &H200: AddChat vbRed, "Cdkey is invalid!"
    Case &H201: AddChat vbRed, "Cdkey is in use" & IIf(LenB(MoreInfo) > 0, " by " & MoreInfo & "!", "!")
    Case &H202: AddChat vbRed, "Cdkey is banned!"
    Case &H203: AddChat vbRed, "Cdkey is for another client!"
    Case &H210: AddChat vbRed, "Expansion cdkey is invalid!"
    Case &H211: AddChat vbRed, "Expansion cdkey is in use" & IIf(LenB(MoreInfo) > 0, " by " & MoreInfo & "!", "!")
    Case &H212: AddChat vbRed, "Expansion cdkey is banned!"
    Case &H213: AddChat vbRed, "Expansion cdkey is for another client!"
    Case Verbyte: AddChat vbRed, "Version byte is invalid!"
    End Select
    'Finally...
    Disconnect
    Exit Sub
hErr:
    ErrorHandler "Bot", "ReceiveAuthCheck"
End Sub

Private Sub SendSetEmail()
    On Error GoTo hErr
    If (Config.Register = AllowRegistration) Then
        If LenB(Config.Email) = 0 Then
            AddChat vbRed, "Registration is enabled, however you have not supplied an e-mail address to bind to this account!"
        Else
            b.InsertCString Config.Email
            SendBnetPacket sckBnet, SID_SETEMAIL
            AddChat vbGreen, Config.Email & " successfully binded to " & Config.Username & "!"
        End If
    Else
        AddChat vbRed, "Registration is disabled, ignored bind request!"
    End If
    Exit Sub
hErr:
    b.Clear
    ErrorHandler "Bot", "SendSetEmail"
End Sub

Private Sub SendResetPassword()
    On Error GoTo hErr
    AddChat vbYellow, "Attempting to reset password.."
    b.InsertCString Config.Username
    b.InsertCString Config.Email
    SendBnetPacket sckBnet, SID_RESETPASSWORD
    Exit Sub
hErr:
    b.Clear
    ErrorHandler "Bot", "SendResetPassword"
End Sub

Private Sub SendChangeEmail()
    On Error GoTo hErr
    AddChat vbYellow, "Attempting to change email.."
    b.InsertCString Config.Username
    b.InsertCString Config.Email
    b.InsertCString Config.NewEmail
    SendBnetPacket sckBnet, SID_CHANGEEMAIL
    Exit Sub
hErr:
    b.Clear
    ErrorHandler "Bot", "SendChangeEmail"
End Sub

Private Sub SendAuthAccountLogon()
    On Error GoTo hErr
    If (nls = 0) Then
        nls = nls_init(Config.Username, Config.Password)
        If (nls = 0) Then
            AddChat vbRed, "Failed to initialize NLS handler!"
            Exit Sub
        End If
    End If
    
    nls_get_A nls, nls_A
    b.InsertFixedString nls_A
    b.InsertCString Config.Username
    SendBnetPacket sckBnet, SID_AUTH_ACCOUNTLOGON
    Exit Sub
hErr:
    b.Clear
    ErrorHandler "Bot", "SendAuthAccountLogon"
End Sub

Private Sub ReceiveAuthAccountLogon()
    On Error GoTo hErr
    Select Case r.ReadInt32()
    Case &H0
        nls_s = r.ReadFixedString(32)
        nls_B = r.ReadFixedString(32)
        nls_get_M1 nls, nls_M1, nls_B, nls_s
        SendAuthAccountLogonProof
    Case &H1
        AddChat vbRed, "Account doesn't exist!"
        SendAuthAccountCreate
    Case &H5
        AddChat vbRed, "Account requires upgrade!"
        SendAuthAccountUpgrade
    Case Else
        AddChat vbRed, "Unknown account logon response!"
        Disconnect
    End Select
    Exit Sub
hErr:
    ErrorHandler "Bot", "ReceiveAuthAccountLogon"
End Sub

Private Sub SendAuthAccountLogonProof()
    On Error GoTo hErr
    AddChat vbYellow, "Verifying login proof.."
    b.InsertFixedString nls_M1
    SendBnetPacket sckBnet, SID_AUTH_ACCOUNTLOGONPROOF
    Exit Sub
hErr:
    b.Clear
    ErrorHandler "Bot", "SendAuthAccountLogonProof"
End Sub

Private Sub ReceiveAuthAccountLogonProof()
    On Error GoTo hErr
    Dim Result As Long, info As String
    Result = r.ReadInt32()
    nls_M2 = r.ReadFixedString(20)
    info = r.ReadCString()
    
    Select Case Result
    Case &H2
        AddChat vbRed, "Incorrect password specified!"
        Disconnect
        Exit Sub
    Case &HF
        AddChat vbRed, info
        Disconnect
        Exit Sub
    Case &HE
        AddChat vbYellow, "Battle.Net requested that you bind an e-mail address with this account..."
        SendSetEmail
    End Select
    
    If nls_check_M2(nls, nls_M2, nls_B, nls_s) = 0 Then
        AddChat vbRed, "Password proof rejected!"
        If LenB(info) > 0 Then AddChat vbRed, info
        Disconnect
    Else
        AddChat vbGreen, "Login successful!"
        SendEnterChat
    End If
    Exit Sub
hErr:
    ErrorHandler "Bot", "ReceiveAuthAccountLogonProof"
End Sub

Private Sub SendAuthAccountCreate()
    On Error GoTo hErr
    Dim buf As String, bufLen As Long
    bufLen = 65 + Len(Config.Username)
    buf = String$(bufLen, vbNullChar)
    
    If nls_account_create(nls, buf, bufLen) = 0 Then
        AddChat vbRed, "Unable to generate account creation packet!"
        Exit Sub
    End If
    
    AddChat vbYellow, "Attempting to create account.."
    b.InsertFixedString buf
    SendBnetPacket sckBnet, SID_AUTH_ACCOUNTCREATE
    Exit Sub
hErr:
    b.Clear
    ErrorHandler "Bot", "SendAuthAccountCreate"
End Sub

Private Sub ReceiveAuthAccountCreate()
    On Error GoTo hErr
    Select Case r.ReadInt32()
    Case &H0
        AddChat vbGreen, "Account created successfully!"
        SendAuthAccountLogon
        Exit Sub
    Case &H4: AddChat vbRed, "Account already exists!"
    Case &H7: AddChat vbRed, "Account is too short!"
    Case &H8: AddChat vbRed, "Account contained an illegal character!"
    Case &H9: AddChat vbRed, "Account contained an illegal word!"
    Case &HA: AddChat vbRed, "Account contains too few alphanumeric characters!"
    Case &HB: AddChat vbRed, "Account contains adjacent punctuation characters!"
    Case &HC: AddChat vbRed, "Account contains too many punctuation characters!"
    Case Else: AddChat vbRed, "Account creation failed!"
    End Select
    Disconnect
    Exit Sub
hErr:
    ErrorHandler "Bot", "ReceiveAuthAccountCreate"
End Sub

Private Sub SendAuthAccountChange()
    On Error GoTo hErr
    AddChat vbYellow, "Attempting to change password.."
    nls_get_A nls, nls_A
    b.InsertFixedString nls_A
    b.InsertCString Config.Username
    SendBnetPacket sckBnet, SID_AUTH_ACCOUNTCHANGE
    Exit Sub
hErr:
    b.Clear
    ErrorHandler "Bot", "SendAuthAccountChange"
End Sub

Private Sub ReceiveAuthAccountChange()
    On Error GoTo hErr
    Select Case r.ReadInt32()
    Case &H0
        nls_s = r.ReadFixedString(32)
        nls_B = r.ReadFixedString(32)
        
        Dim newnls As Long
        newnls = nls_account_change_proof(nls, nls_buf, Config.NewPassword, nls_B, nls_s)
        
        If (newnls = 0) Then
            AddChat vbRed, "Unable to generate account change proof packet!"
            Disconnect
            Exit Sub
        End If
        
        nls_old = nls
        nls = newnls
        SendAuthAccountChangeProof
    Case &H1
        SendAuthAccountCreate
    Case &H5
        SendAuthAccountUpgrade
    Case Else
        AddChat vbRed, "Unknown account change proof response!"
        Disconnect
    End Select
    Exit Sub
hErr:
    ErrorHandler "Bot", "ReceiveAuthAccountChange"
End Sub

Private Sub SendAuthAccountChangeProof()
    On Error GoTo hErr
    AddChat vbRed, "Verifying change proof.."
    b.InsertFixedString nls_buf
    SendBnetPacket sckBnet, SID_AUTH_ACCOUNTCHANGEPROOF
    Exit Sub
hErr:
    b.Clear
    ErrorHandler "Bot", "SendAuthAccountChangeProof"
End Sub

Private Sub ReceiveAuthAccountChangeProof()
    On Error GoTo hErr
    Select Case r.ReadInt32()
    Case &H0
        nls_M2 = r.ReadFixedString(20)
        
        If nls_check_M2(nls, nls_M2, nls_B, nls_s) = 0 Then
            AddChat vbRed, "Password proof rejected!"
            Disconnect
            Exit Sub
        End If
        
        nls_free nls_old
        nls_old = 0
        nls_get_A nls, nls_A
        
        AddChat vbGreen, "Changed password!"
        Config.Password = Config.NewPassword
        Config.NewPassword = vbNullString
        SendAuthAccountLogon
    Case &H2
        AddChat vbRed, "Old password was incorrect!"
        Disconnect
    Case Else
        AddChat vbRed, "Unknown change proof response!"
        Disconnect
    End Select
    Exit Sub
hErr:
    ErrorHandler "Bot", "ReceiveAuthChangeProof"
End Sub

Private Sub SendAuthAccountUpgrade()
    On Error GoTo hErr
    SendBnetPacket sckBnet, SID_AUTH_ACCOUNTUPGRADE
    Exit Sub
hErr:
    b.Clear
    ErrorHandler "Bot", "SendAuthAccountUpgrade"
End Sub

Private Sub ReceiveAuthAccountUpgrade()
    On Error GoTo hErr
    If (r.ReadInt32 = &H0) Then
        AddChat vbGreen, "Upgrade request accepted!"
        serverToken = r.ReadInt32()
    Else
        AddChat vbRed, "Upgrade request denied!"
        Disconnect
    End If
    Exit Sub
hErr:
    ErrorHandler "Bot", "ReceiveAuthAccountUpgrade"
End Sub

Private Sub SendAuthAccountUpgradeProof()
    
End Sub

Private Sub ReceiveAuthAccountUpgradeProof()
    
End Sub

Public Sub SendClanDisband()
    On Error GoTo hErr
    If Self.ClanRank = CLANRANKENUM.Chieftain Then
        AddChat vbYellow, "Disbanding Clan " & Self.ClanTag & "..."
        b.InsertInt32 GetTickCount()
        SendBnetPacket sckBnet, SID_CLANDISBAND
    Else
        AddChat vbRed, "You are not authorized to disband the clan, only the Chieftain can perform this action!"
    End If
    Exit Sub
hErr:
    b.Clear
    ErrorHandler "Bot", "SendDisband"
End Sub

Private Sub ReceiveClanDisband()
    On Error GoTo hErr
    r.Skip 4
    RaiseEvent ClanDisband(r.ReadByte())
    Exit Sub
hErr:
    ErrorHandler "Bot", "ReceiveDisband"
End Sub

Public Sub SendRealmStartup()
    AddChat vbYellow, "Authenticating client for realm play..."
    b.InsertInt32 Realm.Token
    b.InsertInt32 Realm.Status
    b.InsertFixedString Realm.Chunk1
    b.InsertFixedString Realm.Chunk2
    b.InsertCString Realm.UniqueName
    b.SendRealmPacket sckRealm, MCP_STARTUP
End Sub

Private Sub ReceiveRealmStartup()
    Select Case r.ReadInt32()
    Case &H0
        AddChat vbGreen, "Realm authentication accepted!"
        SendRealmCharList2
    Case &HC
        AddChat vbRed, "Cannot connect to realm, no Battle.Net connection was detected!"
    Case &H7E
        AddChat vbRed, "Cdkey is banned from realm play!"
    Case &H7F
        AddChat vbRed, "Your connection has been temporarily restricted from this realm. Please try to log in at another time"
    End Select
End Sub

Public Sub SendRealmMOTD()
    b.SendRealmPacket sckRealm, MCP_MOTD
End Sub

Private Sub ReceiveRealmMOTD()
    Dim Headline As String
    Headline = r.ReadCString()
    AddChat vbPaleBlue, "Realm Message of the Day:"
    AddChat vbGrayText, r.ReadCString()
End Sub

Public Sub SendRealmCharList2()
    b.InsertInt32 8
    b.SendRealmPacket sckRealm, MCP_CHARLIST2
End Sub

Private Sub ReceiveRealmCharList2()
    Dim nq As Integer, ne As Long, nr As Integer, I As Integer
    nq = r.ReadInt16()
    ne = r.ReadInt32()
    nr = r.ReadInt16()
    
    Unload frmCharacters
    Load frmCharacters
    frmCharacters.BotIndex = BotIndex
    frmCharacters.ShowOptions
    frmCharacters.Show
    
    Dim exp As Long, Char As String, stat As String
    For I = 1 To nr
        exp = r.ReadInt32()
        Char = r.ReadCString()
        stat = r.ReadCString()
        
        Dim ExpirationDate As Date, Race As String, Level As Byte, Expansion As Boolean, ss As New clsStatstring
        ExpirationDate = VBA.DateAdd("s", exp, "1/1/1970 00:00:00")
        ss.GetDiablo2Detail stat, Level, Race, Expansion
        Set ss = Nothing
        
        With frmCharacters.lvChar.ListItems.Add(, , Char)
            .ListSubItems.Add , , Race
            .ListSubItems.Add , , Level
            With .ListSubItems.Add(, , ExpirationDate)
                If VBA.DateSerial(Year(ExpirationDate), Month(ExpirationDate), Day(ExpirationDate)) > _
                    VBA.DateSerial(Year(Now), Month(Now), Day(Now)) Then
                    .ForeColor = vbGreen
                Else
                    .ForeColor = vbRed
                End If
            End With
            If Expansion And Config.ProductID = "D2XP" Then
                .ForeColor = vbWhite
            ElseIf Not Expansion And Config.ProductID = "D2DV" Then
                .ForeColor = vbWhite
            Else
                .ForeColor = vbGrayText
            End If
        End With
    Next I
End Sub

Public Sub SendRealmCharLogon(Character As String)
    AddChat vbYellow, "Logging onto character: " & Character
    b.InsertCString Character
    b.SendRealmPacket sckRealm, MCP_CHARLOGON
End Sub

Private Sub ReceiveRealmCharLogon()
    Select Case r.ReadInt32()
    Case &H0
        AddChat vbGreen, "Successfully logged onto character!"
        SendRealmMOTD
        Unload frmCharacters
    Case &H46
        AddChat vbRed, "Character not found!"
    Case &H7A
        AddChat vbRed, "Character logon failed!"
    Case &H7B
        AddChat vbRed, "Character expired!"
    End Select
End Sub

Public Sub SendRealmCharUpgrade(Character As String)
    AddChat vbYellow, "Upgrading character: " & Character
    b.InsertCString Character
    b.SendRealmPacket sckRealm, MCP_CHARUPGRADE
End Sub

Private Sub ReceiveRealmCharUpgrade()
    Dim Result As Long
    Result = r.ReadInt32()
    Select Case Result
    Case &H0
        AddChat vbGreen, "Successfully upgraded character!"
    Case &H46
        AddChat vbRed, "Character not found!"
    Case &H7A
        AddChat vbRed, "Character upgrade failed!"
    Case &H7B
        AddChat vbRed, "Character expired!"
    Case &H7C
        AddChat vbRed, "Already expansion character!"
    Case Else
        AddChat vbRed, "Unknown character upgrade result: " & LongToHex(Result) & "!"
    End Select
End Sub

Public Sub SendRealmCharCreate(ByVal CharClass As Long, ByVal CharFlags As Integer, ByVal CharName As String)
    b.InsertInt32 CharClass
    b.InsertInt16 CharFlags
    b.InsertCString CharName
    b.SendRealmPacket sckRealm, MCP_CHARCREATE
End Sub

Private Sub ReceiveRealmCharCreate()
    Dim Result As Long
    Result = r.ReadInt32()
    Select Case Result
    Case &H0
        AddChat vbGreen, "Successfully created character!"
        SendRealmCharList2
    Case &H14
        AddChat vbRed, "Character already exists, or you have reached the maximum number of allowed characters!"
    Case &H15
        AddChat vbRed, "Invalid character name!"
    Case Else
        AddChat vbRed, "Unknown character creation result: " & LongToHex(Result) & "!"
    End Select
End Sub

Public Sub SendRealmCharDelete(Character As String)
    AddChat vbYellow, "Deleting character: " & Character
    b.InsertInt16 &H0
    b.InsertCString Character
    b.SendRealmPacket sckRealm, MCP_CHARDELETE
End Sub

Private Sub ReceiveRealmCharDelete()
    Dim Result As Long
    Result = r.ReadInt32()
    Select Case Result
    Case &H0
        AddChat vbGreen, "Successfully deleted character!"
    Case &H49
        AddChat vbRed, "Character doesn't exist!"
    Case Else
        AddChat vbRed, "Unknown character deletion result: " & LongToHex(Result) & "!"
    End Select
    SendRealmCharList2
End Sub

Private Sub ReceiveLogonRealmEx()
    Realm.Token = r.ReadInt32()
    Realm.Status = r.ReadInt32()
    Select Case Realm.Status
    Case &H80000001
        AddChat vbRed, "Specified realm is unavailable!"
        Exit Sub
    Case &H80000002
        AddChat vbRed, "Realm login failed!"
        Exit Sub
    End Select
    Realm.Chunk1 = r.ReadFixedString(4 * 2)
    Realm.IP = r.ReadByte() & "." & r.ReadByte() & "." & r.ReadByte() & "." & r.ReadByte()
    Realm.Port = ntohs(r.ReadInt32())
    Realm.Chunk2 = r.ReadFixedString(4 * 12)
    Realm.UniqueName = r.ReadCString()
    
    sckRealm.Close
    sckRealm.Connect Realm.IP, Realm.Port
    RaiseEvent RealmConnecting
End Sub

Private Sub ReceiveQueryRealms2()
    Dim Count As Long, Realm As String, info As String, Realms() As String, I As Integer
    r.Skip 4
    Count = r.ReadInt32()
    If Count > 0 Then
        ReDim Realms(Count - 1)
        For I = 1 To Count
            r.Skip 4
            Realm = r.ReadCString()
            info = r.ReadCString()
            Realms(I - 1) = Realm
            If LCase$(Realm) = LCase$(Config.Realm) Then
                Dim Token As Long
                Token = GetTickCount()
                b.InsertInt32 Token
                b.InsertFixedString doubleHashPassword("password", Token, serverToken)
                b.InsertCString Realm
                SendBnetPacket sckBnet, SID_LOGONREALMEX
            End If
        Next I
        RaiseEvent RealmListing(Count - 1, Realms)
    End If
End Sub

Public Sub SendClanRankChange(User As String, Rank As CLANRANKENUM)
    On Error GoTo hErr
    b.InsertInt32 GetTickCount()
    b.InsertCString User
    b.InsertByte CByte(Rank)
    SendBnetPacket sckBnet, SID_CLANRANKCHANGE
    Exit Sub
hErr:
    b.Clear
    ErrorHandler "Bot", "SendRankChange"
End Sub

Private Sub ReceiveClanRankChange()
    On Error GoTo hErr
    r.Skip 4
    RaiseEvent ClanRankChange(r.ReadByte)
    Exit Sub
hErr:
    ErrorHandler "Bot", "ReceiveRankChange"
End Sub

Public Sub SendClanLeave()
    On Error GoTo hErr
    b.InsertInt32 GetTickCount()
    b.InsertCString Self.Username
    SendBnetPacket sckBnet, SID_CLANREMOVEMEMBER
    Exit Sub
hErr:
    b.Clear
    ErrorHandler "Bot", "SendLeave"
End Sub

Public Sub SendClanInviteMultiple(Name As String, Tag As String, Candidates() As String)
    On Error GoTo hErr:
    Dim I As Integer
    b.InsertInt32 GetTickCount()
    b.InsertCString Name
    b.InsertInt32 StrToInt32(Tag)
    b.InsertByte UBound(Candidates) + 1
    For I = 0 To UBound(Candidates)
        b.InsertCString Candidates(I)
    Next I
    SendBnetPacket sckBnet, SID_CLANINVITEMULTIPLE
    Exit Sub
hErr:
    b.Clear
    ErrorHandler "Bot", "SendInviteMultiple"
End Sub

Private Sub ReceiveClanInviteMultiple()
    Dim Cookie As Long, Result As Byte, User As String, Candidates() As String
    Cookie = r.ReadInt32()
    Result = r.ReadByte()
    If (Result > &H0) Then User = r.ReadAll
    Candidates() = Split(User, vbNullChar)
    RaiseEvent ClanInviteMultiple(Result, Candidates())
End Sub

Public Sub SendClanRemoveMember(User As String)
    On Error GoTo hErr
    b.InsertInt32 GetTickCount()
    b.InsertCString User
    SendBnetPacket sckBnet, SID_CLANREMOVEMEMBER
    Exit Sub
hErr:
    b.Clear
    ErrorHandler "Bot", "SendRemoveMember"
End Sub

Private Sub ReceiveClanRemoveMember()
    On Error GoTo hErr
    r.Skip 4
    RaiseEvent ClanRemoveMember(r.ReadByte())
    Exit Sub
hErr:
    ErrorHandler "Bot", "ReceiveRemoveMember"
End Sub

Private Sub ReceiveClanMemberRemoved()
    On Error GoTo hErr
    Dim User As String, I As Integer, X As Integer
    User = r.ReadCString()
    For I = 1 To UBound(ClanMembers)
        If LCase$(ClanMembers(I).Username) = LCase$(User) Then
            Dim n As Integer
            For n = I To UBound(ClanMembers) - 1
                ClanMembers(n) = ClanMembers(n + 1)
            Next
            ReDim Preserve ClanMembers(UBound(ClanMembers) - 1)
            Exit For
        End If
    Next I
    If frmClanMembers.Opened Then
        For I = 1 To frmClanMembers.lvUsers.ListItems.Count
            If LCase$(frmClanMembers.lvUsers.ListItems(I).text) = LCase$(User) Then
                frmClanMembers.lvUsers.ListItems.Remove I
                Exit For
            End If
        Next I
    End If
    Exit Sub
hErr:
    ErrorHandler "Bot", "ReceiveMemberRemoved"
End Sub

Private Sub ReceiveClanMemberStatusChange()
    On Error GoTo hErr
    Dim User As String, I As Integer, X As Integer
    User = r.ReadCString()
    For I = 1 To UBound(ClanMembers)
        If LCase$(ClanMembers(I).Username) = LCase$(User) Then
            ClanMembers(I).Rank = r.ReadByte()
            ClanMembers(I).Online = r.ReadByte()
            ClanMembers(I).Location = r.ReadCString()
            X = I
            AddChat vbGold, User & "'s is now " & ClanStatusToString(ClanMembers(I).Online) & "!"
            Exit For
        End If
    Next I
    If frmClanMembers.Opened Then
        For I = 1 To frmClanMembers.lvUsers.ListItems.Count
            If LCase$(frmClanMembers.lvUsers.ListItems(I).text) = LCase$(User) Then
                frmClanMembers.lvUsers.ListItems(I).SmallIcon = IIf(ClanMembers(X).Rank = 0, 1, ClanMembers(X).Rank)
                frmClanMembers.lvUsers.ListItems(I).ForeColor = IIf(ClanMembers(X).Online = 0, vbGrayText, vbWhite)
                frmClanMembers.lvUsers.ListItems(I).Tag = ClanMembers(X).Rank
            End If
        Next I
    End If
    Exit Sub
hErr:
    ErrorHandler "Bot", "ReceiveMemberStatusChange"
End Sub

Private Sub ReceiveClanMemberRankChange()
    On Error GoTo hErr
    Dim oldRank As Byte, newRank As Byte, User As String, I As Integer, X As Integer
    oldRank = r.ReadByte()
    newRank = r.ReadByte()
    User = r.ReadCString()
    For I = 1 To UBound(ClanMembers)
        If LCase$(ClanMembers(I).Username) = LCase$(User) Then
            ClanMembers(I).Rank = newRank
            X = I
            AddChat vbGold, User & "'s rank changed from " & ClanRankToString(oldRank) & " to " & ClanRankToString(newRank) & "!"
            Exit For
        End If
    Next I
    If frmClanMembers.Opened Then
        For I = 1 To frmClanMembers.lvUsers.ListItems.Count
            If LCase$(frmClanMembers.lvUsers.ListItems(I).text) = LCase$(User) Then
                frmClanMembers.lvUsers.ListItems(I).SmallIcon = IIf(ClanMembers(X).Rank = 0, 1, ClanMembers(X).Rank)
                frmClanMembers.lvUsers.ListItems(I).Tag = ClanMembers(X).Rank
            End If
        Next I
    End If
    Exit Sub
hErr:
    ErrorHandler "Bot", "ReceiveMemberRankChange"
End Sub

Public Sub SendClanFindCandidates(ByVal ClanTag As String)
    On Error GoTo hErr
    b.InsertInt32 GetTickCount()
    b.InsertInt32 StrToInt32(ClanTag)
    SendBnetPacket sckBnet, SID_CLANFINDCANDIDATES
    Exit Sub
hErr:
    b.Clear
    ErrorHandler "Bot", "SendFindCandidates"
End Sub

Private Sub ReceiveClanFindCandidates()
    Dim Cookie As Long, Result As Byte, CandCount As Byte, Candidates() As String, I As Byte
    Cookie = r.ReadInt32()
    Result = r.ReadByte()
    CandCount = r.ReadByte()
    If (CandCount > 0) Then
        ReDim Candidates(CandCount - 1) As String
        For I = 0 To CandCount - 1
            Candidates(I) = r.ReadCString()
        Next I
    Else
        ReDim Candidates(0) As String
    End If
    RaiseEvent ClanFindCandidates(Cookie, Result, CandCount, Candidates)
End Sub

Public Sub SendClanMakeChieftain(ByVal User As String)
    On Error GoTo hErr
    b.InsertInt32 GetTickCount()
    b.InsertCString User
    SendBnetPacket sckBnet, SID_CLANMAKECHIEFTAIN
    Exit Sub
hErr:
    b.Clear
    ErrorHandler "Bot", "SendMakeChieftain"
End Sub

Private Sub ReceiveClanMakeChieftain()
    On Error GoTo hErr
    r.Skip 4
    RaiseEvent ClanMakeChieftain(r.ReadByte())
    Exit Sub
hErr:
    ErrorHandler "Bot", "ReceiveMakeChieftain"
End Sub

Public Sub ShowClanMembers()
    On Error GoTo hErr
    frmClanMembers.BotIndex = BotIndex
    frmClanMembers.Opened = True
    frmClanMembers.ClearMembers
    Dim I As Integer
    For I = 1 To UBound(ClanMembers)
        frmClanMembers.AddMember ClanMembers(I)
    Next I
    frmClanMembers.Show
    SendClanMOTD
    Exit Sub
hErr:
    ErrorHandler "Bot", "ShowClanMembers"
End Sub

Private Sub ReceiveClanInfo()
    On Error GoTo hErr
    ReDim ClanMembers(0)
    r.Skip 1
    Self.Clanned = True
    Self.ClanTag = r.ReadDwordString()
    Self.ClanRank = r.ReadByte()
    RaiseEvent ClanInfo(ClanRankToString(Self.ClanRank), Self.ClanTag)
    SendClanMemberList
    frmBot.mnuInClan.Visible = (SelectedBot = BotIndex)
    frmBot.mnuClan.Visible = Not frmBot.mnuInClan.Visible
    Exit Sub
hErr:
    ErrorHandler "Bot", "ReceiveClanInfo"
End Sub

Public Sub SendClanMOTD()
    On Error GoTo hErr
    b.InsertInt32 GetTickCount()
    SendBnetPacket sckBnet, SID_CLANMOTD
    Exit Sub
hErr:
    b.Clear
    ErrorHandler "Bot", "SendMOTD"
End Sub

Private Sub ReceiveClanMOTD()
    On Error GoTo hErr
    r.Skip 8
    frmClanMembers.txtMOTD.text = r.ReadCString()
    Exit Sub
hErr:
    ErrorHandler "Bot", "ReceiveMOTD"
End Sub

Public Sub SendClanSetMOTD(Message As String)
    On Error GoTo hErr
    b.InsertInt32 GetTickCount()
    b.InsertCString Message
    SendBnetPacket sckBnet, SID_CLANSETMOTD
    Exit Sub
hErr:
    b.Clear
    ErrorHandler "Bot", "SendSetMOTD"
End Sub

Private Sub SendClanMemberList()
    On Error GoTo hErr
    b.InsertInt32 GetTickCount()
    SendBnetPacket sckBnet, SID_CLANMEMBERLIST
    Exit Sub
hErr:
    b.Clear
    ErrorHandler "Bot", "SendMemberList"
End Sub

Private Sub ReceiveClanMemberList()
    On Error GoTo hErr
    Dim I As Integer, Count As Byte
    r.Skip 4
    Count = r.ReadByte()
    ReDim ClanMembers(1 To Count)
    For I = 1 To Count
        ClanMembers(I).Username = r.ReadCString()
        ClanMembers(I).Rank = r.ReadByte()
        ClanMembers(I).Online = r.ReadByte()
        ClanMembers(I).Location = r.ReadCString()
    Next
    frmBot.AddChat BotIndex, vbGold, "There are currently " & Count & " members in the clan!"
    Exit Sub
hErr:
    ErrorHandler "Bot", "ReceiveMemberList"
End Sub

Private Sub ReceiveClanQuitNotify()
    On Error GoTo hErr
    RaiseEvent ClanQuitNotify
    ClearClanMembers
    Self.ClanRank = 0
    Self.Clanned = False
    Self.ClanTag = vbNullString
    Exit Sub
hErr:
    ErrorHandler "Bot", "ReceiveQuitNotify"
End Sub

Public Sub SendClanCreationInvitation(ByRef accepted As Boolean)
    On Error GoTo hErr
    If (GetTickCount - InviteTick) > 40000 Then
        AddChat vbCrimson, "Clan creation invitation expired before you could respond!"
    Else
        b.InsertInt32 Cookie
        b.InsertInt32 InviteTag
        b.InsertCString Inviter
        b.InsertByte IIf(accepted, &H6, &H4)
        If accepted Then
            AddChat vbLime, "Accepted clan creation invitation!"
        Else
            AddChat vbCrimson, "Declined clan creation invitation!"
        End If
        SendBnetPacket sckBnet, SID_CLANCREATIONINVITATION
    End If
    Exit Sub
hErr:
    b.Clear
    ErrorHandler "Bot", "SendCreationInvitation"
End Sub

Private Sub ReceiveClanCreationInvitation()
    Dim Count As Byte, Candidates() As String, I As Integer
    Cookie = r.ReadInt32()
    InviteTagStr = r.ReadDwordString()
    InviteName = r.ReadCString()
    Inviter = r.ReadCString()
    Count = r.ReadByte()
    ReDim Candidates(Count - 1)
    For I = 0 To UBound(Candidates())
        Candidates(I) = r.ReadCString()
    Next I
    RaiseEvent ClanCreationInvitation(InviteName, InviteTagStr, Inviter, Count, Candidates)
End Sub

Public Sub SendClanInvitationResponse(ByRef accepted As Boolean)
    On Error GoTo hErr:
    If (GetTickCount - InviteTick) > 40000 Then
        AddChat vbCrimson, "Clan invitation expired before you could respond!"
    Else
        b.InsertInt32 Cookie
        b.InsertInt32 InviteTag
        b.InsertCString Inviter
        b.InsertByte IIf(accepted, &H6, &H4)
        If accepted Then
            AddChat vbLime, "Accepted clan invitation!"
        Else
            AddChat vbCrimson, "Declined clan invitation!"
        End If
    End If
    Exit Sub
hErr:
    b.Clear
    ErrorHandler "Bot", "SendInvitationResponse"
End Sub

Private Sub ReceiveClanInvitationResponse()
    On Error GoTo hErr:
    Cookie = r.ReadInt32()
    InviteTag = r.ReadInt32()
    r.Back 4
    InviteTagStr = r.ReadDwordString()
    InviteName = r.ReadCString()
    Inviter = r.ReadCString()
    RaiseEvent ClanInvitationResponse(InviteName, InviteTagStr, Inviter)
    Exit Sub
hErr:
    ErrorHandler "Bot", "ReceiveInvitationResponse"
End Sub

Public Sub SendClanInvitation(ByVal User As String)
    On Error GoTo hErr:
    InviteUser = User
    InviteCookie = GetTickCount()
    b.InsertInt32 InviteCookie
    b.InsertCString InviteUser
    SendBnetPacket sckBnet, SID_CLANINVITATION
    Exit Sub
hErr:
    b.Clear
    ErrorHandler "Bot", "SendInvitation"
End Sub

Private Sub ReceiveClanInvitation()
    On Error GoTo hErr:
    If (r.ReadInt32 = InviteCookie) Then
        RaiseEvent ClanInvitation(r.ReadByte(), InviteUser)
    End If
    Exit Sub
hErr:
    ErrorHandler "Bot", "ReceiveInvitation"
End Sub

Private Sub SendLogonResponse2()
    On Error GoTo hErr:
    AddChat vbYellow, "Attempting to login..."
    b.InsertInt32 clientToken
    b.InsertInt32 serverToken
    b.InsertFixedString doubleHashPassword(Config.Password, clientToken, serverToken)
    b.InsertCString Config.Username
    SendBnetPacket sckBnet, SID_LOGONRESPONSE2
    Exit Sub
hErr:
    b.Clear
    ErrorHandler "Bot", "SendLogonResponse2"
End Sub

Private Sub ReceiveLogonResponse2()
    On Error GoTo hErr:
    Select Case r.ReadInt32()
    Case &H0
        AddChat vbGreen, "Login successful!"
        SendUdpPingResponse
        SendEnterChat
    Case &H1
        AddChat vbRed, "Account does not exist!"
        SendCreateAccount2
    Case &H2
        AddChat vbRed, "Incorrect password!"
        Disconnect
    End Select
    Exit Sub
hErr:
    ErrorHandler "Bot", "ReceiveLogonResponse2"
End Sub

Private Sub SendCreateAccount2()
    On Error GoTo hErr:
    AddChat vbYellow, "Attempting to create account.."
    b.InsertFixedString hashPassword(Config.Password)
    b.InsertCString Config.Username
    SendBnetPacket sckBnet, SID_CREATEACCOUNT2
    Exit Sub
hErr:
    b.Clear
    ErrorHandler "Bot", "SendCreateAccount2"
End Sub

Private Sub ReceiveCreateAccount2()
    On Error GoTo hErr:
    Select Case r.ReadInt32()
    Case &H0
        AddChat vbGreen, "Account created successfully!"
        SendLogonResponse2
        Exit Sub
    Case &H2: AddChat vbRed, "Account contained an illegal character!"
    Case &H3: AddChat vbRed, "Account contained a banned word!"
    Case &H4: AddChat vbRed, "Account creation failed!"
    Case &H6: AddChat vbRed, "Account contains too few alphanumeric characters!"
    Case Else: AddChat vbRed, "Account creation failed!"
    End Select
    Disconnect
    Exit Sub
hErr:
    ErrorHandler "Bot", "ReceiveCreateAccount2"
End Sub

Private Sub SendChangePassword()
    On Error GoTo hErr:
    AddChat vbYellow, "Attempting to change password.."
    b.InsertInt32 clientToken
    b.InsertInt32 serverToken
    b.InsertFixedString doubleHashPassword(Config.Password, clientToken, serverToken)
    b.InsertFixedString hashPassword(Config.NewPassword)
    b.InsertCString Config.Username
    SendBnetPacket sckBnet, SID_CHANGEPASSWORD
    Exit Sub
hErr:
    b.Clear
    ErrorHandler "Bot", "SendChangePassword"
End Sub

Private Sub ReceiveChangePassword()
    On Error GoTo hErr:
    If (r.ReadInt32() = &H1) Then
        AddChat vbGreen, "Password changed from " & Config.Password & " to " & Config.NewPassword & "!"
        Config.Password = Config.NewPassword
        Config.NewPassword = vbNullString
        SendLogonResponse2
    Else
        AddChat vbRed, "Change password failed, incorrect password!"
        Disconnect
    End If
    Exit Sub
hErr:
    ErrorHandler "Bot", "ReceiveChangePassword"
End Sub

Public Sub SendWriteUserData(keys() As String)
    On Error GoTo hErr:
    Dim I As Integer
    b.InsertInt32 &H1
    b.InsertInt32 UBound(keys) + 1
    b.InsertCString Self.Username
    For I = 0 To UBound(keys)
        b.InsertCString keys(I, 0)
    Next I
    For I = 0 To UBound(keys)
        b.InsertCString keys(I, 1)
    Next I
    SendBnetPacket sckBnet, SID_WRITEUSERDATA
    Exit Sub
hErr:
    b.Clear
    ErrorHandler "Bot", "SendWriteProfile"
End Sub

Public Sub HandleCommand(strUser As String, strText As String)
    On Error GoTo hErr
    Dim Attr As Long
    If LenB(strText) = 0 Then Exit Sub
    Attr = FindMemberAttributes(Suffix(strUser))
    
    AddChat vbSkyBlue, strUser & " has " & AttributeToString(Attr)
    
    If Attr = 0 Then Exit Sub
    If InStrB(strText, Space$(1)) > 0 Then
        Dim Word() As String
        Word = Split(strText, Space$(1), 2)
        
        'Basic Access
        If (Attr And ATTR_B) = ATTR_B Then
            Select Case UCase$(Word(0))
            Case "SAY", "ECHO"
                SendAway Word(1), Low
                Exit Sub
            Case "LOCKDOWN"
                Select Case UCase$(Word(1))
                Case "ON"
                    Config.Moderation.Lockdown = True
                    SendText "/w " & GetAccount(strUser) & " Lockdown is now " & IsEnabled(Config.Moderation.Lockdown) & "!"
                Case "OFF"
                    Config.Moderation.Lockdown = False
                    SendText "/w " & GetAccount(strUser) & " Lockdown is now " & IsEnabled(Config.Moderation.Lockdown) & "!"
                Case Else
                    SendText "/w " & GetAccount(strUser) & " Please specify on or off!"
                End Select
                Exit Sub
            Case "ENCRYPT", "EN"
                SendAway ENCRYPTION_CHAR & Encrypt(Word(1)), Low
                Exit Sub
            Case "DECRYPT", "DE"
                If Left$(Word(1), 1) = ENCRYPTION_CHAR Then
                    SendText Decrypt(Mid$(Word(1), 2))
                Else
                    SendText "Message does not appear to be encrypted!"
                End If
                Exit Sub
            Case "PROFILE", "P"
                ProfileLookup Suffix(Word(1)), True
                Exit Sub
            Case "NUDGE"
                SendAway "/w " & GetAccount(Word(1)) & " [NUDGE]", High
                Exit Sub
            Case "ADDQUOTE"
                Open AppData & "Quotes.txt" For Append As #1
                Print #1, Word(1)
                Close #1
                SendText "/w " & GetAccount(Word(1)) & " Successfully added quote!"
                Exit Sub
            End Select
        End If
        
        'Clan Management
        If (Attr And ATTR_C) = ATTR_C Then
            Select Case UCase$(Word(0))
            Case "INVITE"
                If Self.ClanRank = CLANRANKENUM.Chieftain Then
                    SendText "/w " & GetAccount(strUser) & " Sent invitation to " & """" & Word(1) & """" & " waiting for reply..."
                Else
                    SendText "/w " & GetAccount(strUser) & " Cannot invite user, you must be the Chieftain!"
                End If
                Exit Sub
            Case "REMOVEMEMBER"
                If Self.ClanRank = Shaman Or Self.ClanRank = Chieftain Then
                    Dim I As Integer
                    For I = 1 To UBound(ClanMembers)
                        If LCase$(ClanMembers(I).Username) = LCase$(Word(1)) Then
                            SendText "/w " & GetAccount(strUser) & " Attempting to remove " & Word(1) & " from the clan..."
                            SendClanRemoveMember Word(1)
                            Exit Sub
                        End If
                    Next I
                    SendText "/w " & GetAccount(strUser) & " That user is not a member of the clan!"
                Else
                    SendText "/w " & GetAccount(strUser) & " Cannot remove user, you must be a Shaman or the Chieftain!"
                End If
                Exit Sub
            End Select
        End If
        
        'Database Management
        If (Attr And ATTR_D) = ATTR_D Then
            Select Case UCase$(Word(0))
            Case "ADD"
                If InStrB(Word(1), " ") > 0 Then
                    Dim Splt() As String
                    Splt = Split(Word(1), " ")
                    If LenB(ParseAttributeString(Splt(1))) > 0 Then
                        If AddMember(Splt(0), Splt(1)) Then
                            SendText "/w " & GetAccount(strUser) & " Successfully added " & Splt(0) & " with attributes of " & ParseAttributeString(Splt(1)) & "."
                        Else
                            SendText "/w " & GetAccount(strUser) & " That user already exists in the database!"
                        End If
                    Else
                        SendText "/w " & GetAccount(strUser) & " Invalid attributes specified!"
                    End If
                Else
                    SendText "/w " & GetAccount(strUser) & " Invalid syntax, try /adduser [username] [attributes]"
                End If
                Exit Sub
            Case "REMOVE"
                If RemoveMember(Word(1)) Then
                    SendText "/w " & GetAccount(strUser) & " Successfully removed " & Word(1) & " from the database!"
                Else
                    SendText "/w " & GetAccount(strUser) & " That user doesn't exist in the database!"
                End If
                Exit Sub
            Case "FIND"
                Dim intFind As Long
                intFind = FindMemberAttributes(Word(1))
                If intFind > 0 Then
                    SendText "/w " & GetAccount(strUser) & " User " & Word(1) & " exists with attributes of " & AttributeToString(intFind) & "."
                Else
                    SendText "/w " & GetAccount(strUser) & " That user doesn't exist in the database!"
                End If
                Exit Sub
            End Select
        End If
        
        'Join
        If (Attr And ATTR_J) = ATTR_J Then
            Select Case UCase$(Word(0))
            Case "FORCE"
                SendJoinChannel Word(1), &H2
                Exit Sub
            Case "JOIN", "J"
                SendAway "/join " & Word(1), High
                Exit Sub
            End Select
        End If
        
        'Moderation
        If (Attr And ATTR_M) = ATTR_M Then
            Dim strTemp As String, lngAttr As Long
            strTemp = GetAccount(Prefix(Word(1), " "))
            lngAttr = FindMemberAttributes(strTemp)
            
            If (lngAttr And ATTR_S) = ATTR_S Then
                SendText "/w " & GetAccount(strUser) & " That user cannot be banned. " & Word(1) & " => " & AttributeToString(lngAttr)
                Exit Sub
            Else
                Select Case UCase$(Word(0))
                Case "BAN", "B"
                    SendText "/ban " & strTemp
                    Exit Sub
                Case "UNBAN", "U"
                    SendText "/unban " & strTemp
                    Exit Sub
                Case "KICK", "K"
                    SendText "/kick " & strTemp
                    Exit Sub
                Case "IGNORE", "IG"
                    SendText "/ignore " & strTemp
                    Exit Sub
                Case "UNIGNORE", "UI"
                    SendText "/unignore " & strTemp
                    Exit Sub
                End Select
            End If
        End If
    Else
        'Basic Access
        If (Attr And ATTR_B) = ATTR_B Then
            Select Case UCase$(strText)
            Case "PROFILE", "P"
                ProfileLookup Self.Username, True
                Exit Sub
            Case "QUOTE"
                SendAway "Quote: " & RandomQuote, Low
                Exit Sub
            Case "CQ", "CLEARQUEUE"
                Set Queue = New Collection
                AddChat vbGrayText, "Queue cleared!"
                Exit Sub
            Case "VER", "VERSION"
                SendAway frmBot.Title(False) & " by Chriso@USWest - www.bnetdev.net", Low
                Exit Sub
            Case "MP3"
                If Media.MediaPlayer = None Then
                    SendText "/w " & GetAccount(strUser) & " No media player is selected at the moment!"
                Else
                    SendAway Media.Track & " - " & Media.MediaPlayerToString, Low
                End If
                Exit Sub
            End Select
        End If
        
        'Clan Management
        If (Attr And ATTR_C) = ATTR_C Then
            Select Case UCase$(strText)
            Case "CPUB"
                SendAway "/clan public", High
                Exit Sub
            Case "CPRIV"
                SendAway "/clan private", High
                Exit Sub
            End Select
        End If
        
        'Join
        If (Attr And ATTR_J) = ATTR_J Then
            Select Case UCase$(strText)
            Case "HOME", "H"
                SendAway "/join " & Config.Channel, High
                Exit Sub
            Case "REJOIN", "RJ"
                SendJoinChannel Self.Channel, &H2
                Exit Sub
            Case "FIRST"
                SendJoinChannel "The Void", &H1
                Exit Sub
            End Select
        End If
    End If
    Exit Sub
hErr:
    ErrorHandler "Bot", "HandleCommand"
End Sub

Public Sub SendText(strText As String)
    On Error GoTo hErr
    If LenB(strText) = 0 Then Exit Sub
    
    If Left$(strText, 1) = "/" Then
        If InStrB(strText, Space$(1)) > 0 Then
            Dim Word() As String
            Word = Split(Mid$(strText, 2), Space$(1), 2)
            Select Case UCase$(Word(0))
            Case "ADD"
                If InStrB(Word(1), " ") > 0 Then
                    Dim Splt() As String
                    Splt = Split(Word(1), " ")
                    If LenB(ParseAttributeString(Word(1))) > 0 Then
                        If AddMember(Splt(0), Splt(1)) Then
                            AddChat vbLime, "Successfully added " & Splt(0) & " with attributes of " & ParseAttributeString(Splt(1)) & "."
                        Else
                            AddChat vbCrimson, "That user already exists in the database!"
                        End If
                    Else
                        AddChat vbCrimson, "Invalid attributes specified!"
                    End If
                Else
                    AddChat vbCrimson, "Invalid syntax, try /adduser [username] [attributes]"
                End If
                Exit Sub
            Case "REMOVE"
                If RemoveMember(Word(1)) Then
                    AddChat vbLime, "Successfully removed " & Word(1) & " from the database!"
                Else
                    AddChat vbCrimson, "That user doesn't exist in the database!"
                End If
                Exit Sub
            Case "FIND"
                Dim intFind As Long
                intFind = FindMemberAttributes(Word(1))
                If intFind > 0 Then
                    AddChat vbLime, "Member " & Word(1) & " exists with attributes of " & AttributeToString(intFind) & "."
                Else
                    AddChat vbCrimson, "That user doesn't exist in the database!"
                End If
                Exit Sub
            Case "INVITE"
                If Self.ClanRank = CLANRANKENUM.Chieftain Then
                    SendClanInvitation Word(1)
                Else
                    AddChat vbRed, "Cannot invite user, you must be the Chieftain of a clan to invite another user!"
                End If
                Exit Sub
            Case "SAY", "ECHO"
                SendAway Word(1), Low
                Exit Sub
            Case "ENCRYPT", "EN"
                SendAway ENCRYPTION_CHAR & Encrypt(Word(1)), Low
                Exit Sub
            Case "DECRYPT", "DE"
                If Left$(Word(1), 1) = ENCRYPTION_CHAR Then
                    AddChat vbViolet, "Decrypted message: " & Decrypt(Mid$(Word(1), 2))
                Else
                    AddChat vbCrimson, "Message does not appear to be encrypted!"
                End If
                Exit Sub
            Case "STATS"
                If InStrB(Word(1), " ") = 0 And IsDiablo Then
                    Dim ui As Integer, out() As String, oi As Integer, ss As New clsStatstring
                    ui = UserIndex(Word(1))
                    If ui > -1 Then
                        If Users(ui).client = "D2DV" Or Users(ui).client = "D2XP" Then
                            ss.GetDiablo2Info Users(ui).statstring, out
                            AddChat vbYellow, Users(ui).Account & "'s record:"
                            If UBound(out) > 0 Then
                                For oi = 0 To UBound(out)
                                    AddChat vbYellow, out(oi)
                                Next oi
                            Else
                                AddChat vbYellow, "Character: Open"
                            End If
                        Else
                            SendAway "/stats " & Word(1) & " " & Users(ui).client, Low
                        End If
                    Else
                        AddChat vbRed, "Cannot get Diablo II stats when the user is not in the channel. To get stats for another product type " & """" & "/stats " & Word(1) & " [productID]" & """" & "; valid productID's are STAR/SEXP/W2BN/WAR3/W3XP!"
                    End If
                    Exit Sub
                End If
            Case "FORCE"
                SendJoinChannel Word(1), &H2
                Exit Sub
            Case "ECHOPROFILE", "EP"
                ProfileLookup Suffix(Word(1)), True
                Exit Sub
            Case "PROFILE", "P"
                ProfileLookup Suffix(Word(1)), False
                Exit Sub
            Case "NUDGE"
                SendAway "/w " & GetAccount(Word(1)) & " [NUDGE]", High
                Exit Sub
            Case "GIVEOP"
                SendAway "/designate " & GetAccount(Word(1)), High
                SendAway "/resign", High
                Exit Sub
            Case "TICTACTOE"
                If LCase$(Suffix(Word(1))) <> LCase$(Self.Username) Then
                    SendAway "/w " & GetAccount(Word(1)) & " $_begin", High
                Else
                    AddChat vbRed, "You cannot play Tic-Tac-Toe with yourself!"
                End If
                Exit Sub
            Case "ADDQUOTE"
                Open AppData & "Quotes.txt" For Append As #1
                Print #1, Word(1)
                Close #1
                AddChat vbGold, "Added quote!"
                Exit Sub
            Case "REMOVEMEMBER"
                Dim I As Integer
                For I = 1 To UBound(ClanMembers)
                    If LCase$(ClanMembers(I).Username) = LCase$(Word(1)) Then
                        AddChat vbYellow, "Attempting to remove " & Word(1) & " from the clan..."
                        SendClanRemoveMember Word(1)
                        Exit Sub
                    End If
                Next I
                AddChat vbRed, "That user is not a member of the clan!"
                Exit Sub
            'Fix message for Diablo characters
            Case "WHISPER", "W", "M", "MESSAGE"
                If InStr(Word(1), " ") > 0 Then
                    Dim strWords() As String
                    strWords() = Split(Word(1), " ", 2)
                    SendAway "/" & Word(0) & " " & GetAccount(strWords(0)) & " " & IIf(frmBot.mnuEncryption.Checked, "¸" & Encrypt(strWords(1)), strWords(1)), High
                Else
                    AddChat vbRed, "What message do you want to whisper " & Suffix(Word(1)) & "?"
                End If
                Exit Sub
            Case "IGNORE", "UNIGNORE", "BAN", "UNSQUELCH", "SQUELCH", "KICK", "DESIGNATE", "WHOIS"
                SendAway "/" & Word(0) & " " & GetAccount(Word(1)), High
                Exit Sub
            End Select
        Else
            Select Case UCase$(Mid$(strText, 2))
            Case "DATABASE", "DB"
                If LenB(Database(0).Member) = 0 Then
                    AddChat vbCrimson, "Database contains no members!"
                Else
                    AddChat vbGold, "Database contains " & UBound(Database) + 1 & " members:"
                    Dim j As Integer
                    For j = 0 To UBound(Database)
                        If LenB(Database(j).Member) > 0 Then
                            AddChat vbGold, "- " & Database(j).Member & " -> " & Database(j).AttributeString
                        End If
                    Next
                End If
                Exit Sub
            Case "ATTRIBUTES", "ATTR"
                AddChat vbGold, "Attributes:"
                AddChat vbGold, "B - Basic Access"
                AddChat vbGold, "C - Clan Management"
                AddChat vbGold, "D - Database Management"
                AddChat vbGold, "J - Join Ability"
                AddChat vbGold, "M - Moderation"
                AddChat vbGold, "O - Owner of Bot"
                AddChat vbGold, "S - Safe"
                AddChat vbGold, "X - Banned"
                Exit Sub
            Case "CPUB"
                SendAway "/clan public", High
                Exit Sub
            Case "CPRIV"
                SendAway "/clan private", High
                Exit Sub
            Case "ECHOPROFILE", "EP"
                ProfileLookup Self.Username, True
                Exit Sub
            Case "PROFILE", "P"
                ProfileLookup Self.Username, False
                Exit Sub
            Case "QUOTE"
                SendAway "Quote: " & RandomQuote, Low
                Exit Sub
            Case "CQ", "CLEARQUEUE"
                Set Queue = New Collection
                AddChat vbGrayText, "Queue cleared!"
                Exit Sub
            Case "VER", "VERSION"
                SendAway frmBot.Title(False) & " by Chriso@USWest - www.bnetdev.net", Low
                Exit Sub
            Case "MP3"
                If Media.MediaPlayer = None Then
                    AddChat vbRed, "No media player is selected at the moment!"
                Else
                    SendAway Media.Track & " - " & Media.MediaPlayerToString, Low
                End If
                Exit Sub
            Case "SELF", "BOT"
                Dim SDT As DATETIME, NDT As DATETIME
                SDT = ConvertTickCount(NowTickCount() - Self.Uptime)
                NDT = ConvertTickCount(NowTickCount())
                AddChat vbGold, "Channel: #" & Self.Channel & " (" & LongToHex(Self.ChannelFlags) & ")"
                AddChat vbGold, "Ping: " & Self.Ping & "ms"
                AddChat vbGold, "Flags: " & LongToHex(Self.Flags)
                AddChat vbGold, "Operator: " & YesNo(Self.IsOperator)
                AddChat vbGold, "Bot Uptime: " & DateTimeToLongString(ConvertTickCount(NowTickCount() - Self.Uptime))
                AddChat vbGold, "System Uptime: " & DateTimeToLongString(ConvertTickCount(NowTickCount()))
                If Self.Clanned Then
                    AddChat vbGold, "Clan tag: " & Self.ClanTag
                    AddChat vbGold, "Clan rank: " & ClanRankToString(Self.ClanRank)
                End If
                Exit Sub
            Case "HOME", "H"
                SendAway "/join " & Config.Channel, High
                Exit Sub
            Case "REJOIN", "RJ"
                SendJoinChannel Self.Channel, &H2
                Exit Sub
            Case "FIRST"
                SendJoinChannel "The Void", &H1
                Exit Sub
            End Select
        End If
    Else
        If frmBot.mnuEncryption.Checked Then strText = ENCRYPTION_CHAR & Encrypt(strText)
    End If
    
    strText = Replace$(strText, vbCr, vbNullString)
    strText = Replace$(strText, vbLf, vbNullString)
    strText = Replace$(strText, vbNullChar, vbNullString)
    
    If Len(strText) > 224 Then
        SendAway Left$(strText, 224), Low
        SendText Mid$(strText, 224)
    Else
        SendAway strText, Low
    End If
    Exit Sub
hErr:
    ErrorHandler "Bot", "SendText"
End Sub

Private Sub SendAway(strText As String, priority As PRIORITYMODE)
    On Error GoTo hErr
    If (((GetTickCount - QueueTick) > 5000) Or (QueueTick = 0)) And (Queue.Count = 0) Then
        RaiseEvent ChatMessageSent(strText)
        b.InsertCString strText
        SendBnetPacket sckBnet, SID_CHATCOMMAND
        QueueTick = GetTickCount()
        QueueDelay = 1650 + (Len(strText) * 21)
    Else
        If priority = High And Queue.Count > 0 Then
            Queue.Add strText, , 1
        Else
            Queue.Add strText
        End If
    End If
    Exit Sub
hErr:
    b.Clear
    ErrorHandler "Bot", "SendAway"
End Sub

Private Sub SendLines(text As String, Optional Prefix As String)
    On Error GoTo hErr
    If InStrB(text, vbNewLine) > 0 Then
        Dim I As Integer, s() As String
        s = Split(text, vbNewLine)
        For I = 0 To UBound(s)
            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 "Bot", "SendLines"
End Sub

Private Sub SendEnterChat()
    On Error GoTo hErr
    AddChat vbYellow, "Entering chat environment..."
    b.InsertCString Config.Username
    b.InsertByte &H0
    SendBnetPacket sckBnet, SID_ENTERCHAT
    SendGetChannelList
    SendJoinChannel "The Void", &H1, False
    Self.Uptime = NowTickCount()
    Exit Sub
hErr:
    b.Clear
    ErrorHandler "Bot", "SendEnterChat"
End Sub

Private Sub SendGetChannelList()
    b.InsertInt32 &H0
    SendBnetPacket sckBnet, SID_GETCHANNELLIST
End Sub

Private Sub ReceiveGetChannelList()
    Dim Data As String, Channels() As String
    Data = r.ReadAll()
    If LenB(Data) > 0 Then
        Channels = Split(Data, vbNullChar)
        RaiseEvent ChannelListing(Channels)
    End If
End Sub

Public Sub ProfileLookup(Username As String, Send As Boolean)
    On Error GoTo hErr
    Dim keys(3) As String
    keys(0) = "profile\age"
    keys(1) = "profile\sex"
    keys(2) = "profile\location"
    keys(3) = "profile\description"
    SendReadUserData Username, keys, Send
    Exit Sub
hErr:
    ErrorHandler "Bot", "ProfileLookup"
End Sub

Public Sub SendReadUserData(Username As String, keys() As String, Send As Boolean)
    On Error GoTo hErr
    b.InsertInt32 &H1
    b.InsertInt32 UBound(keys) + 1
    b.InsertInt32 GetTickCount()
    b.InsertCString Username
    Dim I As Integer
    For I = 0 To UBound(keys)
        b.InsertCString keys(I)
    Next I
    SendBnetPacket sckBnet, SID_READUSERDATA
    ProfileSend = Send
    ProfileUser = Username
    Exit Sub
hErr:
    b.Clear
    ErrorHandler "Bot", "SendReadProfile"
End Sub

Private Sub ReceiveReadUserData()
    On Error GoTo hErr
    r.Skip 4
    Dim numKeys As Long
    numKeys = r.ReadInt32()
    r.Skip 4
    If numKeys = 4 Then
        If ProfileSend Then
            SendAway "Viewing profile for: " & ProfileUser, Low
            SendLines r.ReadCString(), "[Age] "
            SendLines r.ReadCString(), "[Sex] "
            SendLines r.ReadCString(), "[Loc] "
            SendLines r.ReadCString(), "[Desc] "
        Else
            Dim p As New frmViewProfile
            p.txtAge = r.ReadCString()
            p.txtSex = r.ReadCString()
            p.txtLocation = r.ReadCString()
            p.txtDescription = r.ReadCString()
            p.lblUser = ProfileUser
            p.Yourself = (LCase$(ProfileUser) = LCase$(Self.Username))
            p.BotIndex = BotIndex
            p.Show
        End If
    End If
    Exit Sub
hErr:
    ErrorHandler "Bot", "ReceiveReadProfile"
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 sckBnet, SID_LEAVECHAT
    If Flags = &H1 Then
        If (Left$(Config.ProductID, 2) = "D2") Then
            b.InsertInt32 &H5
        Else
            b.InsertInt32 &H1
        End If
    Else
        b.InsertInt32 Flags
    End If
    b.InsertCString Channel
    SendBnetPacket sckBnet, SID_JOINCHANNEL
    Exit Sub
hErr:
    b.Clear
    ErrorHandler "Bot", "SendJoinChannel"
End Sub

Private Sub ReceiveEnterChat()
    On Error GoTo hErr
    Self.Username = r.ReadCString()
    Self.statstring = r.ReadCString()
    'Account = r.ReadCString()
    IsOnline = True
    AddChat vbGreen, "Chatting on account: " & Self.Username & "!"
    AddChat vbGrayText, "Time taken to connect: " & GetTickCount - ConnectingTick & "ms!"
    If LenB(Config.Realm) > 0 Then SendBnetPacket sckBnet, &H40: AddChat vbYellow, "Requesting a list of available realms..."
    Exit Sub
hErr:
    ErrorHandler "Bot", "ReceiveEnterChat"
End Sub

Private Sub ReceiveChatEvent()
    On Error GoTo hErr
    Dim EventID As Long, Username As String, Ping As Long, Flags As Long, text As String
    EventID = r.ReadInt32()
    Flags = r.ReadInt32()
    Ping = r.ReadInt32()
    r.Skip 12
    Username = r.ReadCString()
    text = r.ReadCString()
    
    If (SelectedTab <> BotToTabIndex(BotIndex)) Then IsActive = True

    Dim ui As Integer
    Select Case EventID
        Case EID_BROADCAST
            RaiseEvent ChatBroadcast(Username, text)
        Case EID_CHANNEL
            RaiseEvent ChatEnterChannel(text, Flags)
            If FirstChannel = False Then
                If Config.JoinChannel Then SendText "/home"
                FirstChannel = True
            End If
            ClearUsers
            Self.Channel = text
            Self.ChannelFlags = Flags
        Case EID_CHANNELDOESNOTEXIST
            AddChat vbRed, "Channel is empty!"
        Case EID_CHANNELFULL
            AddChat vbRed, "Channel is full!"
        Case EID_CHANNELRESTRICTED
            AddChat vbRed, "Channel is restricted!"
        Case EID_EMOTE
            RaiseEvent ChatUserEmote(Username, text, Ping, Flags)
        Case EID_ERROR
            RaiseEvent ChatError(text)
        Case EID_INFO
            RaiseEvent ChatInformation(text)
        Case EID_JOIN
            If Self.IsOperator Then
                Dim Attr As Long
                Attr = FindMemberAttributes(Username)
                If (Attr And ATTR_S) <> ATTR_S Then
                    If Config.Moderation.Lockdown Then
                        SendAway "/ban " & GetAccount(Username) & " Lockdown", High
                    End If
                End If
            End If
            RaiseEvent ChatUserJoin(Username, text, Ping, Flags)
            AddUser Username, text, Flags, Ping
            JoinTick = GetTickCount()
            JoinUser = Username
        Case EID_LEAVE
            RaiseEvent ChatUserLeave(Username)
            RemoveUser Username
        Case EID_SHOWUSER
            RaiseEvent ChatUserHere(Username, text, Ping, Flags)
            AddUser Username, text, Flags, Ping
        Case EID_TALK
            RaiseEvent ChatUserTalk(Username, text, Ping, Flags)
            ui = UserIndex(Username)
            If ui > -1 Then Users(ui).TalkTick = NowTickCount()
        Case EID_USERFLAGS
            RaiseEvent ChatUserUpdate(Username, text, Ping, Flags)
            ui = UserIndex(Username)
            If ui > -1 Then
                UpdateUser Username, Flags, Ping
            Else
                AddUser Username, text, Flags, Ping, True
            End If
        Case EID_WHISPER
            RaiseEvent ChatUserWhisperFrom(Username, text, Ping, Flags)
            ui = UserIndex(Username)
            If ui > -1 Then Users(ui).WhisperTick = NowTickCount()
        Case EID_WHISPERSENT
            RaiseEvent ChatUserWhisper(Username, text, Ping, Flags)
    End Select
    Exit Sub
hErr:
    ErrorHandler "Bot", "ReceiveChatEvent"
End Sub

Private Sub SendUdpPingResponse()
    On Error GoTo hErr
    If (Config.ProductID = "STAR" Or Config.ProductID = "SEXP" Or Config.ProductID = "W2BN") Then
        b.InsertFixedString StrReverse$("bnet")
        SendBnetPacket sckBnet, SID_UDPPINGRESPONSE
    End If
    Exit Sub
hErr:
    b.Clear
    ErrorHandler "Bot", "SendUdpPingResponse"
End Sub

Private Sub sckRealm_Close()
    RaiseEvent RealmDisconnect
End Sub

Private Sub sckRealm_Connect()
    sckRealm.SendData Chr$(&H1)
    RaiseEvent RealmConnected
End Sub

Private Sub sckRealm_DataArrival(ByVal bytesTotal As Long)
    On Error GoTo hErr
    Static strBuffer As String
    Dim strData As String, lngPacketLen As Long, bytPacketID As Byte
    sckRealm.GetData strData
    strBuffer = strBuffer & strData
    While Len(strBuffer) > 2
        lngPacketLen = ExtractInt16(Left$(strBuffer, 2))
        If (Len(strBuffer) < lngPacketLen) Or (lngPacketLen < 0) Then Exit Sub
        r.SetDebuffer Left$(strBuffer, lngPacketLen)
        strBuffer = Mid$(strBuffer, lngPacketLen + 1)
        lngPacketLen = r.ReadInt16()
        bytPacketID = r.ReadByte()
        HandleRealmPacket bytPacketID
    Wend
    Exit Sub
hErr:
    ErrorHandler "Bot", "RealmDataArrival"
End Sub

Private Sub sckRealm_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
    RaiseEvent RealmError(Number, Description)
End Sub

Private Sub tmrIdle_Timer()
    On Error GoTo hErr
    If IsOnline And IsConnected Then
        Static Counter As Byte
        If Config.Idle Then
            If Counter > 254 Then
                Counter = 1
            Else
                Counter = Counter + 1
            End If
            If Counter >= Config.IdleTime Then
                Dim str As String
                str = Config.IdleMessage
                str = Replace$(str, "%v", frmBot.Title(False) & " by Chriso@USWest - www.BnetDev.net")
                str = Replace$(str, "%t", Time)
                str = Replace$(str, "%d", Date)
                str = Replace$(str, "%q", RandomQuote)
                str = Replace$(str, "%*", DateTimeToLongString(ConvertTickCount(NowTickCount - Self.Uptime)))
                str = Replace$(str, "%^", DateTimeToLongString(ConvertTickCount(NowTickCount)))
                str = Replace$(str, "%m", Media.Track)
                SendText str
                Counter = 0
            End If
        Else
            If Counter > 0 Then Counter = 0
        End If
    End If
    Exit Sub
hErr:
    ErrorHandler "Bot", "IdleTimer"
End Sub

Private Sub tmrKeepAlive_Timer()
    On Error GoTo hErr
    If IsConnected Then
        b.Clear
        SendBnetPacket sckBnet, SID_NULL
    Else
        If TryReconnect Then Connect
    End If
    Exit Sub
hErr:
    ErrorHandler "Bot", "KeepAliveTimer"
End Sub

Private Sub tmrQueue_Timer()
    On Error GoTo hErr
    If IsOnline And IsConnected Then
        Static queueRow As Long
        If Queue.Count > 0 Then
            If (GetTickCount - QueueTick) > QueueDelay Then
                RaiseEvent ChatMessageSent(Queue.Item(1))
                b.InsertCString Queue.Item(1)
                SendBnetPacket sckBnet, SID_CHATCOMMAND
                queueRow = queueRow + 1
                QueueDelay = 2700 + (Len(Queue.Item(1)) * 18) + (queueRow * 30)
                If (queueRow / 10) = CInt(queueRow / 10) Then
                    QueueDelay = QueueDelay + 5000
                End If
                Debug.Print QueueDelay
                QueueTick = GetTickCount()
                Queue.Remove 1
                Exit Sub
            End If
        Else
            queueRow = 0
        End If
    End If
    Exit Sub
hErr:
    ErrorHandler "Bot", "QueueTimer"
End Sub

Public Sub SendBnetPacket(ByRef sck As Winsock, id As Byte)
    Select Case id
    Case SID_CHATCOMMAND, SID_WRITEUSERDATA, SID_READUSERDATA, SID_LEAVECHAT
        If IsOnline And IsConnected Then b.SendBnetPacket sck, id
    Case Else
        b.SendBnetPacket sck, id
    End Select
End Sub
