VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "BnetBot"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'----------------------------------------------------------
'  Myriad
'  Common Bot Platform
'  Copyright © 2003-2005 Eric Naeseth.
'----------------------------------------------------------
'  Version 2.4.0 (2004-12-03)
'  2.0.0: First recorded version. (Cloaked)
'  2.0.1: Added new evGetOps event. (Cloaked)
'  2.0.2: Added BinaryRejoin. (Cloaked)
'  2.0.3: Added HasOps tracking. (Cloaked)
'  2.1.0: Added profile read/write. (Cloaked)
'  2.2.0: Merged with Myriad's updated class. (Cloaked)
'  2.2.1: Added options to disable Nagel algorithm, and
'         for ping spoofing. (Cloaked)
'  2.3.0: Added additional account recovery features.
'         (Cloaked)
'  2.4.0: Now uses the BNCSutil library. (Cloaked)
'----------------------------------------------------------
'  Dependencies:
'  myriad.dll
'  Winsock.bas
'  Arbiter.cls
'  BNCSutil.bas
'----------------------------------------------------------

Private S As New Arbiter, BNLS As Arbiter, MCP As Arbiter

Public Enum bnProduct
    bpStarCraft
    bpBroodWar
    bpDiablo2
    bpDiablo2x
    bpWarCraft2
    bpWarCraft3
    bpWarCraft3x
    bpStarCraftSW
    bpDiablo
    bpDiabloSW
    bpChat
    bpStarCraftJapan
    bpBlizzard
    bpBnetRep
    bpUnknown
End Enum

Private Const PRODUCT_STARCRAFT& = &H1
Private Const PRODUCT_BROODWAR& = &H2
Private Const PRODUCT_WAR2BNE& = &H3
Private Const PRODUCT_DIABLO2& = &H4
Private Const PRODUCT_LORDOFDESTRUCTION& = &H5
Private Const PRODUCT_JAPANSTARCRAFT& = &H6
Private Const PRODUCT_WARCRAFT3& = &H7
Private Const PRODUCT_THEFROZENTHRONE& = &H8

' Events
Public Enum bnEvent
    evConError
    evConnect
    evBnlsConnect
    evBnlsDisconnect
    evDisconnect
    evAbort
    evHandshakeComplete
    evConMsg
    evBroadcast
    evTalk
    evEmote
    evWhisperSend
    evWhisperRecv
    evJoin
    evPart
    evChannel
    evUser
    evError
    evInfo
    evSelfTalk
    evBot
    evDbg
    evGetOps
    evRegisterEmail
    evConnecting
    evBnlsConnecting
    evProxyConnecting
    evProxyConnect
    evSuccess
    evJoinedChannel
    evUserFlags
    evRealmConnecting
    evRealmConnect
    evRealmDisconnect
    evRealmStarted
    evRealmStartFailure
    evRealmCharList
    evRealmMOTD
    evRealmCharCreated
    evRealmCharCreateErr
    evRealmCharLogon
    evRealmCharLogonErr
    evRealmCharUpgraded
    evBuildList
    evGeneratedMessage
    evWrongPassword
End Enum

Public Enum prxType
    socks4
    socks5
End Enum

'Private Const CRC32_POLYNOMIAL As Long = &HEDB88320
'Private CRC32Table(0 To 255) As Long

'-----------------------------------------------------------------------------------
'  Hashed Connections
'-----------------------------------------------------------------------------------
'Private Declare Function CheckVersion Lib "myriad.dll" _
    (ByVal lpszFileName1 As String, ByVal lpszFileName2 As String, ByVal lpszFilename3 As String, _
    ByVal lpszValueString As String, lpdwVersion As Long, lpdwChecksum As Long, _
    ByVal lpExeInfoString As String, ByVal lpszMpqFileName As String) As Long
'Private Declare Function GetPasswordHash Lib "myriad.dll" Alias "PasswordHash" _
    (ByVal outBuf As String, ByVal serverToken As Long, ByVal password As String) As Long
'Private Declare Function PasswordHashEx Lib "myriad.dll" _
    (ByVal outBuf As String, ByVal clientKey As Long, ByVal serverToken As Long, _
    ByVal password As String) As Long
'Private Declare Function CDKeyHash Lib "myriad.dll" _
    (ByVal outBuf As String, ByVal lpszCDKey As String, ByVal dwServerHashKey As Long) _
    As Long
'Private Declare Function CDKeyHashEx Lib "myriad.dll" (ByVal outBuf As String, _
    ByVal lpszCDKey As String, ByVal dwClientKey As Long, ByVal dwServerToken As Long) As Long
'Private Declare Function CreateHash Lib "myriad.dll" Alias "CreateAccount" _
    (ByVal outBuf As String, ByVal password As String)
'Private Declare Sub calcHashBuf Lib "myriad.dll" _
    Alias "CalcHashBuf" (outBuf As Any, Inbuf As Any, ByVal length As Integer)
    
'-----------------------------------------------------------------------------------
'  Other myriad.dll Functions
'-----------------------------------------------------------------------------------
'Private Declare Function BNLSChecksum Lib "myriad.dll" (ByVal password As String, _
    ByVal ServerCode As Long) As Long

Private Declare Function GetUserDefaultLangID Lib "kernel32" () As Integer
Private Declare Function GetUserDefaultLCID Lib "kernel32" () As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32" _
    (lpFileTime As Filetime, lpSystemTime As SYSTEMTIME) As Boolean
'Private Declare Function WideCharToMultiByte Lib "kernel32" _
    (ByVal CodePage As Long, ByVal dwFlags As Long, lpWideCharStr As String, _
    ByVal cchWideChar As Long, lpMultiByteStr As String, ByVal cbMultiByte As Long, _
    lpDefaultChar As String, lpUsedDefaultChar As Long) As Long
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As String, ByVal cchMultiByte As Long, ByVal lpWideCharStr As String, ByVal cchWideChar As Long) As Long
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As String, ByVal cchWideChar As Long, ByVal lpMultiByteStr As String, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByVal lpUsedDefaultChar As Long) As Long
Private Const CP_ACP = 0
Private Const CP_UTF8 = 65001
'Private Declare Function SetTimer Lib "user32" _
    (ByVal hWnd As Long, _
    ByVal nIDEvent As Long, _
    ByVal uElapse As Long, _
    ByVal lpTimerFunc As Long) As Long
'Private Declare Function KillTimer Lib "user32" _
    (ByVal hWnd As Long, _
    ByVal nIDEvent As Long) As Long


Private Type Filetime
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
End Type

'-----------------------------------------------------------------------------------
'  BNLS Result Variables
'-----------------------------------------------------------------------------------
Private VerByte&, UseNLS As Boolean, IX86File$, ChecksumFormula$, CDKeyData$, _
    ExCDKeyData$, ClientSession&, ServerSession&, RegRequired As Boolean
    
'-----------------------------------------------------------------------------------
'  Operational Status
'-----------------------------------------------------------------------------------
Private JoiningChannel As Boolean, JoinTarget As String, _
    CreatingAccount As Boolean, RequestingStats As Boolean, ClanCandidates() As String, _
    BNOD$, BNOL&, LastNullSent&, Verbose As Boolean, PCStage As Long, PasswordHash As String, _
    MCPChunk(15) As Long, RUniqueUsername$, HasJoinedChannel As Boolean, BNLSRetry As Boolean, _
    NLS As Long
Public Channel As String, TalkOK As Boolean, _
    GotCandidates As Boolean, FCStatus As Byte, ClanCreateSuccess As Boolean, _
    HasOps As Boolean, LastChannel As String, JoinLastChannel As Boolean

'-----------------------------------------------------------------------------------
'  Users in Channel Iterator
'-----------------------------------------------------------------------------------
Private UserI As Long

'-----------------------------------------------------------------------------------
'  Bot Information
'-----------------------------------------------------------------------------------
Public Username$, Password$, Server$, RealUsername$, Client As bnProduct, _
    cdkey$, ExCDKey$, Home$, Register$, Trigger$, UseBNLS As Boolean, _
    Proxy As Boolean, ProxyServer$, ProxyInit As Boolean, ProxyPort As Integer, _
    ProxyType As prxType, ProxyUser$, ProxyPassword$, bKey$, Profile$, UseRealm As Boolean, _
    Character As String, Realm As String, DBFile$, BNLSServer$
Public ChannelUsers As New Collection, SpamUsers As New Collection

'-----------------------------------------------------------------------------------
'  Hash Files
'-----------------------------------------------------------------------------------
'  StarCraft/Brood War/WarCraft II BNE
'  Hash1: StarCraft.exe or WarCraft II BNE.exe
'  Hash2: storm.dll
'  Hash3: battle.snp
'-----------------------------------------------------------------------------------
'  Diablo II/Lord of Destruction
'  Hash1: Game.exe
'  Hash2: Bnclient.dll
'  Hash3: D2Client.dll
'-----------------------------------------------------------------------------------
Public Hash1 As String, Hash2 As String, Hash3 As String

'-----------------------------------------------------------------------------------
'  Ping Mode
'-----------------------------------------------------------------------------------
Public Enum PingModes
    pmNormal = 0
    pmZero = 1
    pmMinus1 = 2
    pmPlug = 4
End Enum
Public PingMode As PingModes

'-----------------------------------------------------------------------------------
'  Profile Requests
'-----------------------------------------------------------------------------------
Private Type RequestInfo
    User As String
    Keys() As String
End Type
Private PendingProfileRequests() As RequestInfo

'-----------------------------------------------------------------------------------
'  Constants
'-----------------------------------------------------------------------------------
Private Const DEFAULT_REGISTER As String = "Myriad"
Private Const DISABLE_NAGEL As Boolean = True 'sets TCP_NODELAY if True

'-----------------------------------------------------------------------------------
'  Triggered Events
'-----------------------------------------------------------------------------------
Public TriggeredEvent As String, EventTime As Long, TriggerHappy As Boolean
Private EventBuffer As String

'-----------------------------------------------------------------------------------
'  Flood Protection
'-----------------------------------------------------------------------------------
Public Enum FloodLevels
    flNormal = 0
    flLimitActions
    flAlternateParser
    flNoSafelist
    flQueueBypass
End Enum
Public floodLevel As FloodLevels

Public Version As String
Public tmpFileTIME As String

Private Sub Class_Initialize()
    Client = bpUnknown
    ProxyInit = False
    JoiningChannel = False
    RegRequired = False
    Proxy = False
    TalkOK = False
    CreatingAccount = False
    RequestingStats = False
    GotCandidates = False
    UserI = 1
    ClanCreateSuccess = False
    Verbose = False
    floodLevel = flNormal
    Version = "2.4.1"
    BNLSServer = "bnls.valhallalegends.com"
    'BNLSServer = "hdx.jbls.org"
'    Set Q = New Queue
End Sub

Public Function Connect() As Boolean
    'Load frmMain.txtRecv(0)
On Error GoTo Con_Error
    Dim tR As Integer
    PCStage = 0
    HasJoinedChannel = False
    RealUsername = Username
    floodLevel = flNormal
    Connect = False
    If Client = bpUnknown Then
        BotEvent bKey, evConError, "Unknown product."
        Exit Function
    End If
    
    If UseBNLS Then
        Set BNLS = New Arbiter
        tR = frmMain.txtRecv.Count
        Load frmMain.txtRecv(tR)
        If BNLS.Initialize(frmMain.txtRecv(tR).hwnd, bKey, sBNLS) Then
            BotEvent bKey, evBnlsConnecting
            Connect = True
            If Not BNLS.Connect(BNLSServer, 9367) Then
                Connect = False
                BotEvent bKey, evConError, "Could not connect to BNLS."
            End If
        Else
            BotEvent bKey, evConError, "Could not initialize BNLS socket."
        End If
    Else
        If SupportsHashedClient(Client) Then
            Connect = True
            ConnectToBattleNet
        Else
            BotEvent bKey, evConError, "Cannot connect using a hashed connection as a " & _
                ClientKeyToName(Client) & " client."
        End If
    End If
    Exit Function
Con_Error:
    BotEvent bKey, evConError, "Error on Connect(): " & Err.Description & " (#" & _
        Err.Number & ").  Please report this bug."
End Function

Public Function Disconnect() As Boolean
On Error Resume Next
    TalkOK = False
    If UseBNLS Then _
        BNLS.Disconnect
    S.Disconnect
    BotEvent bKey, evDisconnect
On Error GoTo D_End
    If UseRealm Then
        MCP.Disconnect
        BotEvent bKey, evRealmDisconnect
    End If
D_End:
End Function

