VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ParseBNCS"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Public accounthash As String
Public outb As String
Public CP As Long, MPQName As String, MPQN As String, Hash As String
Public Sub parsep(ByVal Data As String)
Dim ProfileEnd As String
Dim SplitProfile As Variant
Dim F As Variant
Dim x As String
On Error Resume Next
Dim d As String
Dim tmp As String
Dim mpqend As Long
Dim PacketID As String
PacketID = Asc(Mid(Data, 2, 1))
PacketData = Mid(Data, 5, MKI(Mid(Data, 3, 2)) - 4)
If PacketScreen = True Then
    If Len(Hex(PacketID)) = 1 Then
        AddC True, Form8.TALK, vbRed, "[Battle.net (TCP)]: S => C: 0x0" & Hex(PacketID)
    Else
        AddC True, Form8.TALK, vbRed, "[Battle.net (TCP)]: S => C: 0x" & Hex(PacketID)
    End If
End If
Select Case PacketID
    Case &HF
        ParseChat.DispatchMessage Data
    Case &H34
        If RealmLogin = True And VarProduct = "VD2D" Or VarProduct = "PX2D" Then
            Dim rpass As String
            rpass = String(5 * 4, vbNullChar)
            Call A2(rpass, Servers)
            With pbuffer
                .InsertDWORD &H1
                .InsertNonNTString rpass
                .InsertNTString varRealm
                .SendPacket &H3E
            End With
        End If
   Case &H3E
        If RealmLogin = True And VarProduct = "VD2D" Or VarProduct = "PX2D" Then
            Dim Server As String
            Dim bleh2 As String
            Dim port As String
            p1 = Mid(Data, 5, 16)
            Server = Mid(Data, 17, 8)
            bleh2 = Mid(Server, 5, 4)
            AddC True, Form1.TALK, QBColor(8), "Attempting to connect to MCP server: " & makeserver(bleh2)
            AddC True, Form4.TALK, QBColor(8), "Attempting to connect to MCP server: " & makeserver(bleh2)
            p2 = Mid(Data, 29, 48)
            urname = Mid(Data, 77, Len(Data) - 79)
            On Error Resume Next
            MDIForm1.socketudp.Close
            MDIForm1.socketudp.RemoteHost = makeserver(bleh2)
            MDIForm1.socketudp.RemotePort = VarPort
            MDIForm1.socketudp.Connect
        End If
    Case &H2F
        If GetDWORD(Mid(Data, 5, 4)) = -1 Then
            AddC True, Form1.TALK, vbYellow, "User " & LastLadderLookup & " is not rated on the ladder."
        Else
            AddC True, Form1.TALK, vbYellow, "User " & LastLadderLookup & " is ranked " & GetDWORD(Mid(Data, 5, 4)) + 1 & " on the ladder."
        End If
        Exit Sub
        
    Case &H0
    
    pbuffer.SendPacket &H0
    
    Case &H19
        ProfileEnd = Mid(Data, 9, Len(Data)) '17
        SplitProfile = Split(ProfileEnd, Chr(&H0))
        For I = 0 To UBound(SplitProfile) - 2
        AddC True, Form1.TALK, vbRed, "Battle.net: " & SplitProfile(I)
        Next I
        
    Case &H25
        If Connected = True Or VarProduct = "PX2D" Or VarProduct = "VD2D" Or VarProduct = "PX2D" And VarProduct = "VD2D" Or VarProduct = "3RAW" Or VarProduct = "PX3W" Then
            With pbuffer
                .InsertDWORD (GetDWORD(Data))
                .SendPacket &H25
            End With
        End If
    Case &H13
        AddC True, Form1.TALK, vbRed, "Battle.net: ", vbYellow, "You have been disconnected for flooding."
        AddC True, Form4.TALK, vbRed, "Battle.net: ", vbYellow, "You have been disconnected for flooding."
    Case &H26
    Dim Splt() As String
            AddC True, Form1.TALK, vbRed, "Profile:"
            ProfileEnd = Mid(Data, 17, Len(Data)) '17
            SplitProfile = Split(ProfileEnd, Chr(&H0)) 'Chr(&H0)
            Splt() = Split(SplitProfile(0), vbNewLine)
            If UBound(Splt) < 0 Then AddC True, Form1.TALK, vbRed, "- Sex:"
            For I = 0 To UBound(Splt)
                If Len(Splt(I)) > 0 Then AddC True, Form1.TALK, vbRed, "- Sex: " & Splt(I)
            Next I
            Splt() = Split(SplitProfile(1), vbNewLine)
            If UBound(Splt) < 0 Then AddC True, Form1.TALK, vbRed, "- Location:"
            For I = 0 To UBound(Splt)
                If Len(Splt(I)) > 0 Then AddC True, Form1.TALK, vbRed, "- Location: " & Splt(I)
            Next I
            Splt() = Split(SplitProfile(2), vbNewLine)
            If UBound(Splt) < 0 Then AddC True, Form1.TALK, vbRed, "- Decription:"
            For I = 0 To UBound(Splt)
                If Len(Splt(I)) > 0 Then AddC True, Form1.TALK, vbRed, "- Decription: " & Splt(I)
            Next I
            Erase Splt()
 
    Case &H46
    Dim spltns() As String
    Dim tmpnews As Long
    spltns() = Split(Mid(Data, 22), "0A")
    AddC True, Form1.TALK, vbGreen, spltns(0)
       
        Case &H6
        Servers = Val("&h" & StrToHex(StrReverse(Mid(Data, 9, 4))))
        Serversn = Val("&h" & StrToHex(StrReverse(Mid(Data, 13, 4))))
        d = Data
        MPQName = Mid(d, InStr(d, "I"), Len(d) - InStr(InStr(d, "I"), d, Chr(0)))
        mpqend = InStr(InStr(d, "I"), d, Chr(0))
        MPQName = Left(MPQName, InStr(MPQName, Chr(0)) - 1)
        Hash = Mid(d, mpqend + 1, InStr(mpqend + 1, d, Chr(0)) - 1)
        Hash = Left(Hash, InStr(Hash, Chr(0)) - 1)
        AddC True, Form4.TALK, QBColor(8), "MPQ Name: " & MPQName
        AddC True, Form4.TALK, QBColor(8), "Hash: " & Hash
        AddC True, Form1.TALK, QBColor(8), "MPQ Name: " & MPQName
        AddC True, Form1.TALK, QBColor(8), "Hash: " & Hash
    Dim version As Long
    Dim CheckSum As Long
    Dim exeinfo As String
    Dim Result As Long
    pbuffer.InsertNonNTString "68XI" & VarProduct
    pbuffer.InsertDWORD &HC
    exeinfo = Space(256)
    Select Case VarProduct
        Case "VD2D"
            Result = Rape(App.Path & "\d2dv\game.exe", App.Path & "\d2dv\bnclient.dll", App.Path & "\d2dv\d2client.dll", Hash, version, CheckSum, exeinfo, MPQName)
        Case "NB2W"
            Result = Rape(App.Path & "\w2bn\Warcraft II BNE.exe", App.Path & "\w2bn\storm.dll", App.Path & "\w2bn\battle.snp", Hash, version, CheckSum, exeinfo, MPQName)
        Case "RATS", "PXES"
            Result = Rape(App.Path & "\star\Starcraft.exe", App.Path & "\star\storm.dll", App.Path & "\star\battle.snp", Hash, version, CheckSum, exeinfo, MPQName)
    End Select
    pbuffer.InsertDWORD version
    pbuffer.InsertDWORD CheckSum
    NullTruncString exeinfo
    AddC True, Form1.TALK, QBColor(8), "Executable information: " & exeinfo
    AddC True, Form4.TALK, QBColor(8), "Executable information: " & exeinfo
    pbuffer.InsertNTString exeinfo
    If exeinfo = Space(256) Then
            pbuffer.Clear
            AddC True, Form1.TALK, vbRed, "Error: CheckRevision call failed!"
            AddC True, Form4.TALK, vbRed, "Error: CheckRevision call failed!"
            MDIForm1.winsock.Close
            MDIForm1.ReconnectTimer.Enabled = True
            Exit Sub
        End If
    pbuffer.SendPacket 7
    Case &H2E
        CP = 25
        Dim l As Long
        l = Len(Data)
        If l = 24 Then
            AddC True, Form1.TALK, vbRed, "Error: An unknown error occured in the ladder lookup"
            Exit Sub
        End If
        rank = 1
        AddC True, Form1.TALK, vbRed, l
        AddC True, Form1.TALK, vbRed, "Ladder listings for " & MakeLongClientName(StrReverse(Mid(Data, 5, 4))) & ":"
        While True
            If CP > l Then GoTo Finish
            AddC True, Form1.TALK, vbRed, getladder(Data)
        Wend