Public Sub SocketEvent(EventType As mSocketEvent, SocketType As mSocketType, _
    Optional Data As String, Optional Length As Long)
    
    Select Case EventType
        Case sConnect
            Select Case SocketType
                Case sBNLS
                    BotEvent bKey, evBnlsConnect
                    Me.BNLSStart
                Case sBattleNet
                    If ProxyInit Then
                        BotEvent bKey, evProxyConnect
                        ProxyStart
                    Else
                        BotEvent bKey, evConnect
                        Me.BNetStart
                    End If
                Case sMCP
                    BotEvent bKey, evRealmConnect
                    MCPStart
            End Select
        Case sData
            Select Case SocketType
                Case sBNLS
                    Me.BNLSData Data, Length
                Case sBattleNet
                    If ProxyInit Then
                        ProxyData Data, Length
                    Else
                        Me.BNetData Data, Length
                    End If
                Case sMCP
                    MCPData Data, Length
            End Select
        Case sDisconnect
            Select Case SocketType
                Case sBNLS
                    BotEvent bKey, evBnlsDisconnect
                    BNLS.onDisconnect
                Case sBattleNet
                    TalkOK = False
                    BotEvent bKey, evDisconnect
                    S.onDisconnect
                Case sMCP
                    BotEvent bKey, evRealmDisconnect
                    MCP.onDisconnect
            End Select
        Case sError
            Select Case SocketType
                Case sBNLS
                    BotEvent bKey, evConError, "BNLS Connection Error: " & Data & " (#" & Length & ")"
                    BNLS.onDisconnect
                    If BNLSRetry Then
                        BNLSServer = "bnls.valhallalegends.com"
                        BNLSRetry = False
                    'ElseIf (Length = 10049 Or Length = 11004) Then
                    Else
                        BNLSRetry = True
                        BNLSServer = "63.161.183.207"
                        BotEvent bKey, evConMsg, "Retrying BNLS with alternate address..."
                        Connect
                    End If
                Case sBattleNet
                    BotEvent bKey, evConError, "B.Net Connection Error: " & Data & " (#" & Length & ")"
                    S.onDisconnect
                Case sMCP
                    BotEvent bKey, evConError, "Realm Connection Error: " & Data & " (#" & Length & ")"
                    MCP.onDisconnect
            End Select
    End Select
End Sub

Public Sub ProxyStart()
    Dim P As New Packet
    Select Case ProxyType
        Case socks4
            With P
                .InsertByte 4
                .InsertByte 1
                .InsertWORD htons(6112)
                .InsertDWORD GetHostByNameAlias(Server)
                .InsertString ProxyUser
                S.Send .GetData(), , True
            End With
        Case socks5
            With P
                .InsertByte 5
                If Len(ProxyUser) Then
                    .InsertByte 2
                    .InsertByte 0
                    .InsertByte 2
                Else
                    .InsertByte 1
                    .InsertByte 0
                End If
                S.Send .GetData(), , True
            End With
    End Select
End Sub

Public Sub ProxyData(Data As String, Length As Long)
    Dim P As New Packet, o As New Packet, bWk As Byte
    P.SetData Data
    Select Case ProxyType
        Case socks4
            With P
                .Skip 1
                bWk = .GetByte()
                Select Case bWk
                    Case 90
                        BotEvent bKey, evSuccess, "SOCKS4 request granted."
                        ProxyInit = False
                        SocketEvent sConnect, sBattleNet
                    Case 91
                        BotEvent bKey, evConError, "SOCKS4 request rejected or failed."
                        ProxyInit = False
                    Case 92
                        BotEvent bKey, evConError, "SOCKS4 request rejected; server requires identd."
                        ProxyInit = False
                    Case 93
                        BotEvent bKey, evConError, "SOCKS4 request rejected; user ID and identd are different."
                        ProxyInit = False
                End Select
            End With
        Case socks5
            Select Case PCStage
                Case 0
                    'Handshake response
                    P.Skip 1
                    bWk = P.GetByte()
                    Select Case bWk
                        Case 0
                            PCStage = 2
                            With o
                                .InsertByte 5
                                .InsertByte 1
                                .InsertByte 0
                                .InsertByte 1
                                .InsertDWORD GetHostByNameAlias(Server)
                                .InsertWORD htons(6112)
                                S.Send .GetData(), , True
                            End With
                        Case 2
                            If Len(ProxyUser) > 255 Or Len(ProxyPassword) > 255 Then
                                BotEvent bKey, evAbort, "Could not connect: Your SOCKS5 username and password must be 255 characters or less in length."
                                S.Disconnect
                                Exit Sub
                            End If
                            PCStage = 1
                            With o
                                .InsertByte 1
                                .InsertByte Len(ProxyUser)
                                .InsertNonNTString ProxyUser
                                .InsertByte Len(ProxyPassword)
                                .InsertNonNTString ProxyPassword
                                S.Send .GetData(), , True
                            End With
                        Case &HFF
                            BotEvent bKey, evAbort, "SOCKS5: Server did not accept authentication."
                            ProxyInit = False
                    End Select
                Case 1
                    'Login response
                    P.Skip 1
                    bWk = P.GetByte()
                    If bWk = 0 Then
                        BotEvent bKey, evSuccess, "SOCKS5: Username and password accepted."
                        PCStage = 2
                        With o
                            .InsertByte 5
                            .InsertByte 1
                            .InsertByte 0
                            .InsertByte 1
                            .InsertDWORD GetHostByNameAlias(Server)
                            .InsertWORD htons(6112)
                            S.Send .GetData(), , True
                        End With
                    Else
                        BotEvent bKey, evAbort, "SOCKS5: Username and password rejected."
                        ProxyInit = False
                    End If
                Case 2
                    'Connect response
                    P.Skip 1
                    bWk = P.GetByte()
                    Select Case bWk
                        Case &H0
                            ProxyInit = False
                            SocketEvent sConnect, sBattleNet
                        Case &H1
                            BotEvent bKey, evAbort, "SOCKS5: Server failure."
                            ProxyInit = False
                        Case &H2
                            BotEvent bKey, evAbort, "SOCKS5: Connection not allowed."
                            ProxyInit = False
                        Case &H3
                            BotEvent bKey, evAbort, "SOCKS5: Proxy server could not contact Battle.Net."
                            ProxyInit = False
                        Case &H4
                            BotEvent bKey, evAbort, "SOCKS5: Proxy server could not contact Battle.Net."
                            ProxyInit = False
                        Case &H5
                            BotEvent bKey, evAbort, "SOCKS5: Battle.Net refused the proxy server's attempt to connect."
                            ProxyInit = False
                        Case &H6
                            BotEvent bKey, evAbort, "SOCKS5: Time-to-live expired."
                            ProxyInit = False
                        Case &H7
                            BotEvent bKey, evAbort, "SOCKS5: Proxy server does not support connections."
                            ProxyInit = False
                        Case &H8
                            BotEvent bKey, evAbort, "SOCKS5: Proxy server cannot handle IPv4 addresses."
                            ProxyInit = False
                        Case Else
                            BotEvent bKey, evAbort, "SOCKS5: Unknown connection status response."
                            S.Disconnect
                            ProxyInit = False
                    End Select
            End Select
    End Select
End Sub

Public Sub BNLSStart()
    '*** BNLS no longer requires authorization (June 28, 2004)
    Dim P As New Packet
    With P
        .InsertDWORD GetBNLSProduct()
        BNLS.Send .GetData(), BNLS_REQUESTVERSIONBYTE
    End With
End Sub

Public Sub BNLSData(Data As String, Length As Long)
    Dim Size As Integer, PacketID As Byte, P As New Packet, o As New Packet, lngWork&, _
        bWork As Byte, i&, strTMP As String
    P.SetData Data
    While Size < Length And i < 1024
        Size = Size + P.GetWORD()
        PacketID = P.GetByte()
        'Debug.Print "Recieved BNLS packet " & PacketID
        Select Case PacketID
            '*** BNLS no longer requires authorization (June 28, 2004)
            Case BNLS_REQUESTVERSIONBYTE
                P.Skip 4
                VerByte = P.GetDWORD()
                strTMP = Hex$(VerByte)
                If Len(strTMP) = 1 Then strTMP = "0" & strTMP
                WriteConfig ClientKeyToStr(Client), strTMP, "VerByte"
                'MsgBox "About to connect to Battle.net", vbExclamation, "BnetBot"
                ConnectToBattleNet
                'TestCDKeyEx
            Case BNLS_CDKEY_EX
                P.Skip 4
                bWork = P.GetByte()
                P.Skip 1
                'BotEvent bKey, evConMsg, "Recieved " + CStr(P.GetByte()) + " / " + CStr(bWork) + _
                    " CD keys."
                lngWork = P.GetDWORD()
                If (Client = bpDiablo2x) Then
                    If lngWork = 2 Then
                        BotEvent bKey, evAbort, "BNLS could not decode your Diablo II original CD-Key."
                        closesocket BNLS.Sock
                        closesocket S.Sock
                        Exit Sub
                    ElseIf lngWork = 1 Then
                        BotEvent bKey, evAbort, "BNLS could not decode your Lord of Destruction CD-Key."
                        closesocket BNLS.Sock
                        closesocket S.Sock
                        Exit Sub
                    ElseIf lngWork = 0 Then
                        BotEvent bKey, evAbort, "BNLS could not decode your Diablo II or Lord of Destruction CD-Keys."
                        closesocket BNLS.Sock
                        closesocket S.Sock
                        Exit Sub
                    End If
                ElseIf (Client = bpWarCraft3x) Then
                    If lngWork = 2 Then
                        BotEvent bKey, evAbort, "BNLS could not decode your WarCraft III original CD-Key."
                        closesocket BNLS.Sock
                        closesocket S.Sock
                        Exit Sub
                    ElseIf lngWork = 1 Then
                        BotEvent bKey, evAbort, "BNLS could not decode your WC3: The Frozen Throne CD-Key."
                        closesocket BNLS.Sock
                        closesocket S.Sock
                        Exit Sub
                    ElseIf lngWork = 0 Then
                        BotEvent bKey, evAbort, "BNLS could not decode your WarCraft III or Frozen Throne CD-Keys."
                        closesocket BNLS.Sock
                        closesocket S.Sock
                        Exit Sub
                    End If
                Else
                    If lngWork = 0 Then
                        BotEvent bKey, evAbort, "BNLS could not decode your CD-Key."
                        closesocket BNLS.Sock
                        closesocket S.Sock
                        Exit Sub
                    End If
                End If
                'BotEvent bKey, evDbg, Data
                With P
                    ClientSession = .GetDWORD()
                    CDKeyData = .GetFixedString(36)
                    If Client = bpDiablo2x Or Client = bpWarCraft3x Then
                        .Skip 4
                        ExCDKeyData = .GetFixedString(36)
                    End If
                End With
                If Verbose Then
                    If bWork = 1 Then
                        BotEvent bKey, evSuccess, "CD-Key encrypted successfully."
                    ElseIf bWork = 2 Then
                        BotEvent bKey, evSuccess, "CD-Keys encrypted successfully."
                    End If
                End If
                'BNLS_VERSIONCHECKEX2 (BaDaSs)
                With o
                        .InsertDWORD GetBNLSProduct()
                        .InsertDWORD &H0
                        .InsertVOID tmpFileTIME
                        .InsertString IX86File
                        .InsertString ChecksumFormula
                        BNLS.Send o.GetData, BNLS_VERSIONCHECKEX2
                'BNLS_VERSIONCHECKEX (OLD)
                     '.InsertDWORD GetBNLSProduct()
                     'Select Case IX86File
                     '   Case "IX86ver0.mpq":
                     '       .InsertDWORD &H0
                     '   Case "IX86ver1.mpq":
                     '       .InsertDWORD &H1
                     '   Case "IX86ver2.mpq":
                     '       .InsertDWORD &H2
                     '   Case "IX86ver3.mpq":
                     '       .InsertDWORD &H3
                     '   Case "IX86ver4.mpq":
                     '       .InsertDWORD &H4
                     '   Case "IX86ver5.mpq":
                     '       .InsertDWORD &H5
                     '   Case "IX86ver6.mpq":
                     '       .InsertDWORD &H6
                     '   Case "IX86ver7.mpq":
                     '       .InsertDWORD &H7
                     'End Select
                        'BotEvent bKey, evDbg, ChecksumFormula
                     '.InsertString ChecksumFormula
                     'BNLS.Send o.GetData(), BNLS_VERSIONCHECK
                End With
            Case BNLS_VERSIONCHECKEX2 ' Added By BaDaSs
            'Case BNLS_VERSIONCHECK (OLD)
            '    'BotEvent bKey, evConMsg, "Recieved BNLS_VERSIONCHECK."
            '    'BotEvent bKey, evDbg, StrToHex(Data)
                If (P.GetBoolean() = False) Then
                    Disconnect
                    BotEvent bKey, evAbort, "Version check failed."
                    Exit Sub
                End If
                If Verbose Then _
                    BotEvent bKey, evSuccess, "Version check succeeded."
                With o
                    'BotEvent bKey, evDbg, ClientSession
                    .InsertDWORD ClientSession 'Client session key
                    .InsertDWORD P.GetDWORD 'Version
                    .InsertDWORD P.GetDWORD 'Checksum
                    If (Client = bpDiablo2x Or Client = bpWarCraft3x) Then
                        .InsertDWORD &H2 '2 keys
                    Else
                        .InsertDWORD &H1 '1 key
                    End If
                    .InsertDWORD 0
                    .InsertNonNTString CDKeyData
                    If (Client = bpDiablo2x Or Client = bpWarCraft3x) Then _
                        .InsertNonNTString ExCDKeyData
                    .InsertString P.GetString 'Statstring
                    If LenB(Register) = 0 Then
                        .InsertString DEFAULT_REGISTER 'Register (Default)
                    Else
                        .InsertString Register 'Register
                    End If
                    S.Send .GetData, SID_AUTH_CHECK
                End With
            Case BNLS_HASHDATA
                If Verbose Then _
                    BotEvent bKey, evConMsg, "Recieved password hash."
                With o
                    If CreatingAccount = False Then
                        PasswordHash = P.GetFixedString(20)
                        .InsertDWORD ClientSession
                        .InsertDWORD ServerSession
                        .InsertNonNTString PasswordHash 'Hash Data
                        .InsertNTString Username
                        S.Send .GetData(), SID_LOGONRESPONSE2
                    Else
                        .InsertNonNTString P.GetFixedString(20)
                        .InsertString Username
                        S.Send .GetData(), SID_CREATEACCOUNT2
                        CreatingAccount = False
                    End If
                End With
            Case BNLS_LOGONCHALLENGE
                With o
                    .InsertNonNTString P.GetFixedString(32)
                    .InsertString Username
                    S.Send .GetData(), SID_AUTH_ACCOUNTLOGON
                End With
            Case BNLS_LOGONPROOF
                With o
                    .InsertNonNTString P.GetFixedString(20)
                    S.Send .GetData(), SID_AUTH_ACCOUNTLOGONPROOF
                End With
            Case BNLS_CONFIRMLOGON
                If P.GetBoolean = False Then
                    BotEvent bKey, evAbort, "Unable to confirm that Battle.Net server knows your password!"
                    Disconnect
                    Exit Sub
                End If
                If RegRequired Then
                    'E-Mail Registration
                    BotEvent bKey, evRegisterEmail, , Username
                Else
                    EnterChat
                End If
            Case BNLS_CREATEACCOUNT
                BotEvent bKey, evConMsg, "Recieved BNLS_CREATEACCOUNT."
                With o
                    .InsertNonNTString P.GetFixedString(64)
                    .InsertString Username
                    S.Send .GetData(), SID_AUTH_ACCOUNTCREATE
                End With
        End Select
        If P.Position < Size Then _
            P.Skip Size - P.Position + 1
        i = i + 1
    Wend
End Sub

Public Sub BNetStart()
    Dim P As Packet, Ping As Packet
    Set P = New Packet
    SendData S.Sock, Chr$(1)
    If Verbose Then _
        BotEvent bKey, evConMsg, "Sent protocol byte."
    With P
        .InsertDWORD &H0 'Protocol ID (always zero)
        .InsertNonNTString "68XI" 'Platform ID (Intel x86)
        .InsertNonNTString StrReverse(ClientKeyToStr(Client)) 'Game Client
        .InsertDWORD VerByte 'Version byte
        .InsertDWORD &H0 'Product Language
        .InsertDWORD &H0 'Local IP for Network Address Translation
        .InsertDWORD &H0 'Time zone bias
        .InsertDWORD &H0 'Locale ID
        .InsertDWORD &H0 'Language ID
        .InsertString "USA" 'Country abbreviation
        .InsertString "United States" 'Country
    End With
    S.Send P.GetData(), SID_AUTH_INFO
    If (PingMode And pmZero) = pmZero Then
        Set Ping = New Packet
        With Ping
            .InsertDWORD &H0
            S.Send .GetData(), SID_PING
        End With
    End If
    Set Ping = Nothing
    Set P = Nothing
End Sub

Public Sub BNetData(Data As String, Length As Long)
'On Error GoTo BND_Error

    Dim Pos&, PacketID As Byte, PacketLen As Integer
    Pos = 1
    
    If BNOL Then
        Length = Length + BNOL
        Data = BNOD & Data
        BNOL = 0
        BNOD = ""
    End If
    'Yeah this really isn't helping me, wanna just fix mine instead? :) :) :) :) :) :) :) I love you
    'AddC StrToHex(Data)
    While Pos <= Length
        '12345678901234567890
        'xyzabc123de.
        If (Pos + 3) > Length Then
            'BotEvent bKey, evDbg, "Trying to read beyond end of header; assuming fragmented."
            BNOD = Mid$(Data, Pos)
            BNOL = Len(BNOD)
            Exit Sub
        End If
        If Asc(Mid$(Data, Pos, 1)) <> &HFF Then
            BotEvent bKey, evConError, "Received invalid packet from Battle.Net."
            Exit Sub
        End If
        PacketID = CByte(Asc(Mid$(Data, Pos + 1, 1)))
        PacketLen = ExtractWORD(Mid$(Data, Pos + 2, 2))
        If (Pos + PacketLen - 1) > Length Then
            'BotEvent bKey, evDbg, "Trying to read beyond end of data; assuming fragmented."
            BNOD = Mid$(Data, Pos)
            BNOL = Len(BNOD)
            Exit Sub
        End If
        If floodLevel > flLimitActions Then
            'AddC StrToHex(Mid$(Data, Pos + 4, PacketLen - 4))
            If PacketID = SID_CHATEVENT Then _
                FloodPacket PacketID, Mid$(Data, Pos + 4, PacketLen - 4)
        Else
            BNPacket PacketID, Mid$(Data, Pos + 4, PacketLen - 4)
        End If
        Pos = Pos + PacketLen
    Wend
    Exit Sub
BND_Error:
    BotEvent bKey, evConError, "[BNet PD] " & Err.Description & " (#" & Err.Number & ") " & Err.Source
End Sub

Private Function ExtractWORD(Str As String) As Integer
    Dim rVal%
    CopyMemory rVal, ByVal Str, 2
    ExtractWORD = rVal
End Function