Finish:
AddC True, Form1.TALK, vbRed, "End of Ladder."

    Case &H7
      strData = Mid(Data, 5, 1)
     Select Case strData
    
     Case Chr(2)
            pbuffer.SendPacket &H2D
       Case Chr(0)
            AddC True, Form1.TALK, vbRed, "Error: Battle.net rejected your hash"
            AddC True, Form4.TALK, vbRed, "Error: Battle.net rejected your hash"
            MDIForm1.winsock.Close
            MDIForm1.ReconnectTimer.Enabled = True
            Case Else
                AddC True, Form4.TALK, vbRed, "Error: Unknown Verification Return Value, may need to upgrade game client"
                AddC True, Form1.TALK, vbRed, "Error: Unknown Verification Return Value, may need to upgrade game client"
            MDIForm1.winsock.Close
            MDIForm1.ReconnectTimer.Enabled = True
        End Select
    Case &HB
        ProfileEnd = Mid(Data, 5, Len(Data)) '17
        SplitProfile = Split(ProfileEnd, Chr(&H0)) 'Chr(&H0)
        For I = 0 To UBound(SplitProfile) - 2
            Channels = Channels & SplitProfile(I) & ", "
        Next I
        AddC True, Form1.TALK, vbGreen, "Avaliable channels: ", vbYellow, Mid(Channels, 1, Len(Channels) - 2)
        AddC True, Form4.TALK, vbGreen, "Avaliable channels: ", vbYellow, Mid(Channels, 1, Len(Channels) - 2)
    Case &H1D
          serverhash = Right(Data, 4)
    Case &H2D
        Dim splti() As String
        splti() = Split(Mid(Data, 1, Len(Data) - 1), Chr(1), 2)
        AddC True, Form1.TALK, QBColor(8), "Icons file is named: " & splti(1)
        AddC True, Form4.TALK, QBColor(8), "Icons file is named: " & splti(1)
        Splt() = Split(Data, Chr(0))
        Erase splti()
        If H1EMethod = False And H50Method = True Or BNLSLogin = True Then Exit Sub
        AddC True, Form1.TALK, QBColor(8), "Sending CD-Key..."
        AddC True, Form4.TALK, QBColor(8), "Sending CD-Key..."
        SendCDKey varCDkey
    Case &H30, &H36
        If H1EMethod = False And H50Method = True Then Exit Sub
        Select Case Mid(Data, 5, 1)
        Case Chr(1)
                AddC True, Form1.TALK, vbGreen, "CD-Key Verified"
                AddC True, Form1.TALK, QBColor(8), "Sending Username/Password..."
                AddC True, Form4.TALK, vbGreen, "CD-Key Verified"
                AddC True, Form4.TALK, QBColor(8), "Sending Username/Password..."
          If Len(NewPass) > 0 And LCase(NewPass) <> LCase(varpass) Then
                With pbuffer
                    accounthash = String(5 * 4, vbNullChar)
                    Result = XLMNO(accounthash, NewPass)
                    outb = String(7 * 4, vbNullChar)
                    RP = a(outb, Val("&h" & StrToHex(StrReverse(serverhash))), varpass)
                    .InsertNonNTString outb
                    .InsertNonNTString accounthash
                    .InsertNTString varUser
                    .SendPacket &H31
                End With
           Else
                SendUsernamePassword
           End If
        Case Chr(2)
            AddC True, Form4.TALK, vbRed, "Error: CDKey Invalid!"
            AddC True, Form1.TALK, vbRed, "Error: CDKey Invalid!"
            MDIForm1.winsock.Close
            MDIForm1.ReconnectTimer.Enabled = True
        Case Chr(3)
            AddC True, Form4.TALK, vbRed, "Error: CDKey Invalid - For a Different Product"
            AddC True, Form1.TALK, vbRed, "Error: CDKey Invalid - For a Different Product"
            MDIForm1.winsock.Close
            MDIForm1.ReconnectTimer.Enabled = True
        Case Chr(4)
            AddC True, Form4.TALK, vbRed, "Error: Disabled CD-Key"
            AddC True, Form1.TALK, vbRed, "Error: Disabled CD-Key"
            MDIForm1.winsock.Close
            MDIForm1.ReconnectTimer.Enabled = True
        Case Chr(5)
            ProfileEnd = Mid(Data, 1, Len(Data)) '17
            SplitProfile = Split(ProfileEnd, Chr(&H0))
            AddC True, Form4.TALK, vbRed, "Error: CD-Key in use (By: " & SplitProfile(UBound(SplitProfile) - 1) & ")."
            AddC True, Form1.TALK, vbRed, "Error: CD-Key in use (By: " & SplitProfile(UBound(SplitProfile) - 1) & ")."
            MDIForm1.winsock.Close
            MDIForm1.ReconnectTimer.Enabled = True
        End Select
  Case &H52
        Select Case GetWORD(Mid(Data, 5, 2))
            Case &H0
                AddC True, Form1.TALK, vbGreen, "Account created!"
                AddC True, Form4.TALK, vbGreen, "Account created!"
                AddC True, Form4.TALK, QBColor(8), "Sending Username/Password..."
                AddC True, Form1.TALK, QBColor(8), "Sending Username/Password..."
                With pbuffer
                    .InsertNTString varUser
                    .InsertNTString varpass
                    .SendBNLSPacket &H2
                End With
            Case &H7
                AddC True, Form1.TALK, vbRed, "Account create failed: username too short"
                AddC True, Form4.TALK, vbRed, "Account create failed: username too short"
                MDIForm1.winsock.Close
                MDIForm1.ReconnectTimer.Enabled = True
            Case &H8
                AddC True, Form1.TALK, vbRed, "Account create failed: username contains invalid characters"
                AddC True, Form4.TALK, vbRed, "Account create failed: username contains invalid characters"
                MDIForm1.winsock.Close
                MDIForm1.ReconnectTimer.Enabled = True
            Case &H9
                AddC True, Form1.TALK, vbRed, "Account create failed: username contains bad word(s)"
                AddC True, Form4.TALK, vbRed, "Account create failed: username contains bad word(s)"
                MDIForm1.winsock.Close
                MDIForm1.ReconnectTimer.Enabled = True
            Case &HA
                AddC True, Form1.TALK, vbRed, "Account create failed: username does not contain enough alphanumeric chars in name"
                AddC True, Form4.TALK, vbRed, "Account create failed: username does not contain enough alphanumeric chars in name"
                MDIForm1.winsock.Close
                MDIForm1.ReconnectTimer.Enabled = True
            Case &HB
                AddC True, Form1.TALK, vbRed, "Account create failed: username contains adjacent punctuation characters"
                AddC True, Form4.TALK, vbRed, "Account create failed: username contains adjacent punctuation characters"
                MDIForm1.winsock.Close
                MDIForm1.ReconnectTimer.Enabled = True
            Case &HC
                AddC True, Form1.TALK, vbRed, "Account create failed: username contains too many punctuation characters"
                AddC True, Form4.TALK, vbRed, "Account create failed: username contains too many punctuation characters"
                MDIForm1.winsock.Close
                MDIForm1.ReconnectTimer.Enabled = True
            Case Else
                AddC True, Form1.TALK, vbRed, "Account create failed: username already exists"
                AddC True, Form4.TALK, vbRed, "Account create failed: username already exists"
                MDIForm1.winsock.Close
                MDIForm1.ReconnectTimer.Enabled = True
        End Select
  Case &H29
     If Mid(Data, 5, 1) = Chr(1) Then
            If RealmLogin = True And VarProduct = "VD2D" Or VarProduct = "PX2D" Then
            With pbuffer
                .InsertDWORD &H0
                .InsertDWORD &H0
                .InsertBYTE &H0
                .SendPacket &H34
            End With
            Else
            AddC True, Form1.TALK, vbGreen, "Login Passed!"
            AddC True, Form4.TALK, vbGreen, "Login Passed!"
            pbuffer.InsertNonNTString VarProduct
            pbuffer.SendPacket &HB
            pbuffer.InsertNTString varUser
            pbuffer.InsertBYTE 0
            pbuffer.SendPacket &HA
            pbuffer.InsertDWORD 1
            pbuffer.InsertNTString VarHome
            pbuffer.SendPacket &HC
        End If
        Else
            AddC True, Form4.TALK, vbRed, "Error: Logon Failed!"
            AddC True, Form1.TALK, vbRed, "Error: Logon Failed!"
            AddC True, Form1.TALK, QBColor(8), "Attempting to create account..."
            AddC True, Form4.TALK, QBColor(8), "Attempting to create account..."
            SendCreateAccount varUser, varpass
            'MDIForm1.winsock.Close
        End If
        Case &H54
            Select Case GetWORD(Mid(Data, 5, 2))
                Case &H0
                    AddC True, Form1.TALK, vbGreen, "Login Passed!"
                    AddC True, Form4.TALK, vbGreen, "Login Passed!"
                    With pbuffer
                        .InsertNTString varUser
                        .InsertBYTE 0
                        .SendPacket &HA
                        .InsertNonNTString VarProduct
                        .SendPacket &HB
                        .InsertDWORD 0
                        .InsertNTString varUser & ":" & VarServer
                        .SendPacket &HC
                        .InsertNTString "/whoami"
                        .SendPacket &HE
                        .InsertDWORD 1
                        .InsertNTString varUser
                        .SendPacket &HC
                    End With
                Case &H2
                    AddC True, Form1.TALK, vbRed, "Login Failed!"
                    AddC True, Form4.TALK, vbRed, "Login Failed!"
                    If attemptedc = False Then
                        AddC True, Form1.TALK, QBColor(8), "Attempting to create account..."
                        AddC True, Form4.TALK, QBColor(8), "Attempting to create account..."
                        With pbuffer
                            .InsertNTString varUser
                            .InsertNTString varpass
                            .SendBNLSPacket &H4
                        End With
                    attemptedc = True
                    Else
                        MDIForm1.winsock.Close
                        MDIForm1.ReconnectTimer.Enabled = True
                    End If
                End Select
        Case &H57
            Select Case GetDWORD(Mid(PacketData, 1, 4))
                Case &H0
                    AddC True, Form1.TALK, QBColor(8), "Confirming upgrade..."
                    AddC True, Form1.TALK, QBColor(8), "Confirming upgrade..."
                Case Else
                    AddC True, Form1.TALK, vbRed, "Account upgrade failed!"
                    AddC True, Form4.TALK, vbRed, "Account upgrade failed!"
                End Select
        Case &H53
        If Asc(Mid$(Data, 5, 1)) = &H1 Then
            AddC True, Form1.TALK, vbRed, "Login Failed!"
            AddC True, Form4.TALK, vbRed, "Login Failed!"
            If attemptedc = False Then
                AddC True, Form1.TALK, QBColor(8), "Attempting to create account..."
                AddC True, Form4.TALK, QBColor(8), "Attempting to create account..."
                With pbuffer
                    .InsertNTString varUser
                    .InsertNTString varpass
                    .SendBNLSPacket &H4
                End With
                attemptedc = True
            End If
        ElseIf Asc(Mid$(Data, 5, 1)) = &H5 Then
            AddC True, Form1.TALK, vbRed, "Account requires upgrade."
            AddC True, Form4.TALK, vbRed, "Account requires upgrade."
            MDIForm1.winsock.Close
            MDIForm1.BNLSSock.Close
            MDIForm1.ReconnectTimer.Enabled = True
            'AddC True, Form1.TALK, QBColor(8), "Attempting to upgrade account..."
            'AddC True, Form4.TALK, QBColor(8), "Attempting to upgrade account..."
            'With pbuffer
            '    .InsertNTString varUser
            '    .InsertNTString varpass
            '    .SendBNLSPacket &H7
            'End With
        Else
            With pbuffer
                .InsertNonNTString Mid(Data, 9, 64)
                .SendBNLSPacket &H3
            End With
        End If
        Case &H51
            Dim g5d As Long
            g5d = GetDWORD(Mid(Data, 4, 4))
            Select Case g5d
            Case &H0
            AddC True, Form1.TALK, QBColor(8), "CD-Key Verified"
            AddC True, Form1.TALK, QBColor(8), "Sending Username/Password..."
            AddC True, Form4.TALK, QBColor(8), "CD-Key Verified"
            AddC True, Form4.TALK, QBColor(8), "Sending Username/Password..."
            If BNLSLogin = True And VarProduct = "3RAW" Or VarProduct = "PX3W" Then
                With pbuffer
                    .InsertNTString varUser
                    .InsertNTString varpass
                    .SendBNLSPacket &H2
                End With
            Else
                With pbuffer
                    .InsertNonNTString "bnet"
                    .SendPacket &H14
                    .SendPacket &H2D
                End With
                If Len(NewPass) > 0 And LCase(NewPass) <> LCase(varpass) Then
                    With pbuffer
                        accounthash = String(5 * 4, vbNullChar)
                        Result = XLMNO(accounthash, NewPass)
                        outb = String(7 * 4, vbNullChar)
                        RP = a(outb, Servers, varpass)
                        .InsertNonNTString outb
                        .InsertNonNTString accounthash
                        .InsertNTString varUser
                        .SendPacket &H31
                    End With
                Else
                    outb = String(7 * 4, vbNullChar)
                    RP = a(outb, Servers, varpass)
                    With pbuffer
                        .InsertNonNTString outb
                        .InsertNTString varUser
                        .SendPacket &H3A
                    End With
                End If
            End If
            Case 65792
                AddC True, Form1.TALK, vbRed, "Error: Invalid game version"
                AddC True, Form4.TALK, vbRed, "Error: Invalid game version"
                On Error Resume Next
                MDIForm1.winsock.Close
                MDIForm1.BNLSSock.Close
                MDIForm1.ReconnectTimer.Enabled = True
            Case 131584
                AddC True, Form1.TALK, vbRed, "Error: Disabled CD-Key"
                AddC True, Form4.TALK, vbRed, "Error: Disabled CD-Key"
                On Error Resume Next
                MDIForm1.winsock.Close
                MDIForm1.BNLSSock.Close
                MDIForm1.ReconnectTimer.Enabled = True
            Case 131072
                AddC True, Form1.TALK, vbRed, "Error: Invalid CD-Key"
                AddC True, Form4.TALK, vbRed, "Error: Invalid CD-Key"
                On Error Resume Next
                MDIForm1.winsock.Close
                MDIForm1.BNLSSock.Close
                MDIForm1.ReconnectTimer.Enabled = True
            Case 131840
                AddC True, Form1.TALK, vbRed, "Error: CDKey Invalid - For a Different Product"
                AddC True, Form4.TALK, vbRed, "Error: CDKey Invalid - For a Different Product"
                On Error Resume Next
                MDIForm1.winsock.Close
                MDIForm1.BNLSSock.Close
                MDIForm1.ReconnectTimer.Enabled = True
            Case 135936
                AddC True, Form1.TALK, vbRed, "Error: CDKey(2) Invalid - For a Different Product"
                AddC True, Form4.TALK, vbRed, "Error: CDKey(2) Invalid - For a Different Product"
                On Error Resume Next
                MDIForm1.winsock.Close
                MDIForm1.BNLSSock.Close
                MDIForm1.ReconnectTimer.Enabled = True
            Case 131328
                ProfileEnd = Mid(Data, 1, Len(Data)) '17
                SplitProfile = Split(ProfileEnd, Chr(&H0))
                AddC True, Form1.TALK, vbRed, "Error: CD-Key in use (By: " & SplitProfile(UBound(SplitProfile) - 1) & ")."
                AddC True, Form4.TALK, vbRed, "Error: CD-Key in use (By: " & SplitProfile(UBound(SplitProfile) - 1) & ")."
                On Error Resume Next
                MDIForm1.winsock.Close
                MDIForm1.BNLSSock.Close
                MDIForm1.ReconnectTimer.Enabled = True
            Case 135424
                ProfileEnd = Mid(Data, 1, Len(Data)) '17
                SplitProfile = Split(ProfileEnd, Chr(&H0))
                AddC True, Form1.TALK, vbRed, "Error: CD-Key(2) in use (By: " & SplitProfile(UBound(SplitProfile) - 1) & ")."
                AddC True, Form4.TALK, vbRed, "Error: CD-Key(2) in use (By: " & SplitProfile(UBound(SplitProfile) - 1) & ")."
                On Error Resume Next
                MDIForm1.winsock.Close
                MDIForm1.BNLSSock.Close
                MDIForm1.ReconnectTimer.Enabled = True
            Case Else
                AddC True, Form1.TALK, vbRed, "Error: Unknown error occured (" & g5d & ")"
                AddC True, Form4.TALK, vbRed, "Error: Unknown error occured (" & g5d & ")"
                On Error Resume Next
                MDIForm1.winsock.Close
                MDIForm1.BNLSSock.Close
                MDIForm1.ReconnectTimer.Enabled = True
            End Select
            
            Case &H31
            If InStr(Data, Chr(&H1)) Then
                If BadBoy = False Then
                    AddC True, Form1.TALK, vbGreen, "Password changed to: " & NewPass
                    AddC True, Form4.TALK, vbGreen, "Password changed to: " & NewPass
                    varpass = NewPass
                    SaveConfig
                Else
                    On Error Resume Next
                    AddC True, Form1.TALK, vbRed, "Error: Unknown error (Contact LoRd]ZeR0[)"
                    AddC True, Form4.TALK, vbRed, "Error: Unknown error (Contact LoRd]ZeR0[)"
                    MDIForm1.winsock.Close
                    MDIForm1.BNLSSock.Close
                    MDIForm1.socketudp.Close
                End If
                If H1EMethod = False And H50Method = True Then
                    outb = String(7 * 4, vbNullChar)
                    RP = a(outb, Servers, varpass)
                    With pbuffer
                        .InsertNonNTString outb
                        .InsertNTString varUser
                        .SendPacket &H3A
                    End With
                ElseIf H1EMethod = True And H50Method = False Then
                    SendUsernamePassword
                End If
            Else
                If BadBoy = False Then
                    AddC True, Form1.TALK, vbRed, "Error: Password change failed"
                    AddC True, Form4.TALK, vbRed, "Error: Password change failed"
                    On Error Resume Next
                    MDIForm1.winsock.Close
                    MDIForm1.BNLSSock.Close
                    MDIForm1.ReconnectTimer.Enabled = True
                Else
                    AddC True, Form1.TALK, vbRed, "Error: Unknown"
                    AddC True, Form4.TALK, vbRed, "Error: Unknown"
                    On Error Resume Next
                    MDIForm1.winsock.Close
                    MDIForm1.BNLSSock.Close
                    MDIForm1.ReconnectTimer.Enabled = True
                End If
            End If
        Case &H50
            Dim MPQN As Long
                strUDPVal = Mid(Data, 13, 4) 'gets the value to send in the UDP pings
                Servers = Val("&h" & StrToHex(StrReverse(Mid(Data, 9, 4))))
                Serversn = Val("&h" & StrToHex(StrReverse(Mid(Data, 13, 4))))
                MPQName = Mid(Data, 25, 12)
                Hash = Mid(Data, 38, Len(Data) - 2)
                Hash = Left(Hash, InStr(Hash, Chr(0)) - 1)
                MPQN = Mid(MPQName, 8, 1)
                AddC True, Form4.TALK, QBColor(8), "MPQ Name: " & MPQName
                AddC True, Form4.TALK, QBColor(8), "Hash: " & Hash
                AddC True, Form1.TALK, QBColor(8), "MPQ Name: " & MPQName
                AddC True, Form1.TALK, QBColor(8), "Hash: " & Hash
                If BNLSLogin Then
                    Servers = Val("&h" & StrToHex(StrReverse(Mid(Data, 9, 4))))
                    MPQName = Mid(Data, 25, 12)
                    Hash = Mid(Data, 38, Len(Data) - 2)
                    MPQN = Val(Mid(MPQName, 8, 1))
                    If VarProduct = "3RAW" Or VarProduct = "PX3W" Then
                        With pbuffer
                            '&H2
                            .InsertDWORD &H2
                            .SendBNLSPacket &HD
                            .InsertDWORD GetBNLSProdID(VarProduct)
                            .InsertDWORD CLng(MPQN)
                            .InsertNTString Hash
                            .SendBNLSPacket &H9
                        End With
                    Else
                        With pbuffer
                            .InsertDWORD GetBNLSProdID(VarProduct)
                            .InsertDWORD CLng(MPQN)
                            .InsertNTString Hash
                            .SendBNLSPacket &H9
                        End With
                    End If
                    Exit Sub
                End If
                send0x51 "" & Servers, "" & Serversn, "" & MPQName, "" & Hash, "" & MPQN
        Case &H3D
            Select Case Asc(Mid(Data, 5, 1))
                Case &H0
                    AddC True, Form1.TALK, vbGreen, "Account created!"
                    AddC True, Form4.TALK, vbGreen, "Account created!"
                    AddC True, Form4.TALK, QBColor(8), "Sending Username/Password..."
                    AddC True, Form1.TALK, QBColor(8), "Sending Username/Password..."
                    If H1EMethod = False And H50Method = True Or BNLSLogin = True Then
                        outb = String(7 * 4, vbNullChar)
                        RP = a(outb, Servers, varpass)
                        With pbuffer
                            .InsertNonNTString outb
                            .InsertNTString varUser
                            .SendPacket &H3A
                        End With
                    Else
                        SendUsernamePassword
                    End If
                Case &H1
                    AddC True, Form1.TALK, vbRed, "Account create failed: name too short"
                    AddC True, Form4.TALK, vbRed, "Account create failed: name too short"
                    On Error Resume Next
                    MDIForm1.winsock.Close
                    MDIForm1.BNLSSock.Close
                    MDIForm1.ReconnectTimer.Enabled = True
                Case &H2
                    AddC True, Form1.TALK, vbRed, "Account create failed: invalid characters"
                    AddC True, Form4.TALK, vbRed, "Account create failed: invalid characters"
                    On Error Resume Next
                    MDIForm1.winsock.Close
                    MDIForm1.BNLSSock.Close
                    MDIForm1.ReconnectTimer.Enabled = True
                Case &H3
                    AddC True, Form1.TALK, vbRed, "Account create failed: bad words"
                    AddC True, Form4.TALK, vbRed, "Account create failed: bad words"
                    On Error Resume Next
                    MDIForm1.winsock.Close
                    MDIForm1.BNLSSock.Close
                    MDIForm1.ReconnectTimer.Enabled = True
                Case &H4
                    AddC True, Form1.TALK, vbRed, "Account create failed: account exists"
                    AddC True, Form4.TALK, vbRed, "Account create failed: account exists"
                    On Error Resume Next
                    MDIForm1.winsock.Close
                    MDIForm1.BNLSSock.Close
                    MDIForm1.ReconnectTimer.Enabled = True
                Case Else
                    AddC True, Form1.TALK, vbRed, "Account create failed: unknown"
                    AddC True, Form4.TALK, vbRed, "Account create failed: unknown"
                    On Error Resume Next
                    MDIForm1.winsock.Close
                    MDIForm1.BNLSSock.Close
                    MDIForm1.ReconnectTimer.Enabled = True
            End Select
Case &H15
ProfileEnd = Mid(Data, 21, Len(Data))
SplitProfile = Split(ProfileEnd, Chr(0))
varLastAd = GetDWORD("" & SplitProfile(0))
'AddC True, Form1.TALK, vbBlue, "The adbanner is now: " & SplitProfile(0) & " [url=" & SplitProfile(1) & "]"
Case &HA
On Error Resume Next
If MDIForm1.socketudp.State = sckConnected Then
    With UDPBUF
        .SendPacket &H12
    End With
End If
Dim strss As String
News = True
Connected = True
ConnectionUptime = GetTickCount()
Dim spltn() As String
spltn() = Split(Data, Chr(0))
StatsString.ParseStatString spltn(2), strss
If VarProduct = "3RAW" Or VarProduct = "PX3W" Then spltn(1) = ParseChat.ConvertW3Name(spltn(1))
AddC True, Form4.TALK, vbGreen, "Logged on as: " & spltn(1)
AddC True, Form1.TALK, vbGreen, "Logged on as: " & spltn(1)
ConnectionUptime = GetTickCount()
MyName = spltn(1)
MDIForm1.ReconnectTimer.Interval = 5000
If MDIForm1.BNLSSock.State = sckConnected Then MDIForm1.BNLSSock.Close
Case &H0
pbuffer.SendPacket &H0
Case &H3A
Select Case Asc(Mid(Data, 5, 1))
    Case &H1, &H2
        AddC True, Form1.TALK, vbRed, "Login Failed!"
        AddC True, Form4.TALK, vbRed, "Login Failed!"
        AddC True, Form1.TALK, QBColor(8), "Attempting to create account..."
        AddC True, Form4.TALK, QBColor(8), "Attempting to create account..."
        SendCreateAccount varUser, varpass
    Case &H0

        If RealmLogin = True And VarProduct = "VD2D" Or VarProduct = "PX2D" Then
            With pbuffer
                .InsertDWORD &H0
                .InsertDWORD &H0
                .InsertBYTE &H0
                .SendPacket &H34
            End With
        Else
        AddC True, Form1.TALK, vbGreen, "Login Passed!"
        AddC True, Form4.TALK, vbGreen, "Login Passed!"
        With pbuffer
            .InsertNonNTString VarProduct
            .SendPacket &HB
            .InsertNTString varUser
            .InsertBYTE 0
            .SendPacket &HA
            .InsertDWORD 1
            .InsertNTString VarHome
            .SendPacket &HC
        End With
    End If
    End Select