Private Sub BNPacket(PacketID As Byte, Data As String)
    Dim P As Packet, o As Packet, i&, pEnd&, lngWork&, eID&
    Dim strTMP$, eFlags&, ePing&, eUser$, eMsg$, tmpUser As New User, bytTmp As Byte, _
        eUserK$
    Dim j&, cWork As Collection, lngWork2&
    Set P = New Packet
    Set o = New Packet
    
    'Fragmented packet handling
    'If BNOL > 0 Then
    '    Length = Length + BNOL
    '    Data = BNOD & Data
    '    BNOD = ""
    '    BNOL = 0
    'End If
    
    P.SetData Data
    Select Case PacketID
        Case SID_PING
            If ((PingMode And pmZero) <> pmZero) And ((PingMode And pmMinus1) <> pmMinus1) Then
                o.InsertDWORD P.GetDWORD()
                S.Send o.GetData(), SID_PING
            End If
        Case SID_AUTH_INFO
            'BotEvent bKey, evConMsg, "Recieved SID_AUTH_INFO."
            lngWork = P.GetDWORD()
            Select Case lngWork
                Case &H0:
                    UseNLS = False
                    BotEvent bKey, evConMsg, "Using Old Logon System (Broken SHA-1)."
                Case &H1:
                    UseNLS = True
                    BotEvent bKey, evConMsg, "Using New Logon System Version 1."
                Case &H2:
                    UseNLS = True
                    BotEvent bKey, evConMsg, "Using New Login System Version 2."
                    If UseBNLS Then
                        o.InsertDWORD &H2
                        BNLS.Send o.GetData(), BNLS_CHOOSENLSREVISION
                    End If
                Case Else:
                    BotEvent bKey, evAbort, "Unrecognized logon type.  You should check if a new version of the bot is available."
                    Disconnect
                    Exit Sub
            End Select
            If UseBNLS Then
                With o
                    If Verbose Then _
                        BotEvent bKey, evConMsg, "Requesting CD-key hash..."
                    .InsertDWORD &H0 'Cookie (yummy!)
                    
                    'Number of CD-Keys:
                    If (Client = bpDiablo2x Or Client = bpWarCraft3x) Then
                        .InsertByte &H2 'Original + Expansion Keys
                    Else
                        .InsertByte &H1 'Original Key Only
                    End If
                    .InsertDWORD &H1 'Same session key flag
                    ServerSession = P.GetDWORD() 'Server key
                    .InsertDWORD ServerSession
                    .InsertNTString cdkey 'Original key
                    If (Client = bpDiablo2x Or Client = bpWarCraft3x) Then _
                        .InsertNTString ExCDKey 'Expansion key
                    'MsgBox "Sending BNLS_CDKEY_EX", vbExclamation, "BnetBot"
                End With
                BNLS.Send o.GetData, BNLS_CDKEY_EX
                With P
                    Dim tmpPeek As String
                    tmpPeek = P.Peek
                    tmpFileTIME = Mid$(tmpPeek, 1, 8) 'Added By BaDaSs
                    .Skip 12
                    IX86File = .GetString
                    ChecksumFormula = .GetString
                End With
            Else
                With P
                    ServerSession = .GetDWORD()
                    .Skip 12
                    IX86File = .GetString()
                    ChecksumFormula = .GetString()
                End With
                'Hashed
                SendAuthCheck
            End If
        Case SID_AUTH_CHECK
            lngWork = P.GetDWORD()
            
            Select Case lngWork
                Case &H0
                    BotEvent bKey, evSuccess, "Passed version and CD-Key check."
                Case &H100
                    Disconnect
                    BotEvent bKey, evAbort, "Game version is out of date.  Wait for a BNLS update."
                    Exit Sub
                Case &H101
                    Disconnect
                    BotEvent bKey, evAbort, "Invalid game version."
                    Exit Sub
                Case &H200
                    Disconnect
                    BotEvent bKey, evAbort, "Invalid CD-Key."
                    Exit Sub
                Case &H201
                    Disconnect
                    strTMP = P.GetString()
                    If LenB(strTMP) > 0 Then
                        BotEvent bKey, evAbort, "CD-Key in use by " & strTMP & "."
                    Else
                        BotEvent bKey, evAbort, "CD-Key in use."
                    End If
                    Exit Sub
                Case &H202
                    Disconnect
                    BotEvent bKey, evAbort, "CD-Key is banned from Battle.Net."
                    Exit Sub
                Case &H203
                    Disconnect
                    BotEvent bKey, evAbort, "CD-Key is for another game."
                    Exit Sub
                Case &H210
                    Disconnect
                    BotEvent bKey, evAbort, "Invalid Expansion CD-Key."
                    Exit Sub
                Case &H211
                    Disconnect
                    strTMP = P.GetString()
                    If LenB(strTMP) > 0 Then
                        BotEvent bKey, evAbort, "Expansion CD-Key in use by " & strTMP & "."
                    Else
                        BotEvent bKey, evAbort, "Expansion CD-Key in use."
                    End If
                    Exit Sub
                Case &H212
                    Disconnect
                    BotEvent bKey, evAbort, "Expansion CD-Key is banned from Battle.Net."
                    Exit Sub
                Case &H213
                    Disconnect
                    BotEvent bKey, evAbort, "Expansion CD-Key is for another game."
                    Exit Sub
            End Select
            LogIn
        Case SID_AUTH_ACCOUNTLOGON
            lngWork = P.GetDWORD()
            Select Case lngWork
                Case &H0
                    If UseBNLS Then
                        With o
                            .InsertNonNTString P.GetFixedString(64)
                            BNLS.Send .GetData(), BNLS_LOGONPROOF
                        End With
                    Else
                        Dim B$, Salt$, M1$
                        Salt = P.GetFixedString(32)
                        B = P.GetFixedString(32)
                        
                        M1 = String$(20, vbNullChar)
                        Call nls_get_M1(NLS, M1, B, Salt)
                        
                        
                        With o
                            .InsertNonNTString M1
                            S.Send .GetData(), SID_AUTH_ACCOUNTLOGONPROOF
                        End With
                    End If
                Case &H1
                    BotEvent bKey, evError, "Account does not exist."
                    If (MsgBox("The account you have attempted to connect with does not exist.  Would you like to create it?", _
                        vbQuestion Or vbYesNo, GetVersion(mvTitlebar)) = vbYes) Then
                        If UseBNLS Then
                            With o
                                .InsertString Username
                                .InsertString LCase$(Password)
                                BNLS.Send o.GetData(), BNLS_CREATEACCOUNT
                            End With
                        Else
                            Dim CreateBuf As String, DataLen As Long
                            DataLen = Len(Username) + 65
                            CreateBuf = String$(DataLen, vbNullChar)
                            If (nls_account_create(NLS, CreateBuf, DataLen) = 0) Then
                                BotEvent bKey, evAbort, "Failed to build account creation packet."
                                Disconnect
                            Else
                                With o
                                    .InsertNonNTString CreateBuf
                                    S.Send .GetData(), SID_AUTH_ACCOUNTCREATE
                                End With
                            End If
                        End If
                    Else
                        Disconnect
                    End If
                Case &H5
                    BotEvent bKey, evConMsg, "Account requires upgrade."
                    Disconnect
                Case Else
                    BotEvent bKey, evAbort, "Unknown failure on SID_AUTH_ACCOUNTLOGON."
                    Disconnect
            End Select
        Case SID_AUTH_ACCOUNTLOGONPROOF
            lngWork = P.GetDWORD()
            Select Case lngWork
                Case &H0
                    'Success
                    RegRequired = False
                    BotEvent bKey, evSuccess, "Username and password accepted."
                    If UseBNLS Then
                        With o
                            .InsertNonNTString P.GetFixedString(20)
                            BNLS.Send .GetData(), BNLS_CONFIRMLOGON
                        End With
                    Else
                        Call nls_free(NLS)
                        EnterChat
                    End If
                Case &H2
                    BotEvent bKey, evError, "Your password is incorrect."
                    BotEvent bKey, evWrongPassword
                    'Disconnect
                Case &HE
                    'E-Mail Registration Needed
                    BotEvent bKey, evSuccess, "Username and password accepted."
                    If UseBNLS Then
                        RegRequired = True
                        With o
                            .InsertNonNTString P.GetFixedString(20)
                            BNLS.Send .GetData(), BNLS_CONFIRMLOGON
                        End With
                    Else
                        Call nls_free(NLS)
                        BotEvent bKey, evRegisterEmail, , Username
                    End If
                Case &HF
                    BotEvent bKey, evError, "Login error: " & P.GetString()
                Case Else
                    BotEvent bKey, evAbort, "Unknown failure on SID_AUTH_ACCOUNTLOGONPROOF."
                    Disconnect
            End Select
        Case SID_AUTH_ACCOUNTCREATE
            lngWork = P.GetDWORD()
            Select Case lngWork
                Case &H0
                    BotEvent bKey, evSuccess, "Account created."
                    If UseBNLS Then
                        With o
                            .InsertString Username
                            .InsertString LCase$(Password)
                            BNLS.Send .GetData(), BNLS_LOGONCHALLENGE
                        End With
                        Exit Sub
                    Else
                        LogIn
                    End If
                Case &H7
                    BotEvent bKey, evAbort, "Username is too short."
                    Disconnect
                Case &H8
                    BotEvent bKey, evAbort, "Username contains an illegal character."
                    Disconnect
                Case &H9
                    BotEvent bKey, evAbort, "Username contains an illegal word."
                    Disconnect
                Case &HA
                    BotEvent bKey, evAbort, "Username contains too few alphanumeric characters."
                    Disconnect
                Case &HB
                    BotEvent bKey, evAbort, "Username contains punctuation characters that are next to each other."
                    Disconnect
                Case &HC
                    BotEvent bKey, evAbort, "Username contains too many punctuation characters."
                    Disconnect
                Case Else
                    BotEvent bKey, evAbort, "Unknown account creation error."
                    Disconnect
            End Select
        Case SID_LOGONRESPONSE2
            lngWork = P.GetDWORD()
            Select Case lngWork
                Case &H0
                    BotEvent bKey, evSuccess, "Username and password accepted."
                    If UseRealm Then
                        S.Send "", SID_REALMINIT
                    Else
                        EnterChat
                    End If
                Case &H1
                    BotEvent bKey, evConError, "Account does not exist."
                    If (MsgBox("The account you have attempted to connect with does not exist.  Would you like to create it?", _
                        vbQuestion Or vbYesNo, GetVersion(mvTitlebar)) = vbYes) Then
                        If UseBNLS Then
                            CreatingAccount = True
                            With o
                                .InsertDWORD Len(Password) 'Length of password
                                .InsertDWORD &H0
                                .InsertNonNTString LCase$(Password)
                                BNLS.Send .GetData(), BNLS_HASHDATA
                            End With
                        Else
                            strTMP = hashPassword(Password)
                            'strTmp = String$(20, vbNullChar)
                            'CalcHashBuf strTmp, LCase$(Password), Len(Password)
                            With o
                                .InsertNonNTString strTMP
                                .InsertString Username
                                S.Send .GetData(), SID_CREATEACCOUNT2
                            End With
                        End If
                    End If
                Case &H2
                    BotEvent bKey, evError, "Invalid or incorrect password."
                    BotEvent bKey, evWrongPassword
                    'Disconnect
            End Select
        Case SID_REALMINIT
            If Len(Realm) = 0 Then
                With P
                    .Skip 12
                    Realm = .GetString()
                End With
            End If
            'strTmp = String$(20, vbNullChar)
            'Call GetPasswordHash(strTmp, ServerSession, "password")
            'CalcHashBuf ByVal strTmp, ByVal "password", 8
            'AddC StrToHex(strTmp), vbWhite
            'CalcHashBuf ByVal strTmp, ByVal MakeDWORD(ClientSession) & _
                MakeDWORD(ServerSession) & strTmp, 28
            'AddC StrToHex(strTmp), vbWhite
            strTMP = RealmPassword()
            With o
                .InsertDWORD ClientSession
                .InsertNonNTString strTMP
                .InsertString Realm
                S.Send .GetData(), SID_LOGONREALMEX
            End With
        Case SID_LOGONREALMEX
            'uff da!
            HandleRealmLogon Data
            'Dim MCPIP As Long, MCPPort As Integer
            'With p
            '    .Skip 4
            '    lngWork = .GetDWORD()
            '    Select Case lngWork
            '        Case &H80000001
            '            AddC "Realm is currently unavailable.", vbRed
            '            EnterChat
            '            Exit Sub
            '        Case &H80000002
            '            AddC "Realm password was rejected.", vbRed
            '            EnterChat
            '            Exit Sub
            '    End Select
            '    .Skip -8
            '    AddC Len(MCPChunk)
            '    MCPChunk = .GetFixedString(16)
            '    MCPIP = .GetDWORD()
            '    MCPPort = PackPort(.GetDWORD())
            '    AddC Len(MCPChunk)
            '    MCPChunk = MCPChunk & .GetFixedString(48)
            '    AddC Len(MCPChunk)
            '    AddC StrToHex(MCPChunk)
            '    RUniqueUsername = .GetString()
            '    ConnectToRealm MCPIP, MCPPort
            'End With
        Case SID_CREATEACCOUNT2
            CreatingAccount = False
            lngWork = P.GetDWORD()
            Select Case lngWork
                Case 0:
                    BotEvent bKey, evSuccess, "Account created."
                    With o
                        .InsertDWORD ClientSession
                        .InsertDWORD ServerSession
                        .InsertNonNTString PasswordHash 'Hash Data
                        .InsertNTString Username
                        S.Send .GetData(), SID_LOGONRESPONSE2
                    End With
                    'Hash password (yeah, again) to be used in logging in.
                    'With O
                    '    .InsertDWORD Len(Password) 'Length of password
                    '    .InsertDWORD &H0
                    '    .InsertNonNTString LCase$(Password)
                    '    BNLS.Send .GetData(), BNLS_HASHDATA
                    'End With
                Case 1, 6:
                    BotEvent bKey, evAbort, "The username " & Username & " is too short."
                    Disconnect
                Case 2:
                    BotEvent bKey, evAbort, "The username " & Username & " contains invalid characters."
                    Disconnect
                Case 3:
                    BotEvent bKey, evAbort, "The username " & Username & " contains a banned word."
                    Disconnect
                Case 4:
                    BotEvent bKey, evAbort, "The username " & Username & " already exists."
                    Disconnect
                Case Else:
                    BotEvent bKey, evAbort, "Unknown result code on account creation."
                    Disconnect
            End Select
        Case SID_ENTERCHAT
            RealUsername = P.GetString()
            BotEvent bKey, evConMsg, "Logged on as " & RealUsername & "."
            'If LenB(Home) = 0 Then Home = "Public Chat " & DEFAULT_REGISTER
            'With O
            '    .InsertDWORD &H0
            '    .InsertString Home
            '    S.Send .GetData(), SID_JOINCHANNEL
        
        'End With

        Case SID_CHATEVENT
            With P
                eID = .GetDWORD()
                eFlags = .GetDWORD()
                ePing = .GetDWORD()
                .Skip 12
                eUser = .GetString()
                eMsg = .GetString()
            End With
            Select Case eID
                Case EID_TALK
                    'If CollectionHasKey(SpamUsers, eUser) = False And _
                        GetTickCount() - ChannelUsers(eUser).JoinTime > 100 Then
                            BotEvent bKey, evTalk, eMsg, eUser, eFlags, ePing
                    'Else
                    '    AddC "!", vbWhite
                    '    SpamUsers.Add eUser, eUser
                    '    ChannelUsers.Remove eUser
                    '    NotifyUserMove bKey, eID
                    'End If
                Case EID_SHOWUSER
                    'If CollectionHasKey(SpamUsers, eUser) Then Exit Sub
                    If Client = bpDiablo2 Or Client = bpDiablo2x Then
                        eUserK = ExtractD2Username(eUser)
                    Else
                        eUserK = eUser
                    End If
                    'AddC "EID_SHOWUSER: " & eUser
                    CUAdd eUserK, ClientStrToKey(StrReverse(Left$(eMsg, 4))), _
                        eFlags, ePing
                    UpdateLocation bKey, Channel, UsersInChannel
                    'NotifyUserMove bKey, EID_SHOWUSER
                    BotEvent bKey, evUser, StrReverse(Left$(eMsg, 4)), _
                        eUser, eFlags, ePing
                Case EID_JOIN
                    'AddC GetTickCount() - ChannelUsers(eUser).JoinTime & "ms", vbWhite
                    'If CollectionHasKey(SpamUsers, eUser) Then Exit Sub
                    If Client = bpDiablo2 Or Client = bpDiablo2x Then
                        eUserK = ExtractD2Username(eUser)
                    Else
                        eUserK = eUser
                    End If
                    CUAdd eUserK, ClientStrToKey(StrReverse(Left$(eMsg, 4))), _
                        eFlags, ePing
                    UpdateLocation bKey, Channel, UsersInChannel
                    'NotifyUserMove bKey, EID_JOIN
                    BotEvent bKey, evJoin, StrReverse(Left$(eMsg, 4)), _
                        eUser, eFlags, ePing
                Case EID_USERFLAGS
                    'AddC "Recieved flag update for " & eUser & ".", vbWhite
                    'If CollectionHasKey(SpamUsers, eUser) Then Exit Sub
                    'If eUser = "DaRK.Cloak.KoG" Then
                    '    i = 0
                    'End If
                    If Client = bpDiablo2 Or Client = bpDiablo2x Then
                        eUserK = ExtractD2Username(eUser)
                    Else
                        eUserK = eUser
                    End If
                    
                    'If CollectionHasKey(ChannelUsers, eUserK) Then
                    '    ChannelUsers(eUserK).Flags = eFlags
                    '    If eFlags And USER_CHANNELOP Then
                    '        ChannelUsers(eUserK).IsOperator = True
                    '    Else
                    '        ChannelUsers(eUserK).IsOperator = False
                    '    End If
                    'Else
                        CUAdd eUserK, ClientStrToKey(StrReverse(Left$(eMsg, 4))), _
                        eFlags, ePing
                    'End If
                    'NotifyUserMove bKey, EID_USERFLAGS
                    If Channel = "The Void" Then
                        UpdateLocation bKey, Channel, UsersInChannel
                        BotEvent bKey, evUser, StrReverse(Left$(eMsg, 4)), _
                            eUser, eFlags, ePing
                    Else
                        'If (eFlags And USER_CHANNELOP) = USER_CHANNELOP Then _
                            BotEvent bKey, evGetOps, , eUser, eFlags
                        If (eUserK = RealUsername) And (eFlags And USER_CHANNELOP) = USER_CHANNELOP Then _
                            HasOps = True
                        BotEvent bKey, evUserFlags, StrReverse(Left$(eMsg, 4)), _
                            eUser, eFlags, ePing
                    End If
                Case EID_LEAVE
                    'AddC GetTickCount() - ChannelUsers(eUser).JoinTime & "ms", vbWhite
                    'If CollectionHasKey(SpamUsers, eUser) Then Exit Sub
                    'If GetTickCount() - ChannelUsers(eUser).JoinTime <= 100 Then
                    '    AddC "!", vbWhite
                    '    SpamUsers.Add eUser, eUser
                    '    ChannelUsers.Remove eUser
                    '    NotifyUserMove bKey, eID
                    '    Exit Sub
                    'End If
                    If Client = bpDiablo2 Or Client = bpDiablo2x Then
                        ChannelUsers.Remove ExtractD2Username(eUser)
                    Else
                        ChannelUsers.Remove eUser
                    End If
                    UpdateLocation bKey, Channel, UsersInChannel
                    BotEvent bKey, evPart, , eUser
                    'NotifyUserMove bKey, EID_LEAVE
                Case EID_CHANNEL
                    LastChannel = Channel
                    Channel = eMsg
                    If Channel = "The Void" Then
                        If Client = bpDiablo2 Or Client = bpDiablo2x Then
                             Say "/unsquelch *" & RealUsername
                        Else
                            Say "/unsquelch " & RealUsername
                        End If
                    End If
                    Set ChannelUsers = New Collection
                    HasOps = False
                    If HasJoinedChannel Then
                        If (LastChannel = Channel And UserClan.DDPInProgress) Then _
                            UserClan.DDPRestore
                        BotEvent bKey, evJoinedChannel, eMsg, , eFlags, 0
                    Else
                        HasJoinedChannel = True
                        BotEvent bKey, evJoinedChannel, eMsg, , eFlags, 1
                    End If
                    UpdateLocation bKey, eMsg, 0
                Case EID_EMOTE
                    'AddC GetTickCount() - ChannelUsers(eUser).JoinTime & "ms", vbWhite
                    'If CollectionHasKey(SpamUsers, eUser) = False And _
                        GetTickCount() - ChannelUsers(eUser).JoinTime > 100 Then
                            BotEvent bKey, evEmote, eMsg, eUser, eFlags
                    'Else
                    '    AddC "!", vbWhite
                    '    SpamUsers.Add eUser, eUser
                    '    ChannelUsers.Remove eUser
                    '    NotifyUserMove bKey, eID
                    'End If
                Case EID_INFO
                    If TriggerHappy And Left$(eMsg, 8) <> "Users in" Then
                        Dim aWork() As String
                            aWork = Split(eMsg, ", ")
                            For lngWork = 0 To UBound(aWork)
                                EventBuffer = EventBuffer & aWork(lngWork) & vbNullChar
                            Next lngWork
                    Else
                        If LenB(eMsg) > 0 Then _
                            BotEvent bKey, evInfo, eMsg
                    End If
                Case EID_ERROR
                    If LenB(eMsg) > 0 Then _
                        BotEvent bKey, evError, eMsg
                Case EID_WHISPER
                    BotEvent bKey, evWhisperRecv, eMsg, eUser
                Case EID_WHISPERSENT
                    BotEvent bKey, evWhisperSend, eMsg, eUser
                Case EID_BROADCAST
                    BotEvent bKey, evBroadcast, eMsg, eUser
            End Select
        Case SID_MESSAGEBOX
            With P
                lngWork = .GetDWORD()
                'MsgBox .GetString(), lngWork, .GetString()
            End With
        Case SID_READUSERDATA
            If RequestingStats Then
                'BotEvent bKey, evConMsg, "Recieved account stastics."
                RequestingStats = False
                Dim ftTmp As Filetime, stTmp As SYSTEMTIME
                With P
                    'BotEvent bKey, evDbg, StrToHex(Data)
                    lngWork = .GetDWORD()
                    lngWork = .GetDWORD()
                    lngWork = .GetDWORD()
                    'BotEvent bKey, evDbg, lngWork
                    'strTmp = .GetString()
                    'strTmp = .GetString() 'Account created
                    'BotEvent bKey, evConMsg, strTmp
                    'ftTmp = StringToFiletime(strTmp)
                    'CopyMemory ftTmp, ByVal strTmp, 8
                    FileTimeToSystemTime StringToFiletime(.GetString()), stTmp
                    BotEvent bKey, evInfo, "Account Created: " & _
                        ProcessSystemTime(stTmp)
                    'strTmp = .GetString() 'Last login
                    'ftTmp = StringToFiletime(strTmp)
                    'CopyMemory ftTmp, ByVal strTmp, 8
                    FileTimeToSystemTime StringToFiletime(.GetString()), stTmp
                    BotEvent bKey, evInfo, "Last Logged In: " & _
                        ProcessSystemTime(stTmp)
                    'strTmp = .GetString() 'Last logout
                    'ftTmp = StringToFiletime(strTmp)
                    'CopyMemory ftTmp, ByVal strTmp, 8
                    FileTimeToSystemTime StringToFiletime(.GetString()), stTmp
                    BotEvent bKey, evInfo, "Last Logged Out: " & _
                        ProcessSystemTime(stTmp)
                    'strTmp = .GetString() 'Time logged
                    BotEvent bKey, evInfo, "Time Logged: " & _
                        ProcessInterval(.GetString())
                End With
            Else
                With P
                    .Skip 4
                    lngWork = .GetDWORD()
                    lngWork2 = .GetDWORD()
                End With
                With PendingProfileRequests(lngWork2)
                    ProfileReceived bKey, .User, .Keys, P.GetStringArray(lngWork)
                End With
            End If
        Case SID_CLANMEMBERUPDATE
            HandleMemberUpdate P
            'Parse0x7F Data
        Case SID_CLANMEMBERLIST
            HandleMemberList P
            'Parse0x7D Data
        Case SID_CLANMEMBERREMOVED
            HandleMemberRemoved P
        Case SID_CLANINFO
            With P
                .Skip 1
                strTMP = StrReverse(.GetFixedString(4))
                Do While Right$(strTMP, 1) = vbNullChar
                    strTMP = Left$(strTMP, (Len(strTMP) - 1))
                Loop
                UserClan.Active = True
                UserClan.Tag = strTMP
                UserClan.RequestMOTD
                BotEvent bKey, evInfo, ClanInfo(strTMP, .GetByte())
            End With
            With o
                .InsertDWORD &HDEADBEEF 'Cookie
                S.Send .GetData(), SID_CLANMEMBERLIST
            End With
        Case SID_FINDCLANCANDIDATES
            With P
                .Skip 4
                FCStatus = .GetByte()
                bytTmp = .GetByte()
                ClanCandidates = .GetStringArray(bytTmp)
            End With
            UserClan.CandidateResult CLng(FCStatus), CLng(bytTmp), ClanCandidates
        Case SID_INVITEMULTIPLEUSERS
            UserClan.ClanCreated
        Case SID_AUTH_REGISTEREMAIL
            BotEvent bKey, evRegisterEmail, , Username
        Case SID_CLANSENDINVITE
            With P
                lngWork2 = .GetDWORD()
                lngWork = .GetDWORD()
                strTMP = String$(4, Chr$(0))
                CopyMemory ByVal strTMP, lngWork, 4
                strTMP = StrReverse(Replace(strTMP, vbNullChar, ""))
                InvitedToClan bKey, lngWork2, lngWork, strTMP, .GetString(), .GetString()
            End With
        Case SID_CLANREQUEST
            HandleInvitationResponse P
        Case SID_CLANMOTD
            HandleClanMOTD P
        Case SID_CLANREMOVEMEMBER
            HandleMemberRemoval P
        Case SID_CLANMAKECHIEFTAIN
            HandleChieftainChange P
        Case SID_CLANRANKUPDATE
            HandleRankChange P
        Case SID_CLANDISBAND
            HandleClanDisband P
        Case SID_GETADVLISTEX
            On Error GoTo BND_Error
            lngWork = P.GetDWORD()
            'AddC "Got game list! " & lngWork & " games.", vbWhite
            If lngWork > 0 Then
                Dim dgl As New frmGameList
                For j = 1 To lngWork
                    On Error GoTo BND_Error
                    With P
                        Set cWork = New Collection
                        cWork.Add .GetWORD(), "type"
                        .Skip 8
                        cWork.Add ntohs(.GetWORD()), "port"
                        'AddC cWork("port")
                        cWork.Add IPToString(.GetDWORD()), "ip"
                        .Skip 16
                        cWork.Add UTF8Decode(.GetString()), "name"
                        'AddC cWork("name"), vbWhite
                        'AddC cWork("ip"), vbWhite
                        'AddC cWork("port"), vbWhite
                        'AddC cWork("type"), vbWhite
                        dgl.AddGame cWork("name"), .GetString(), cWork("type"), _
                            cWork("ip"), cWork("port")
                        strTMP = .GetString()
                        Set cWork = Nothing
                    End With
                Next j
                dgl.Show
            End If
        Case SID_NULL
        Case &H4A
        'one sec (just remember to save b4 you try to run)
        Case Else
            Dim PIS As String * 1
            CopyMemory ByVal PIS, PacketID, 1
            'BotEvent bKey, evInfo, "Recieved unhandled packet 0x" & LTrim$(StrToHex(PIS)) & ".  " & StrToHex(Data)
    End Select
    Exit Sub