Case &H5
    AddC True, Form1.TALK, QBColor(8), "Packet 0x05 received"
    AddC True, Form4.TALK, QBColor(8), "Packet 0x05 received"
Case &H4A
    ProfileEnd = Mid(Data, 1, Len(Data)) '17
    SplitProfile = Split(ProfileEnd, Chr(&H0))
    AddC True, Form1.TALK, QBColor(8), "0x4A Received: " & SplitProfile(1)
    AddC True, Form4.TALK, QBColor(8), "0x4A Received: " & SplitProfile(1)
Case Else
    If Len(PacketID) = 1 Then
        AddC True, Form1.TALK, vbWhite, "Unhandled Packet: 0x0" & Hex(PacketID)
        AddC True, Form4.TALK, vbWhite, "Unhandled Packet: 0x0" & Hex(PacketID)
    Else
        AddC True, Form1.TALK, vbWhite, "Unhandled Packet: 0x" & Hex(PacketID)
        AddC True, Form4.TALK, vbWhite, "Unhandled Packet: 0x" & Hex(PacketID)
    End If
End Select
End Sub
Public Sub Send0x50()
With pbuffer
.InsertDWORD &H0
.InsertNonNTString "68XI" & VarProduct
.InsertDWORD "&H" & verByte
.InsertDWORD &H0
.InsertDWORD &H0
.InsertDWORD &H480
.InsertDWORD &H1033
.InsertDWORD &H1033
.InsertNTString "USA"
.InsertNTString "United States"
.SendPacket &H50
If VarProduct <> "PX2D" And VarProduct <> "VD2D" And VarProduct <> "3RAW" And VarProduct <> "PX3W" Then
    .InsertDWORD &H0
    .SendPacket &H25