BND_Error:
    If Err.Number = P.EOPError Then
        MsgBox "Trying to read beyond end of packet.", vbExclamation
        BotEvent bKey, evDbg, "Trying to read beyond end of packet; assuming packet was fragmented."
        'BNOD = Data
        'BNOL = Length
    Else
        BotEvent bKey, evConError, "[BNet PP] " & Err.Description & " (#" & Err.Number & ") " & Err.Source
        Resume Next
    End If
End Sub

Private Sub HandleMemberList(P As Packet)
    Dim Cookie As Long
    Dim i As Long
    Dim MemberCount As Long
    Dim Member As ClanMember
    
    With P
        Cookie = .GetDWORD()
        MemberCount = CLng(.GetByte())
        
        For i = 0 To (MemberCount - 1)
            Set Member = New ClanMember
            Member.Username = .GetString()
            Member.Rank = .GetByte()
            If (.GetByte()) Then
                Member.Online = True
            Else
                Member.Online = False
            End If
            .Skip 1
            If (Not UserClan.AddMember(Member)) Then
                BotEvent bKey, evError, "Failed to add clan member " & _
                    Member.Username & " to internal storage."
            End If
        Next i
    End With
    
    If Not (AutoClan Is Nothing) Then
        AutoClan.ScanChannel Me
    End If
End Sub

Private Sub HandleMemberUpdate(P As Packet)
    Dim Member As ClanMember
    
    UserClan.MemberChanged P.GetString(), CLng(P.GetByte()), CBool(P.GetByte())
End Sub

Private Sub HandleMemberRemoved(P As Packet)
    UserClan.MemberRemoved P.GetString()
End Sub

Public Sub LogIn()
    Dim o As Packet, Data As String, DataLen As Long
    Set o = New Packet
    With o
        If UseNLS Then
            If UseBNLS Then
                .InsertString Username
                .InsertString LCase$(Password)
                BNLS.Send .GetData(), BNLS_LOGONCHALLENGE
            Else
                NLS = nls_init(Username, Password)
                If (NLS = 0) Then
                    BotEvent bKey, evAbort, "Failed to initialize NLS handler."
                    Disconnect
                    Exit Sub
                End If
                'DataLen = Len(Username) + 33
                'Data = String$(DataLen, vbNullChar)
                'If (nls_account_logon(NLS, Data, DataLen) = 0) Then
                '    BotEvent bKey, evAbort, "Failed to generate logon packet."
                '    Disconnect
                '    Exit Sub
                'End If
                Data = String$(32, vbNullChar)
                Call nls_get_A(NLS, Data)
                .InsertNonNTString Data
                .InsertString Username
                S.Send .GetData(), SID_AUTH_ACCOUNTLOGON
            End If
        Else
            If UseBNLS Then
                .InsertDWORD Len(Password) 'Length of password
                .InsertDWORD &H2 'Double-hash flag
                .InsertNonNTString LCase$(Password)
                .InsertDWORD ClientSession
                .InsertDWORD ServerSession
                BNLS.Send .GetData(), BNLS_HASHDATA
            Else
                'PasswordHash = String$(28, vbNullChar)
                'If (PasswordHashEx(PasswordHash, ClientSession, ServerSession, _
                    Password)) Then
                '    AddC StrToHex(PasswordHash)
                '    AddC LngToHex(ClientSession)
                '    AddC LngToHex(ServerSession)
                '    AddC StrToHex(Mid$(PasswordHash, 9))
                PasswordHash = doubleHashPassword(LCase$(Password), ClientSession, ServerSession)
                If (LenB(PasswordHash)) Then
                    .InsertDWORD ClientSession
                    .InsertDWORD ServerSession
                    .InsertNonNTString PasswordHash
                    .InsertString Username
                    S.Send .GetData(), SID_LOGONRESPONSE2
                Else
                    BotEvent bKey, evAbort, "Failed to hash your password."
                    Disconnect
                    Exit Sub
                End If
            End If
        End If
    End With
End Sub

Public Sub WriteProfile(Keys() As String, Values() As String)
    Dim P As Packet
    Set P = New Packet
    
    With P
        .InsertDWORD 1
        .InsertDWORD (UBound(Keys) - LBound(Keys)) + 1
        .InsertString Username
        .InsertStringArray Keys
        .InsertStringArray Values
        S.Send .GetData(), SID_WRITEUSERDATA
    End With
End Sub

Public Sub HandleRealmLogon(Data As String)
    Dim P As Packet, TempData() As Long, i&
    Set P = New Packet
    
    With P
        .SetData Data
        TempData = .GetDWORDArray(18)
        Select Case TempData(1)
            Case &H80000001
                AddC "Realm is currently unavailable.", vbRed
                EnterChat
                Exit Sub
            Case &H80000002
                AddC "Realm password was rejected.", vbRed
                EnterChat
                Exit Sub
        End Select
        RUniqueUsername = .GetString()
    End With
    For i = 0 To 3
        MCPChunk(i) = TempData(i)
    Next i
    
    For i = 4 To 15
        MCPChunk(i) = TempData(i + 2)
    Next i
    'AddC LngToHex(TempData(4))
    ConnectToRealm TempData(4), PackPort(TempData(5))
    'AddC IPToString(TempData(4)) & ":" & htons(PackPort(TempData(5)))
End Sub

Public Sub RequestProfile(ByVal Username As String, Keys() As String)
On Error GoTo RP_Error
    Dim rKey&, P As Packet, i&, RequestsEmpty As Boolean
    rKey = UBound(PendingProfileRequests) + 1
    If RequestsEmpty = True Then
        rKey = 0
        ReDim PendingProfileRequests(0) As RequestInfo
    Else
        ReDim Preserve PendingProfileRequests(rKey) As RequestInfo
    End If
    With PendingProfileRequests(rKey)
        .Keys = Keys
        .User = Username
    End With

    Set P = New Packet
    
    With P
        .InsertDWORD 1
        'AddC "Requesting: " & ((UBound(Keys) - LBound(Keys)) + 1) & " keys."
        .InsertDWORD (UBound(Keys) - LBound(Keys)) + 1
        .InsertDWORD rKey
        .InsertString Username
        .InsertStringArray Keys
        S.Send .GetData(), SID_READUSERDATA
    End With
    Exit Sub
RP_Error:
    If Err.Number = 9 Then
        RequestsEmpty = True
        Resume Next
    Else
        BotEvent bKey, evConError, Err.Description
    End If
    'On Error GoTo 0
End Sub

'Public Sub WriteProfile(Keys() As String, Values() As String)
'    Dim P As Packet
'    Set P = New Packet
'
'    With P
'        .InsertDWORD 1
'        .InsertDWORD (UBound(Keys) - LBound(Keys)) + 1
'        .InsertString Username
'        .InsertStringArray Keys
'        .InsertStringArray Values
'        S.Send .GetData(), SID_WRITEUSERDATA
'    End With
'End Sub