End If
End With
End Sub
Public Sub send0x51(Servers As String, Serversn As String, MPQName As String, Hash As String, MPQN As String)
'servers, serversn, MPQName, Hash, MPQN
Dim version As Long
Dim CheckSum As Long
Dim exeinfo As String
Dim Result As Long
Dim accounthash As String, r As String
Dim lngProdID As Long
Dim lngValue1 As Long
Dim lngValue2 As Long
Dim GTC As Long
Dim dblProdID As Double, dblValue1 As Double, dblValue2 As Double
GTC = 2140859764

exeinfo = Space(256)
Select Case VarProduct
    Case "VD2D"
        Result = Rape(App.Path & "\d2dv\game.exe", App.Path & "\d2dv\bnclient.dll", App.Path & "\d2dv\d2client.dll", Hash, version, CheckSum, exeinfo, MPQName)
    Case "PX2D"
        Result = Rape(App.Path & "\d2xp\game.exe", App.Path & "\d2xp\bnclient.dll", App.Path & "\d2xp\d2client.dll", Hash, version, CheckSum, exeinfo, MPQName)
    Case "NB2W"
        Result = Rape(App.Path & "\w2bn\Warcraft II BNE.exe", App.Path & "\w2bn\storm.dll", App.Path & "\w2bn\battle.snp", Hash, version, CheckSum, exeinfo, MPQName)
    Case "RATS", "PXES"
        Result = Rape(App.Path & "\star\Starcraft.exe", App.Path & "\star\storm.dll", App.Path & "\star\battle.snp", Hash, version, CheckSum, exeinfo, MPQName)
    Case "PX2D"
        Result = Rape(App.Path & "\d2xp\game.exe", App.Path & "\d2xp\bnclient.dll", App.Path & "\d2xp\d2client.dll", Hash, version, CheckSum, exeinfo, MPQName)