Public Sub SendAuthCheck()
    'Hashed connections only.
    Dim P As Packet
    Dim eVersion As Long, Checksum As Long, EXEInfo As String
    Dim MPQFile As Long
    Dim D&, KeyHash As String, HashSize As Long, _
        XD&, ExpHash As String, ExpHashSize As Long, _
        Product As Long, Val1 As Long, ExpVal1 As Long, _
        ExpProduct As Long
    
    ClientSession = GetTickCount()
    BotEvent bKey, evDbg, "Entered SendAuthCheck()."
    DoEvents
    
    Set P = New Packet
    BotEvent bKey, evDbg, "Create CD-key decoder..."
    D = kd_create(cdkey, Len(cdkey))
    If (D < 0) Then
        BotEvent bKey, evAbort, "Your CD-key is invalid."
        Disconnect
        Exit Sub
    End If
    BotEvent bKey, evDbg, "Created.  Calculating hash..."
    HashSize = kd_calculateHash(D, ClientSession, ServerSession)
    If (HashSize <= 0) Then
        BotEvent bKey, evAbort, "Failed to hash your CD-key. (" & D & ") (" & HashSize & ")"
        'kd_free D
        Disconnect
        Exit Sub
    End If
    BotEvent bKey, evDbg, "Calculated.  Retrieving hash..."
    KeyHash = String$(HashSize, vbNullChar)
    kd_getHash D, KeyHash
    BotEvent bKey, evDbg, "Retrieved hash."
    Val1 = kd_val1(D)
    Product = kd_product(D)
    BotEvent bKey, evDbg, "Retrieved value.  Freeing decoder..."
    
    kd_free D
    BotEvent bKey, evDbg, "Decoder freed."
    
    If Client = bpDiablo2x Or Client = bpWarCraft3x Then
        XD = kd_create(ExCDKey, Len(ExCDKey))
        If (XD < 0) Then
            BotEvent bKey, evAbort, "Your expansion CD-key is invalid."
            Disconnect
            Exit Sub
        End If
        
        HashSize = kd_calculateHash(XD, ClientSession, ServerSession)
        If (HashSize <= 0) Then
            BotEvent bKey, evAbort, "Failed to hash your expansion CD-key."
            Disconnect
            Exit Sub
        End If
        
        ExpHash = String$(HashSize, vbNullChar)
        ExpVal1 = kd_val1(D)
        ExpProduct = kd_product(D)
        kd_getHash XD, ExpHash
        kd_free XD
    End If
    
    MPQFile = extractMPQNumber(IX86File)
    If MPQFile < 0 Then
        BotEvent bKey, evAbort, "Unrecognized MPQ file.  Connection aborted."
        Disconnect
        Exit Sub
    End If
    
    If Not checkRevision(ChecksumFormula, Hash1, Hash2, Hash3, MPQFile, Checksum) Then
        BotEvent bKey, evAbort, "Failed to hash the ""hash files"".  Connection aborted."
        Disconnect
        Exit Sub
    End If
    
    eVersion = getExeInfo(Hash1, EXEInfo)
    If (eVersion = 0) Then
        BotEvent bKey, evAbort, "Failed to retrieve information for the file """ & Hash1 & """. " & _
            "Connection aborted."
        Disconnect
        Exit Sub
    End If
    
    P.InsertDWORD ClientSession
    P.InsertDWORD eVersion
    P.InsertDWORD Checksum
    If Client = bpDiablo2x Or Client = bpWarCraft3x Then
        P.InsertDWORD 2
    Else
        P.InsertDWORD 1
    End If
    P.InsertDWORD 0 'no spawn
    P.InsertDWORD Len(cdkey)
    P.InsertDWORD Product
    P.InsertDWORD Val1
    P.InsertDWORD 0
    P.InsertNonNTString KeyHash
    If Client = bpDiablo2x Or Client = bpWarCraft3x Then
        P.InsertDWORD Len(ExCDKey)
        P.InsertDWORD ExpProduct
        P.InsertDWORD ExpVal1
        P.InsertDWORD 0
        P.InsertNonNTString ExpHash
    End If
    P.InsertString EXEInfo
    If LenB(Register) = 0 Then
        'no register
        P.InsertString DEFAULT_REGISTER
    Else
        P.InsertString Register
    End If
    S.Send P.GetData(), SID_AUTH_CHECK
End Sub

Private Sub NullTruncateString(nString As String)
    Dim i&
    i = InStr(nString, vbNullChar)
    If i = 0 Then Exit Sub
    
    nString = Left$(nString, i - 1)
End Sub

Private Function RealmPassword(Optional ByVal rPassword As String = "password") As String
    Dim strTMP As String * 20, strTmp2 As String * 20
    calcHashBuf ByVal strTMP, ByVal rPassword, Len(rPassword)
    calcHashBuf ByVal strTmp2, ByVal MakeDWORD(ClientSession) & _
        MakeDWORD(ServerSession) & strTMP, 28
    RealmPassword = strTmp2
    'strTmp = String$(20, vbNullChar)
    'Call GetPasswordHash(strTmp, ServerSession, "password")
    'CalcHashBuf ByVal strTmp, ByVal "password", 8
    'AddC StrToHex(strTmp), vbWhite
    'CalcHashBuf ByVal strTmp, ByVal MakeDWORD(ClientSession) & _
        MakeDWORD(ServerSession) & strTmp, 28
    'AddC StrToHex(strTmp), vbWhite
End Function

Private Function PackPort(Port As Long) As Integer
    Dim intWork As Integer
    intWork = 0
    CopyMemory intWork, Port, 2
    PackPort = intWork
End Function

Private Function MakeDWORD(Data As Long) As String
    Dim Result As String * 4
    CopyMemory ByVal Result, Data, 4
    MakeDWORD = Result
End Function

Public Sub RegisterEmail(ByVal EMail As String)
    Dim P As Packet
    Set P = New Packet
    With P
        .InsertString EMail
        S.Send .GetData(), SID_AUTH_REGISTEREMAIL
    End With
    EnterChat
End Sub

Public Sub RecoverPassword(ByVal EMail As String)
    Dim P As Packet
    Set P = New Packet
    With P
        .InsertString Username
        .InsertString EMail
        S.Send .GetData(), SID_AUTH_RECOVERACCT
    End With
End Sub

Private Function ConnectToRealm(Server As Long, Port As Integer) As Boolean
    Set MCP = New Arbiter
    Dim tR%
    ConnectToRealm = False
    tR = frmMain.txtRecv.Count
    Load frmMain.txtRecv(tR)
    If MCP.Initialize(frmMain.txtRecv(tR).hwnd, bKey, sMCP) Then
        BotEvent bKey, evRealmConnecting, Server
        If MCP.ConnectRaw(Server, Port) = False Then
            BotEvent bKey, evConError, "Could not connect to the realm."
            EnterChat
        Else
            ConnectToRealm = True
        End If
    Else
        BotEvent bKey, evConError, "Could not initialize MCP (realm) socket."
        EnterChat
    End If
End Function

Private Sub MCPStart()
    Dim P As New Packet
    With P
        .InsertDWORDArray MCPChunk
        .InsertString RUniqueUsername
        MCP.Send .GetData(), MCP_STARTUP
    End With
End Sub

Private Sub MCPData(Data As String, Length As Long)
    Dim P As New Packet, o As New Packet, pLen&, Pos&, PacketID As Byte, lngWork&
    P.SetData Data
    While (Pos < Length)
        With P
            pLen = .GetWORD()
            PacketID = .GetByte()
        End With
        Select Case PacketID
            Case MCP_STARTUP
                lngWork = P.GetDWORD()
                Select Case lngWork
                    Case &H0
                        BotEvent bKey, evRealmStarted
                    Case &HC
                        BotEvent bKey, evRealmStartFailure, "The realm could not find your Battle.Net connection."
                        EnterChat
                    Case Else
                        BotEvent bKey, evRealmStartFailure, "Unknown realm startup failure."
                        EnterChat
                End Select
        End Select
        
        With P
            If .Position < pLen Then _
                .Skip pLen - .Position + 1
            Pos = Pos + .Position
        End With
    Wend
End Sub

Private Function UTF8Encode(Str As String) As String
    Dim InputChars As Long
    InputChars = Len(Str)
   
    'We need to first convert the ASCII input to Unicode before we can convert it to UTF-8...
    Dim UnicodeChars As Long, UnicodeBuffer As String
    UnicodeChars = MultiByteToWideChar(CP_ACP, 0, Str, InputChars, vbNullString, 0)
    UnicodeBuffer = Space(UnicodeChars * 2)
    MultiByteToWideChar CP_ACP, 0, Str, InputChars, UnicodeBuffer, UnicodeChars
   
    'Now that we've got everything translated to Unicode, we can (finally) convert it to UTF-8.
    Dim UTF8Chars As Long, UTF8Buffer As String
    UTF8Chars = WideCharToMultiByte(CP_UTF8, 0, UnicodeBuffer, UnicodeChars, 0, 0, vbNullString, 0)
    UTF8Buffer = Space(UTF8Chars)
    WideCharToMultiByte CP_UTF8, 0, UnicodeBuffer, UnicodeChars, UTF8Buffer, UTF8Chars, vbNullString, 0
   
    UTF8Encode = UTF8Buffer
End Function

Private Function UTF8Decode(Str As String) As String
    Dim InputBytes As Long
    InputBytes = Len(Str)
   
    'Again, we need to convert the UTF-8 string to Unicode before we can convert it to 8-bit.
    Dim UnicodeChars As Long, UnicodeBuffer As String
    UnicodeChars = MultiByteToWideChar(CP_UTF8, 0, Str, InputBytes, vbNullString, 0)
    UnicodeBuffer = Space(UnicodeChars * 2)
    MultiByteToWideChar CP_UTF8, 0, Str, InputBytes, UnicodeBuffer, UnicodeChars
   
    'Now that we've got everything translated to Unicode, we can convert it to 8-bit characters.
    Dim SingleByteChars As Long, SingleByteBuffer As String
    SingleByteChars = WideCharToMultiByte(CP_ACP, 0, UnicodeBuffer, UnicodeChars, vbNullString, 0, vbNullString, 0)
    SingleByteBuffer = Space(SingleByteChars)
    WideCharToMultiByte CP_ACP, 0, UnicodeBuffer, UnicodeChars, SingleByteBuffer, SingleByteChars, vbNullString, 0
   
    UTF8Decode = SingleByteBuffer
End Function

Public Sub RequestGameList()
    If Client <> bpStarCraft And Client <> bpBroodWar Then Exit Sub
    Dim P As New Packet
    With P
        .InsertWORD 0
        .InsertWORD 0
        .InsertDWORD 48
        .InsertDWORD 0
        .InsertDWORD 25
        .InsertByte 0
        .InsertByte 0
        .InsertByte 0
        S.Send .GetData(), SID_GETADVLISTEX
    End With
End Sub

Public Sub BinaryRejoin()
    If TalkOK Then
        Dim P As New Packet
        With P
            S.Send "", &H10
            .InsertDWORD 2
            .InsertString Channel
            S.Send .GetData(), SID_JOINCHANNEL
        End With
    End If
End Sub
Public Sub WC3Promote(Username As String, Rank As String)
Dim P As New Packet
With P
    .InsertDWORD &HB
    .InsertNTString Username
    If Rank = "shaman" Then .InsertByte &H3
    If Rank = "grunt" Then .InsertByte &H2
    S.Send .GetData(), &H7A
    .InsertDWORD &H0
    .InsertDWORD &H0
    .InsertDWORD &H0
    .InsertDWORD &H0
    S.Send .GetData(), &H15
        End With
End Sub

Public Sub InviteToClan(Username As String, Optional ByVal Cookie As Long = 0)
    Dim P As Packet
    Set P = New Packet
    
    With P
        .InsertDWORD Cookie
        .InsertString Username
        S.Send .GetData(), SID_CLANREQUEST
    End With
End Sub

Public Sub HandleInvitationResponse(P As Packet)
    Dim Cookie As Long
    Dim Result As Long
    Dim CStatus As InvitationStatus
    
    Cookie = P.GetDWORD()
    Result = CLng(P.GetByte())
    
    Select Case Result
        Case 0: CStatus = isAccepted
        Case 4: CStatus = isDeclined
        Case 5: CStatus = isFailed
        Case 9: CStatus = isClanFull
    End Select
    
    UserClan.InvitationResponse Cookie, CStatus
End Sub

Public Sub RemoveClanMember(Username As String, Optional ByVal Cookie As Long = 0)
    Dim P As Packet
    Set P = New Packet
    
    With P
        .InsertDWORD Cookie
        .InsertString Username
        S.Send .GetData(), SID_CLANREMOVEMEMBER
    End With
End Sub

Public Sub HandleMemberRemoval(P As Packet)
    UserClan.ActionResponse P.GetDWORD(), P.GetByte()
End Sub

Public Sub ChangeMemberRank(Username As String, ByVal NewRank As Long, Optional ByVal Cookie As Long = 0)
    Dim P As Packet
    Set P = New Packet
    
    With P
        .InsertDWORD Cookie
        .InsertString Username
        .InsertByte CByte(NewRank)
        S.Send .GetData(), SID_CLANRANKUPDATE
    End With
End Sub

Public Sub HandleRankChange(P As Packet)
    UserClan.ActionResponse P.GetDWORD(), P.GetByte()
End Sub

Public Sub ChangeChieftain(Username As String, Optional ByVal Cookie As Long = 0)
    Dim P As Packet
    Set P = New Packet
    
    With P
        .InsertDWORD Cookie
        .InsertString Username
        S.Send .GetData(), SID_CLANMAKECHIEFTAIN
    End With
End Sub

Public Sub HandleChieftainChange(P As Packet)
    UserClan.ActionResponse P.GetDWORD(), P.GetByte()
End Sub

Public Sub DisbandClan(Optional ByVal Cookie As Long = 0)
    Dim P As Packet
    Set P = New Packet
    
    With P
        .InsertDWORD Cookie
        S.Send .GetData(), SID_CLANDISBAND
    End With
End Sub

Public Sub HandleClanDisband(P As Packet)

End Sub

Public Sub SetClanMOTD(Message As String)
    Dim P As Packet
    Set P = New Packet
    
    With P
        .InsertDWORD 0 'Cookie, even though there is no reply packet.
        .InsertString Message
        S.Send .GetData(), SID_CLANSETMOTD
    End With
End Sub

Public Sub RequestClanMOTD()
    Dim P As Packet
    Set P = New Packet
    
    With P
        .InsertDWORD 0 ' Cookie
        
        S.Send .GetData(), SID_CLANMOTD
    End With
End Sub

Public Sub HandleClanMOTD(P As Packet)
    With P
        .Skip 8
        UserClan.MOTD = .GetString()
    End With
End Sub

Public Sub WC3exile(Username As String)
Dim P As New Packet
With P
    .InsertDWORD &H1
    .InsertNTString Username
    SendData S.Sock, P
    'End With
    'Dim L As New Packet
    'With L
    .InsertDWORD &H0
    .InsertDWORD &H0
    .InsertDWORD &H0
    .InsertDWORD &H0
    SendData S.Sock, P
        End With
    End Sub
Public Sub WC3demote(Username As String, Rank As String)
Dim P As New Packet
With P
    .InsertDWORD &H1
    .InsertNTString Username
    If Rank = "peon" Then .InsertByte &H1
    If Rank = "grunt" Then .InsertByte &H2
    S.Send .GetData(), &H7A
    .InsertDWORD &H0
    .InsertDWORD &H0
    .InsertDWORD &H0
    .InsertDWORD &H0
    S.Send .GetData(), &H15
    End With
End Sub
Public Sub ClanInviteAccepted(Cookie&, ClanTag&, Inviter$)
    Dim P As New Packet
    With P
        .InsertDWORD Cookie
        .InsertDWORD ClanTag
        .InsertString Inviter
        .InsertByte &H6
        S.Send .GetData(), SID_CLANSENDINVITE
    End With
End Sub

Public Sub ClanInviteDeclined(Cookie&, ClanTag&, Inviter$)
    Dim P As New Packet
    With P
        .InsertDWORD Cookie
        .InsertDWORD ClanTag
        .InsertString Inviter
        .InsertByte &H4
        S.Send .GetData(), SID_CLANSENDINVITE
    End With
End Sub

Public Function FindClanCandidates(ClanTag As String) As Boolean
    Dim o As New Packet, L&, RT As String * 4
    L = Len(ClanTag)
    Select Case L
        Case 1: RT = vbNullChar & vbNullChar & vbNullChar & ClanTag
        Case 2: RT = vbNullChar & vbNullChar & StrReverse(ClanTag)
        Case 3: RT = vbNullChar & StrReverse(ClanTag)
        Case 4: RT = StrReverse(ClanTag)
        Case Else
            FindClanCandidates = False
            Exit Function
    End Select
    With o
        .InsertDWORD Rand(1, 128000)
        .InsertNonNTString RT
        S.Send .GetData(), SID_FINDCLANCANDIDATES
    End With
    FindClanCandidates = True
End Function

Public Function GetClanCandidates() As String()
    GetClanCandidates = ClanCandidates
End Function

Public Function CreateClan(ClanTag As String, ClanName As String, InitialMembers() As String, _
    ByVal NumberOfMembers As Byte) As Boolean
    ClanCreateSuccess = False
    If Len(ClanName) < 1 Then
        CreateClan = False
        Exit Function
    End If
    
    Dim P As New Packet, L&, RT As String * 4
    L = Len(ClanTag)
    Select Case L
        Case 1: RT = vbNullChar & vbNullChar & vbNullChar & ClanTag
        Case 2: RT = vbNullChar & vbNullChar & StrReverse(ClanTag)
        Case 3: RT = vbNullChar & StrReverse(ClanTag)
        Case 4: RT = StrReverse(ClanTag)
        Case Else
            CreateClan = False
            Exit Function
    End Select
    With P
        .InsertDWORD Rand(1, 64000)
        .InsertString ClanName
        .InsertNonNTString RT
        .InsertByte NumberOfMembers
        .InsertStringArray InitialMembers
        S.Send .GetData(), SID_INVITEMULTIPLEUSERS
    End With
    CreateClan = True
End Function

Private Function ClanInfo(ClanName As String, Rank As Byte, Optional User As String = "") As String
    If LenB(User) = 0 Then
        ClanInfo = "You are "
    Else
        ClanInfo = User & " is "
    End If
    Select Case Rank
        Case RANK_NEW_PEON: ClanInfo = ClanInfo & "a new peon in"
        Case RANK_PEON: ClanInfo = ClanInfo & "a peon in"
        Case RANK_GRUNT: ClanInfo = ClanInfo & "a grunt in"
        Case RANK_SHAMAN: ClanInfo = ClanInfo & "a shaman in"
        Case RANK_CHIEFTAIN: ClanInfo = ClanInfo & "the chieftain of"
    End Select
    ClanInfo = ClanInfo & " Clan " & ClanName & "."
    
    Dim P As New Packet
    With P
    .InsertDWORD &H1
    S.Send .GetData(), &H7D
    End With
    
End Function

Private Function StringToFiletime(T As String) As Filetime
    Dim Frag() As String, FT As Filetime
    'BotEvent bKey, evDbg, "StringToFiletime(""" & T & """)"
    Frag = Split(T, " ")
    If Val(Frag(0)) < 2 ^ 31 Then
        FT.dwHighDateTime = Val(Frag(0))
    Else
        FT.dwHighDateTime = Val(Frag(0)) - 2 ^ 32
    End If
    If UBound(Frag) > 0 Then
        If Val(Frag(1)) < 2 ^ 31 Then
            FT.dwLowDateTime = Val(Frag(1))
        Else
            FT.dwLowDateTime = Val(Frag(1)) - 2 ^ 32
        End If
    End If
    StringToFiletime = FT
End Function

Private Function ProcessInterval(T As String) As String
'<RAGE>On Error Resume Next
    Dim lngSeconds As Long, lngDays As Long, lngHours As Long, lngMins As Long
    'Dim strSeconds As String, strDays As String, strHours As String, strMinutes As String, _
    strXSeconds As String, strXMinutes As String, strXHours As String
    lngSeconds = T
    lngDays = Int(lngSeconds / 86400)
    lngSeconds = lngSeconds Mod 86400
    lngHours = Int(lngSeconds / 3600)
    lngSeconds = lngSeconds Mod 3600
    lngMins = Int(lngSeconds / 60)
    lngSeconds = lngSeconds Mod 60
    If lngDays = 1 Then
        ProcessInterval = "1 day, "
    ElseIf lngDays > 1 Then
        ProcessInterval = lngDays & " days, "
    End If
    If lngHours = 1 Then
        ProcessInterval = ProcessInterval & "1 hour, "
    ElseIf lngHours > 1 Then
        ProcessInterval = ProcessInterval & lngHours & " hours, "
    ElseIf lngHours = 0 And lngDays >= 1 Then
        ProcessInterval = ProcessInterval & "0 hours, "
    End If
    If lngMins = 1 Then
        ProcessInterval = ProcessInterval & "1 minute, "
    ElseIf lngMins > 1 Then
        ProcessInterval = ProcessInterval & lngMins & " minutes, "
    ElseIf lngMins = 0 And lngHours >= 1 Then
        ProcessInterval = ProcessInterval & "0 minutes, "
    End If
    If lngSeconds = 1 Then
        ProcessInterval = ProcessInterval & "1 second"
    ElseIf lngSeconds > 1 Then
        ProcessInterval = ProcessInterval & lngSeconds & " seconds"
    ElseIf lngSeconds = 0 And lngDays >= 1 Then
        ProcessInterval = ProcessInterval & "0 seconds"
    End If
        
    'If lngDays <> 1 Then strDays = "s"
    'If lngHours < 10 Then strXHours = "0"
    'If lngMins < 10 Then strXMinutes = "0"
    'If lngSeconds < 10 Then strXSeconds = "0"
    'ProcessInterval = lngDays & " day" & strDays & ", " & strXHours & lngHours & ":" _
    & strXMinutes & lngMins & ":" & strXSeconds & lngSeconds
End Function

Public Property Get UsersInChannel() As Long
    UsersInChannel = ChannelUsers.Count()
End Property

Private Function ProcessSystemTime(T As SYSTEMTIME) As String
    Select Case T.wDayOfWeek
        Case 0: ProcessSystemTime = "Sunday, "
        Case 1: ProcessSystemTime = "Monday, "
        Case 2: ProcessSystemTime = "Tuesday, "
        Case 3: ProcessSystemTime = "Wednesday, "
        Case 4: ProcessSystemTime = "Thursday, "
        Case 5: ProcessSystemTime = "Friday, "
        Case 6: ProcessSystemTime = "Saturday, "
    End Select
    Select Case T.wMonth
        Case 1: ProcessSystemTime = ProcessSystemTime & "January"
        Case 2: ProcessSystemTime = ProcessSystemTime & "February"
        Case 3: ProcessSystemTime = ProcessSystemTime & "March"
        Case 4: ProcessSystemTime = ProcessSystemTime & "April"
        Case 5: ProcessSystemTime = ProcessSystemTime & "May"
        Case 6: ProcessSystemTime = ProcessSystemTime & "June"
        Case 7: ProcessSystemTime = ProcessSystemTime & "July"
        Case 8: ProcessSystemTime = ProcessSystemTime & "August"
        Case 9: ProcessSystemTime = ProcessSystemTime & "September"
        Case 10: ProcessSystemTime = ProcessSystemTime & "October"
        Case 11: ProcessSystemTime = ProcessSystemTime & "November"
        Case 12: ProcessSystemTime = ProcessSystemTime & "December"
    End Select
    ProcessSystemTime = ProcessSystemTime & " " & T.wDay & ", " & T.wYear & " "
    Dim ap$
    If T.wHour > 12 Then
        T.wHour = T.wHour - 12
        ap = "PM"
    ElseIf T.wHour = 0 Then
        T.wHour = 12
        ap = "AM"
    Else
        ap = "AM"
    End If
    ProcessSystemTime = ProcessSystemTime & T.wHour & ":"
    If T.wMinute < 10 Then ProcessSystemTime = ProcessSystemTime & "0"
    ProcessSystemTime = ProcessSystemTime & T.wMinute & ":"
    If T.wSecond < 10 Then ProcessSystemTime = ProcessSystemTime & "0"
    ProcessSystemTime = ProcessSystemTime & T.wSecond & " " & ap
End Function

Public Sub CUAdd(ByVal cUsername As String, Product As bnProduct, _
    Flags As Long, Ping As Long)
On Error GoTo ACU_Error
    Dim tmpUser As New User
    If Client = bpDiablo2 Or Client = bpDiablo2x Then _
        cUsername = ExtractD2Username(cUsername)
    With tmpUser
        .Username = cUsername
        .Product = Product
        .Flags = Flags
        .Ping = Ping
        If Flags And USER_CHANNELOP Then
            .IsOperator = True
        Else
            .IsOperator = False
        End If
        .JoinTime = GetTickCount()
    End With
    'If tmpUser.IsOperator Then
    '    AddC "Adding channel user: " & Username & " [op]."
    'Else
    '    AddC "Adding channel user: " & Username
    'End If
    ChannelUsers.Add tmpUser, cUsername
    Exit Sub
ACU_Error:
    If Err.Number = 457 Then
        With ChannelUsers(cUsername)
            .Username = cUsername
            If Product <> bpUnknown Then _
                .Product = Product
            .Flags = Flags
            .Ping = Ping
            If Flags And USER_CHANNELOP Then
                .IsOperator = True
            Else
                .IsOperator = False
            End If
        End With
    End If
End Sub

Public Function GetUser(Username As String) As User
On Error GoTo Trap
    Dim U As User
    Set GetUser = ChannelUsers(Username)
    Exit Function
Trap:
    ' try harder
    For Each U In ChannelUsers
        If (LCase$(U.Username) = LCase$(Username)) Then
            Set GetUser = U
            Exit Function
        End If
    Next
    
    ' give up
    Set GetUser = Nothing
End Function

Private Function ExtractD2Username(ByVal cUsername$) As String
    Dim Frag() As String
    If Left$(cUsername, 1) = "*" Then
        ExtractD2Username = Mid$(cUsername, 2)
    Else
        Frag = Split(cUsername, "*")
        If UBound(Frag) = 0 Then
            ExtractD2Username = Frag(0)
        Else
            ExtractD2Username = Frag(1)
        End If
    End If
End Function

Public Function GetChanUserInfo(ByVal Username$, Client As bnProduct, Flags&, Ping&) As Boolean
On Error GoTo CUI_Err
    With ChannelUsers(Username)
        Client = .Product
        Flags = .Flags
        Ping = .Ping
    End With
    GetChanUserInfo = True
    Exit Function
CUI_Err:
    GetChanUserInfo = False
End Function

Public Sub ChannelListDump()
    Dim i&
    For i = 1 To ChannelUsers.Count()
        If ChannelUsers(i).IsOperator Then
            AddC i & ": " & ChannelUsers(i).Username & " (op) " & ClientKeyToName(ChannelUsers(i).Product)
        Else
            AddC i & ": " & ChannelUsers(i).Username & " " & ClientKeyToName(ChannelUsers(i).Product)
        End If
    Next i
End Sub

Public Sub BuildChannelList()
    Dim i&, FirstPass As Boolean, Count&
    FirstPass = True
    Count = ChannelUsers.Count()
    i = 1
    While i <= Count
        'If FirstPass = True And ChannelUsers(i).IsOperator Then
        '    BotEvent bKey, evBuildList, ClientKeyToStr(ChannelUsers(i).Product), _
                ChannelUsers(i).Username, ChannelUsers(i).Flags, ChannelUsers(i).Ping
        'ElseIf FirstPass = False And ChannelUsers(i).IsOperator = False Then
            BotEvent bKey, evBuildList, ClientKeyToStr(ChannelUsers(i).Product), _
                ChannelUsers(i).Username, ChannelUsers(i).Flags, ChannelUsers(i).Ping
        'End If
        'If FirstPass And i = Count Then
        '    FirstPass = False
        '    i = 1
        'Else
            i = i + 1
        'End If
    Wend
    UpdateLocation bKey, Channel, UsersInChannel
End Sub

'Public Sub BuildChannelList()
'    'AddC "BnetBot.BuildChannelList()", vbWhite
'    'chList.ListItems.Clear
'    'Exit Sub
'    Dim i&, j&, Count&, FirstPass As Boolean
'    j = 1
'    Count = ChannelUsers.Count()
'    If Count = 0 Then
'        Exit Sub
'    End If
'    FirstPass = True
'
'    'For i = 1 To Count
'    '    AddC i & ": " & ChannelUsers(i).Username
'    'Next i
'
'    For i = 1 To Count
'        If FirstPass = True And (ChannelUsers(i).Flags And USER_CHANNELOP) Then
'            'AddC "Adding op: " & ChannelUsers(i).Username
'            BotEvent bKey, evBuildList, ClientKeyToStr(ChannelUsers(i).Product), _
'                ChannelUsers(i).Username, ChannelUsers(i).Flags, ChannelUsers(i).Ping
'        ElseIf FirstPass = False And (ChannelUsers(i).Flags And USER_CHANNELOP) = 0 Then
'            'AddC "Adding normal user: " & ChannelUsers(i).Username
'            BotEvent bKey, evBuildList, ClientKeyToStr(ChannelUsers(i).Product), _
'                ChannelUsers(i).Username, ChannelUsers(i).Flags, ChannelUsers(i).Ping
'        End If
'        If i = Count And FirstPass Then
'            i = 0
'            FirstPass = False
'        End If
'    Next i
'    UpdateLocation bKey, Channel, UsersInChannel
'End Sub

Public Function MoreUsers() As Boolean
    If UserI <= ChannelUsers.Count() Then
        MoreUsers = True
    Else
        MoreUsers = False
    End If
End Function

Public Function NextUser(Optional Client As bnProduct, Optional Ping As Long, Optional Flags As Long, Optional IsOp As Boolean)
    NextUser = ChannelUsers(UserI).Username
    If IsMissing(Client) = False Then Client = ChannelUsers(UserI).Product
    If IsMissing(Flags) = False Then Flags = ChannelUsers(UserI).Flags
    If IsMissing(Ping) = False Then Ping = ChannelUsers(UserI).Ping
    If IsMissing(IsOp) = False Then IsOp = ChannelUsers(UserI).IsOperator
    UserI = UserI + 1
End Function

Public Sub ResetUserI()
    UserI = 1
End Sub

Public Sub EnterChat()
'<RAGE>On Error Resume Next
    Dim o As New Packet
    'We won't be needing BNLS anymore...
    If UseBNLS Then _
        BNLS.Disconnect
    With o
        If ((PingMode And pmPlug) <> pmPlug) Then
            .InsertNonNTString "tenb"
            S.Send o.GetData(), SID_UDPPINGRESPONSE
        End If
        .InsertString Username
        .InsertByte &H0
        S.Send o.GetData(), SID_ENTERCHAT
        .InsertDWORD &H2
        If Not JoinLastChannel Or LenB(Channel) = 0 Then
            If LenB(Home) = 0 Then Home = "Public Chat " & DEFAULT_REGISTER
            BotEvent bKey, evConMsg, "Joining home channel " & Home & "..."
            .InsertString Home
        Else
            BotEvent bKey, evConMsg, "Joining last channel " & Channel & "..."
            .InsertString Channel
        End If
        JoiningChannel = True
        JoinTarget = Home
        S.Send .GetData(), SID_JOINCHANNEL
        TalkOK = True
        BotEvent bKey, evHandshakeComplete
    End With
End Sub

Public Sub RequestStats()
    RequestingStats = True
    BotEvent bKey, evConMsg, "Requesting account statistics..."
    Dim P As Packet
    Set P = New Packet
    With P
        .InsertDWORD 1 '1 acct
        .InsertDWORD 4 '4 fields
        .InsertDWORD 5468
        .InsertString Username
        .InsertString "System\Account Created"
        .InsertString "System\Last Logon"
        .InsertString "System\Last Logoff"
        .InsertString "System\Time Logged"
        S.Send .GetData(), SID_READUSERDATA
    End With
End Sub

Public Function BNetSend(Data As String, Optional PacketID As Byte) As Boolean
    If IsMissing(PacketID) Then
        BNetSend = S.Send(Data)
    Else
        BNetSend = S.Send(Data, PacketID)
    End If
End Function

Public Sub Talk(Text As String)
    Call Say(Text)
End Sub

Public Sub Say(Text As String)
    If Not TalkOK Then Exit Sub
    Dim P As New Packet
    'LastTick = GetTickCount()
    With P
        .InsertString Text
        S.Send P.GetData(), SID_CHATCOMMAND
    End With
    BotEvent bKey, evSelfTalk, Text
End Sub

Private Function ConnectToBattleNet() As Boolean
Dim tR As Integer
    ConnectToBattleNet = False
    If UseBNLS = False Then
        VerByte = GetVersionByte(Client)
        If VerByte = 0 Then
            BotEvent bKey, evAbort, "The version byte for " & ClientKeyToName(Client) & " is unavailable."
            Exit Function
        End If
    End If
    
    If Proxy Then
        ProxyInit = True
        BotEvent bKey, evProxyConnecting
        Dim P As New Packet
        If ProxyType = socks4 Or ProxyType = socks5 Then
            If LenB(ProxyServer) = 0 Then
                BotEvent bKey, evAbort, "Could not connect to proxy server.  No proxy server was specified."
                Exit Function
            End If
            tR = frmMain.txtRecv.Count
            Load frmMain.txtRecv(tR)
            If S.Initialize(frmMain.txtRecv(tR).hwnd, bKey, sBattleNet, DISABLE_NAGEL) Then
                If S.Connect(ProxyServer, ProxyPort) = False Then
                    BotEvent bKey, evAbort, "Could not connect to the proxy server."
                Else
                    ConnectToBattleNet = True
                End If
            End If
        End If
    Else
        If LenB(Server) = 0 Then
            BotEvent bKey, evAbort, "Could not connect to Battle.Net because no server was specified."
            Exit Function
        End If
        tR = frmMain.txtRecv.Count
        Load frmMain.txtRecv(tR)
        If S.Initialize(frmMain.txtRecv(tR).hwnd, bKey, sBattleNet) Then
            BotEvent bKey, evConnecting, Server
            If S.Connect(Server, 6112) = False Then
                BotEvent bKey, evAbort, "Could not connect to Battle.Net."
            Else
                ConnectToBattleNet = True
            End If
        Else
            BotEvent bKey, evAbort, "Could not initialize Battle.Net socket."
        End If
    End If
End Function

Public Function GetSock() As Long
    GetSock = S.Sock
End Function

Public Function GetSocket(sType As mSocketType) As Long
'<RAGE>On Error Resume Next
    Select Case sType
        Case sBattleNet: GetSocket = S.Sock
        Case sBNLS: GetSocket = BNLS.Sock
        Case sMCP: GetSocket = MCP.Sock
    End Select
End Function

Public Function GetBNLSSock() As Long
'<RAGE>On Error Resume Next
    GetBNLSSock = BNLS.Sock
End Function

'Private Sub InitCRC32()
'    Dim i As Long, j As Long, K As Long, XorVal As Long
'
'    Static CRC32Initialized As Boolean
'    If CRC32Initialized Then Exit Sub
'    CRC32Initialized = True
'
'    For i = 0 To 255
'        K = i
'
'        For j = 1 To 8
'            If K And 1 Then XorVal = CRC32_POLYNOMIAL Else XorVal = 0
'            If K < 0 Then K = ((K And &H7FFFFFFF) \ 2) Or &H40000000 Else K = K \ 2
'            K = K Xor XorVal
'        Next
'
'        CRC32Table(i) = K
'    Next
'End Sub

'Private Function CRC32(ByVal Data As String) As Long
'    Dim i As Long, j As Long
'
'    Call InitCRC32
'
'    CRC32 = &HFFFFFFFF
'
'    For i = 1 To Len(Data)
'        j = CByte(Asc(Mid(Data, i, 1))) Xor (CRC32 And &HFF&)
'        If CRC32 < 0 Then CRC32 = ((CRC32 And &H7FFFFFFF) \ &H100&) Or &H800000 Else CRC32 = CRC32 \ &H100&
'        CRC32 = CRC32 Xor CRC32Table(j)
'    Next
'
'    CRC32 = Not CRC32
'End Function

'Private Function BNLSChecksum(ByVal Password As String, ByVal ServerCode As Long) As Long
'    BNLSChecksum = CRC32(Password & Right("0000000" & Hex(ServerCode), 8))
'End Function

Private Function GetBNLSProduct() As Long
    Select Case Client
        Case bpStarCraft: GetBNLSProduct = PRODUCT_STARCRAFT
        Case bpBroodWar: GetBNLSProduct = PRODUCT_BROODWAR
        Case bpDiablo2: GetBNLSProduct = PRODUCT_DIABLO2
        Case bpDiablo2x: GetBNLSProduct = PRODUCT_LORDOFDESTRUCTION
        Case bpWarCraft2: GetBNLSProduct = PRODUCT_WAR2BNE
        Case bpWarCraft3: GetBNLSProduct = PRODUCT_WARCRAFT3
        Case bpWarCraft3x: GetBNLSProduct = PRODUCT_THEFROZENTHRONE
    End Select
End Function

Public Sub UICInfo()
    Dim i&
    For i = 1 To ChannelUsers.Count()
        AddC i & ": " & ChannelUsers(i).Username & " using " & ClientKeyToName(ChannelUsers(i).Product) & " with ping of " & ChannelUsers(i).Ping, vbWhite
    Next i
End Sub

Public Function ResendLastBNLS() As Boolean
    ResendLastBNLS = BNLS.ResendLast()
End Function

Private Sub Class_Terminate()
'<RAGE>On Error Resume Next
   Disconnect
   'Set Q = Nothing
End Sub

'Public Sub TimerTick(ByVal dwTime&)
'    If TalkOK And dwTime - LastNullSent >= 15000 Then
'        LastNullSent = dwTime
'        SendNull
'    End If
'    If MsgQueue.Count() > 0 And dwTime >= RequiredDelay(Len(MsgQueue(1)), dwTime) Then
'        Say MsgQueue(1)
'        MsgQueue.Remove 1
'    End If
'End Sub

Public Sub SendNull()
    Call S.Send("", SID_NULL)
End Sub

'-----------------------------------------------------------------------------------
'  Hashed Connections
'-----------------------------------------------------------------------------------
Public Function SupportsHashedClient(checkClient As bnProduct) As Boolean
    SupportsHashedClient = True
End Function

Public Function GetVersionByte(Product As bnProduct) As Long
    Dim sTmp$
    sTmp = GetConfig(ClientKeyToStr(Product), "VerByte")
    If LenB(sTmp) Then
        GetVersionByte = CLng("&H" & sTmp)
        Exit Function
    End If
    
    'defaults
    Select Case Product
        Case bpStarCraft, bpBroodWar: GetVersionByte = &HCD
        Case bpWarCraft2: GetVersionByte = &H4F
        Case bpDiablo2, bpDiablo2x: GetVersionByte = &HB
        Case bpWarCraft3, bpWarCraft3x: GetVersionByte = &H14
    End Select
    'GetVersionByte = CLng("&H" & GetSetting("VerByte", ClientKeyToStr(Product)))
End Function

'Public Function GetVersionByte(Product As bnProduct) As Long
'    GetVersionByte = CLng("&H" & GetCon("VerByte", ClientKeyToStr(Product)))
'End Function


'-----------------------------------------------------------------------------------
'  Queue
'-----------------------------------------------------------------------------------

'Public Sub qAdd(ByVal Message As String, Optional ByVal Urgent As Boolean = False)
'    If Urgent And MsgQueue.Count() > 0 Then
'        MsgQueue.Add Message, , 1
'    Else
'        MsgQueue.Add Message
'    End If
'End Sub

'Private Function RequiredDelay(ByVal Bytes As Long, Optional ByVal Tick As Long = 0) As Long
'    Static SentBytes As Long
'    Const PerPacket = 200
'    Const PerByte = 10
'    Const MaxBytes = 600
'    If Tick = 0 Then _
'        Tick = GetTickCount()
'    If (LastTick - Tick) > (SentBytes * PerByte) Then
'        SentBytes = 0
'    Else
'        SentBytes = SentBytes - (LastTick - Tick) / PerByte
'    End If
'    If (SentBytes + PerPacket + Bytes) > MaxBytes Then
'        RequiredDelay = Tick + (SentBytes + PerPacket + Bytes - MaxBytes) * PerByte
'    Else
'        SentBytes = SentBytes + PerPacket + Bytes
'        RequiredDelay = Tick
'    End If
'End Function

Public Sub SendGarbage()
    'never ever use this
    'unless IP-bans are your idea of fun
    
    Dim P As Packet
    Set P = New Packet
    P.InsertString "Blizzard is a bunch of flaming homos wearing " & _
        "ladies' dresses and they should all die!"
    S.Send P.GetData(), &H69
    BotEvent bKey, evConError, "Unexpected connection failure."
    '(wink, wink)
End Sub

Public Sub TriggerEvent()
    If Not TriggerHappy Then Exit Sub
    TriggerHappy = False
    If TriggeredEvent = "sweepban" Then
        Dim i&, Frag() As String
        Frag = Split(EventBuffer, vbNullChar)
        For i = 0 To UBound(Frag)
            'Check for accounts on ops.
            If Left$(Frag(i), 1) = "[" And Right$(Frag(i), 1) = "]" And UCase$(Frag(i)) = Frag(i) Then
                Frag(i) = Mid$(Frag(i), 2, (Len(Frag(i)) - 2))
            End If
            If LenB(Frag(i)) Then _
                BotEvent bKey, evGeneratedMessage, "/ban " & Frag(i) & " Sweepban"
        Next i
        EventBuffer = ""
    End If
End Sub