End Select
NullTruncString exeinfo
AddC True, Form1.TALK, QBColor(8), "Executable information: " & exeinfo
AddC True, Form4.TALK, QBColor(8), "Executable information: " & exeinfo
Call DecodeCDKey(varCDkey, dblProdID, dblValue1, dblValue2)
lngProdID = CLng(dblProdID)
lngValue1 = CLng(dblValue1)
lngValue2 = CLng(dblValue2)
Servers = CLng(Servers)
accounthash = String(5 * 4, vbNullChar)
r = c(accounthash, Servers, lngProdID, lngValue1, lngValue2, GTC)
With pbuffer
.InsertDWORD GTC
.InsertDWORD version
.InsertDWORD CheckSum
If VarProduct = "PX2D" Then
    .InsertDWORD &H2
Else
    .InsertDWORD &H1
End If
.InsertDWORD &H0
.InsertDWORD Len(varCDkey)
.InsertDWORD CLng(dblProdID)
.InsertDWORD CLng(dblValue1)
.InsertDWORD &H0
.InsertNonNTString accounthash
If VarProduct = "PX2D" Then
    Dim accountHash2 As String, r2 As String
    Dim lngProdID2 As Long
    Dim lngValue12 As Long
    Dim lngValue22 As Long
    Dim dblProdID2 As Double, dblValue12 As Double, dblValue22 As Double
    Call DecodeCDKey(varCDkey2, dblProdID2, dblValue12, dblValue22, True)
    lngProdID2 = CLng(dblProdID2)
    lngValue12 = CLng(dblValue12)
    lngValue22 = CLng(dblValue22)
    accountHash2 = String(5 * 4, vbNullChar)
    r2 = c(accountHash2, Servers, lngProdID2, lngValue12, lngValue22, GTC)
    .InsertDWORD Len(varCDkey2)
    .InsertDWORD CLng(dblProdID2)
    .InsertDWORD CLng(dblValue12)
    .InsertDWORD &H0
    .InsertNonNTString accountHash2
End If
.InsertNTString exeinfo
.InsertNTString varUser
.SendPacket &H51
End With
End Sub
Private Function getladder(Data As String) As String
getladder = GetDWORD(Mid(Data, CP, 4))
CP = CP + 4
getladder = getladder & "-" & GetDWORD(Mid(Data, CP, 4))
CP = CP + 4
getladder = getladder & "-" & GetDWORD(Mid(Data, CP, 4))
CP = CP + 4
getladder = getladder & " and is rated " & GetDWORD(Mid(Data, CP, 4))
CP = CP + 4
getladder = getladder & " with a rank of " & GetDWORD(Mid(Data, CP + 24, 4)) + 1
CP = CP + 64
getladder = Mid(Data, CP, InStr(CP, Data, Chr(0)) - CP) & "'s ladder stats are " & getladder
 CP = CP + Len(Mid(Data, CP, InStr(CP, Data, Chr(0)) - CP)) + 1
getladder = getladder & "."
End Function
Public Function FTtoDate(str As String) As Date
    Dim d As Currency
    CopyMemory d, ByVal str, 8
    
    Const DateDiff = -109205 '"Win32 day 0;" CDbl(#1/1/1601#)
    Const TicksPerDay = 86400000# '60 * 60 * 24 * 1000
    
    On Error Resume Next
    FTtoDate = CDate(d / TicksPerDay + DateDiff)
    If Err Then Exit Function
End Function
Public Function MKI(Data As String) As Integer
If Len(Data) < 2 Then
        Exit Function
    End If
    CopyMemory MKI, ByVal Data, 2
End Function

