Full Source .... Post Comments / Help

NetNX · January 25, 2004, 09:51 AM

This shit is not working ive been trying to implement 0x50 plz help ... yes its one modual .... i know im bad at this shhh....

Code Select

Option Explicit
Private Buffer As String
'Private Declare Function CheckRevision Lib "CheckRevision.dll" Alias "_CheckRevision@32" (ByVal FileExe As String, ByVal FileStormDll As String, ByVal FileBnetDll As String, ByVal HashText As String, ByRef version As Long, ByRef Checksum As Long, ByVal ExeInfo As String, ByVal mpqname As String) As Long
Private Declare Function a Lib "bnetauth.dll" Alias "A" (ByVal outbuf As String, ByVal ServerKey As Long, ByVal Password As String) As Long
Private Declare Function z Lib "bnetauth.dll" Alias "Z" (ByVal FileExe As String, ByVal FileStormDll As String, ByVal FileBnetDll As String, ByVal HashText As String, ByRef version As Long, ByRef Checksum As Long, ByVal ExeInfo As String, ByVal mpqname As String) As Long
Private Declare Function c Lib "bnetauth.dll" Alias "C" (ByVal outbuf As String, ByVal serverhash As Long, ByVal prodid As Long, ByVal val1 As Long, ByVal val2 As Long, ByVal Seed As Long) As Long
Private Declare Function GetTickCount Lib "kernel32.dll" () As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal numbytes As Long)
Private Declare Sub HashPass Lib "Hash.dll" Alias "?HashPassword@@YGXPBDHPAK1111@Z" (ByVal Password As String, ByVal nLength As Integer, ByRef lngSeed As Long, ByRef lngKey As Long, ByRef Value1 As Long, ByRef lngValue2 As Long, ByRef lngValue3 As Long)
Private Declare Sub HashCDKey Lib "Hash.dll" Alias "?HashCDKey@@YGXPAK0000@Z" (ByRef lngKey As Long, ByRef lngSeed As Long, ByRef lngProdID As Long, ByRef lngValue1 As Long, ByRef lngValue2 As Long)
Public NoVoid As Boolean, BinaryJoin As Boolean, HackVoid As Boolean, BlockUPD As Boolean, SpoofNeg As Boolean, SpoofZero As Boolean, UseProxy As Boolean, UseBNLS As Boolean, ProxyPort As Integer, ProxyServer As String, CDKEY As String, Product As String, EXPCDKEY As String, Server As String, Account As String, vPassword As String, HomeChannel As String
Public Chk As String
Public tmpe As String
Public sessionkey As Long
Private lastchan As String
Private matchwith As String
Private version As Long
Private Servers As Long
Private CdkeyHash As String
Private Cdkey2Hash As String
Private gtc As Long
Private exeN As String
Private varFiles As String
Private serverhash As String
Private hash As String, mpqname As String
Private serversn As Long
Private Checksum As Long
Private ExeInfo As String
Private ClientSessionKey As Long, ServerSessionKey As Long
Private Const CRC32_POLYNOMIAL As Long = &HEDB88320
Private CRC32Table(0 To 255) As Long

Dim HashCmd As String

Event CheckRevision(Message As String, Good As Boolean)
Event JoinChannel(Message As String)
Event UserEmotes(UserName As String, Flags As Long, Message As String)
Event UsersInChannel(UserName As String, Flags As Long, Message As String, Ping As Long)
Event UserJoinsChannel(UserName As String, Flags As Long, Message As String, Ping As Long)
Event UserLeavesChannel(UserName As String, Flags As Long)
Event UserTalks(UserName As String, Flags As Integer, Message As String, Ping As Integer)
Event BnetConnected()
Event BnetConnecting()
Event WisperFrom(UserName As String, Flags As Long, Message As String)
Event WisperTo(UserName As String, Flags As Long, Message As String, Ping As Long)
Event BnetInfo(Message As String)
Event BnetError(Message As String)
Event SocketError(Number As Long, Description As String)
Event BnetDisconnected()
Event BnetAthorized(ath As Boolean)
Event BnetCdkey(state As Integer, user As String)
Event FlagsUpdated(UserName As String, Flags As Long, Message As String, Ping As Long)
Event ProxyError(Message As String)
Event ProxyInfo(Message As String)

Private Function GetVerByte() As String
On Error Resume Next
 Select Case Product
        Case "RATS", "PXES"
            GetVerByte = "C7"
        Case "NB2W"
            GetVerByte = "4F"
        Case "VD2D", "PX2D"
            GetVerByte = "A"
        Case "3RAW", "PX3W"
            GetVerByte = "0D"
    End Select
End Function
Private Function GetEASN(Product) As Integer
On Error Resume Next
 Select Case Product
        Case "RATS"
            GetEASN = 1
        Case "PXES"
            GetEASN = 2
        Case "NB2W"
            GetEASN = 3
        Case "VD2D"
            GetEASN = 4
    End Select
End Function

Public Function GetBNLSByte() As Long
Select Case Product
    Case "RATS"
        GetBNLSByte = &H1
    Case "PXES"
        GetBNLSByte = &H2
    Case "PX2D"
        GetBNLSByte = &H5
    Case "VD2D"
        GetBNLSByte = &H4
    Case "NB2W"
        GetBNLSByte = &H3
    Case "3RAW"
        GetBNLSByte = &H7
    Case "PX3W"
        GetBNLSByte = &H8
End Select
End Function
Public Sub SendHeader()
    sckBnet.SendData Chr(1)
End Sub
Public Sub WC3Invite(UserName As String)
    InsertDWORD &H1
    InsertNTString UserName
    sendPacket &H77
    InsertDWORD &H0
    InsertDWORD &H0
    InsertDWORD &H0
    InsertDWORD &H0
    sendPacket &H15
End Sub
Public Sub WC3message(Message As String)
    InsertDWORD &H5
    sendPacket &H7C
    InsertDWORD &H0
    InsertNTString Message
    sendPacket &H7B
    InsertDWORD &H5
    sendPacket &H7C
    InsertDWORD &H0
    InsertDWORD &H0
    InsertDWORD &H0
    InsertDWORD &H0
    sendPacket &H15
End Sub
Public Sub WC3Promote(UserName As String)
    InsertDWORD &HB
    InsertNonNTString UserName
    InsertWORD &H3
    sendPacket &H7A
    InsertDWORD &H0
    InsertDWORD &H0
    InsertDWORD &H0
    InsertDWORD &H0
    sendPacket &H15
End Sub

Public Sub WC3demote(UserName As String)
    InsertDWORD &H1
    InsertNTString UserName
    InsertBYTE &H1
    sendPacket &H7A
    InsertDWORD &H0
    InsertDWORD &H0
    InsertDWORD &H0
    InsertDWORD &H0
    sendPacket &H15
End Sub

Public Sub WC3quit(UserName As String)
    InsertDWORD &H1
    InsertNTString UserName
    sendPacket &H78
    InsertDWORD &H0
    InsertDWORD &H0
    InsertDWORD &H0
    InsertDWORD &H0
    sendPacket &H15
End Sub

Public Sub p0x50()
    InsertDWORD 0
    InsertNonNTString "68XI" & Product
    InsertDWORD GetVerByte()
    InsertDWORD &H0
    InsertDWORD &H0
    InsertDWORD &H0
    InsertDWORD &H0
    InsertDWORD &H0
    InsertNTString "USA"
    InsertNTString "United States"
    sendPacket &H50
    If SpoofZero Then
        InsertDWORD &H0
        sendPacket &H25
    End If
End Sub

Private Sub p0x51()
            InsertDWORD gtc
            InsertDWORD version
            InsertDWORD Checksum
            If Product = "PX2D" Or Product = "PX3W" Then
                InsertDWORD &H2
            Else
                InsertDWORD &H1
            End If
            InsertDWORD &H0
            InsertNonNTString CdkeyHash
            If Product = "PX2D" Or Product = "PX3W" Then
                InsertNonNTString Cdkey2Hash
            End If
            InsertNTString ExeInfo
            InsertNTString "NXBotOCX"
            sendPacket &H51
End Sub

Public Sub SendCDKey(CDKEY As String)
On Error Resume Next
    Dim lngSeed As Long, lngKey As Long, lngProdID As Long, lngValue1 As Long, lngValue2 As Long, lngValue3 As Long
    Dim dblProdID As Double, dblValue1 As Double, dblValue2 As Double, dblSeed As Double, dblKey As Double
    dblSeed = Val("&h" & StrToHex(StrReverse(serverhash)))
    dblKey = GetTickCount()
    lngSeed = CLng(dblSeed)
    lngKey = CLng(dblKey)
    DecodeCDKey CDKEY, dblProdID, dblValue1, dblValue2
    lngProdID = CLng(dblProdID)
    lngValue1 = CLng(dblValue1)
    lngValue2 = CLng(dblValue2)
    Call HashCDKey(lngKey, lngSeed, lngProdID, lngValue1, lngValue2)
    InsertDWORD &H0
    InsertDWORD Len(CDKEY)
    InsertDWORD CLng(dblProdID)
    InsertDWORD CLng(dblValue1)
    InsertDWORD CLng(dblSeed)
    InsertDWORD CLng(dblKey)
    InsertDWORD lngKey
    InsertDWORD lngSeed
    InsertDWORD lngProdID
    InsertDWORD lngValue1
    InsertDWORD lngValue2
    InsertNTString "NXBotOCX"
    sendPacket &H36
End Sub
Public Sub SendUsernamePassword()
On Error Resume Next
    Dim dbseed As Double
    Dim dblKey As Double
    Dim dblSeed As Double
    Dim lngSeed As Long
    Dim lngKey As Long
    Dim lngValue1 As Long
    Dim lngValue2 As Long
    Dim lngValue3 As Long
    dblSeed = Val("&h" & StrToHex(StrReverse(serverhash)))
    dblKey = GetTickCount
    lngSeed = CLng(dblSeed)
    lngKey = CLng(dblKey)
    HashPass vPassword, Len(vPassword), lngKey, lngSeed, lngValue1, lngValue2, lngValue3
    InsertDWORD CLng(dblKey)
    InsertDWORD CLng(dblSeed)
    InsertDWORD lngKey
    InsertDWORD lngSeed
    InsertDWORD lngValue1
    InsertDWORD lngValue2
    InsertDWORD lngValue3
    InsertNTString Account
    sendPacket &H29
End Sub

'Public Sub ParseBNLS(ByVal data As String)
'Select Case Asc(Mid$(data, 3, 1))
'    Case &HE 'authorize
'        Dim key As Long, key2 As Long
'        key2 = GetDWORD(Mid(data, 4, 4))
'        key = BNLSChecksum(vbNullString, key2)
'        InsertDWORD key
'        sendBNLSPacket &HF
'
'    Case &HF 'authorize proof
'        If Product = "3RAW" Or Product = "PX3W" Then
'            InsertDWORD &H2
'            sendBNLSPacket &HD
'        End If
'        sckBnet.Close
'        If UseProxy Then
 '           addchat vbYellow, "SOCK: Connecting..."
'            sckBnet.Connect ProxyServer, 1080
'            Exit Sub
'        End If
'        sckBnet.Connect Server, 6112
'    Case &H9 'version check
'        version = Val("&H" & StrToHex(StrReverse(Mid(data, 8, 4))))
 '       version = CLng(version)
 '       checksum = Val("&H" & StrToHex(StrReverse(Mid(data, 12, 4))))
 ''       checksum = CLng(checksum)
'        exeinfo = Mid(data, 16, Len(data) - 16)
'        If Product = "PX2D" Or Product = "PX3W" Then
'            InsertDWORD &H0
'            InsertBYTE &H2
'            InsertDWORD &H1
'            InsertDWORD Servers
'            InsertNTString CDKEY
'            InsertNTString EXPCDKEY
'            sendBNLSPacket &HC
'        Else
'            InsertDWORD Servers
'            InsertNTString CDKEY
'            sendBNLSPacket &H1
'        End If
'    Case &H1 'bnls cdkey
'        CdkeyHash = Mid(data, 12)
'        GTC = Val("&H" & StrToHex(StrReverse(Mid(data, 8, 4))))
'        GTC = CLng(GTC)
'        p0x51
'    Case &HC 'bnls cdkey ex
 '       CdkeyHash = Mid(data, 18, 36)
 '       Cdkey2Hash = Mid(data, 58, 36)
'        GTC = Val("&H" & StrToHex(StrReverse(Mid(data, 14, 4))))
'        GTC = CLng(GTC)
'        p0x51
'    Case &H4 'create an account
'        InsertNonNTString Mid$(data, 4)
'        InsertNTString Account
'        sendPacket &H52
'    Case &H2 'logon challenge
'        InsertNonNTString Mid(data, 4)
'        InsertNTString Account
'        sendPacket &H53
'    Case &H3 'bnls logonproof
'        InsertNonNTString Mid(data, 4)
'        sendPacket &H54
'End Select
'End Sub

Public Sub parseBNET(ByVal data As String)
Dim PacketData As String
On Error Resume Next
Dim PacketId As Integer
Dim PacketLen As Integer
PacketLen = GetWORD(Mid(data, 3, 2))
If PacketLen > 0 Then PacketData = Mid(data, 5, PacketLen)
PacketId = Asc(Mid(data, 2, 1))

'If Form2.Option3.Value = True Then
'    Select Case packetid
'    Case &H50
'                Servers = Val("&h" & StrToHex(StrReverse(Mid(data, 9, 4))))
'                MPQName = Mid(data, 25, 12)
'                hash = Mid(data, 38, Len(data) - 2)
'                MPQName = Val(Mid(MPQName, 8, 1))
'                InsertDWORD GetBNLSByte()
'                InsertDWORD CLng(MPQName)
'                InsertNTString hash
'                sendBNLSPacket &H9
'    Case &H25
'        If Form2.normalping.Value = True Or Form2.botplug.Value = True Then
'            InsertNonNTString Mid(data, 5, 4)
'            sendPacket &H25
'        End If
'    Case &H51
'    Select Case GetWORD(Mid(data, 5, 2))
'        Case &H0
'            AddChat vbGreen, "BNET: (0x0000) Version and CD-key check passed!"
'                If Product = "3RAW" Or Product = "PX3W" Then
'                    InsertNTString Account
'                    InsertNTString vPassword
'                    sendBNLSPacket &H2
'                Else
'                    If Form2.botplug.Value = True Then
'                    Else
'                        InsertNonNTString "tenb"
'                        sendPacket &H14
'                        sendPacket &H2D
'                    End If
'                    tempb = String(7 * 4, vbNullChar)
'                    rb = A(tempb, Servers, vPassword)
'                    InsertNonNTString tempb
'                    InsertNTString Account
'                    sendPacket &H3A
'                End If
'        Case &H100
'            AddChat vbRed, "BNET: (0x0100) Game version recognized, but out of date!"
'        Case &H101
'            AddChat vbRed, "BNET: (0x0101) Game version unrecognized!"
'        Case &H200
'            AddChat vbRed, "BNET: (0x0200) Invalid CD-key!"
'        Case &H203
'            AddChat vbRed, "BNET: (0x0203) Invalid CD-key for this product!"
'        Case &H202
'            AddChat vbRed, "BNET: (0x0202) CD-key banned by Battle.net!"
'        Case &H201
'            AddChat vbRed, "BNET: (0x0201) CD-key in use: " & Mid(data, 9, Len(data) - 9)
'        End Select
'
'    Case &H3A
'        Select Case Asc(Mid(data, 5, 1))
'            Case &H1
'                AddChat vbRed, "BNET: (0x01) Logon failed!"
'            Case &H2
'                AddChat vbRed, "BNET: (0x02) Logon failed, due to incorrect password!"
'            Case &H0
'                AddChat vbGreen, "BNET: (0x00) Logon passed!"
'                    If Form2.Check5.Value = 1 Then
'                        InsertNTString Account
'                        InsertBYTE 0
'                        sendPacket &HA
'                        InsertNonNTString Product
'                        sendPacket &HB
'                        InsertDWORD 2
'                        InsertNTString HomeChannel
'                        sendPacket &HC
'                    Else
'                        InsertNTString Account
'                        InsertBYTE 0
'                        sendPacket &HA
'                        InsertNonNTString Product
'                        sendPacket &HB
'                        InsertDWORD 1
'                        InsertNTString "L"
'                        sendPacket &HC
'                    End If
'            Case Else
'                AddChat vbRed, "BNET: Unknown Account Logon Error!"
'        End Select
'    Case &HF
        'CHAT EVENTS!
'        chatevent = MakeLong(Mid$(data, 5, 4))
'        flags = MakeLong(Mid$(data, 9, 4))
'        ping = MakeLong(Mid$(data, 13, 4))
'        Username = KillNull(Mid$(data, 29))
'        message = KillNull(Mid$(data, Len(Username) + 30))
'        Select Case chatevent
'            Case 5 'chat
'                Call ontalk(Username, flags, message, ping)
'            Case 23 'emote
'                Call OnEmote(Username, flags, message)
'            Case 10 'whisper to
'                Call OnWhisperTo(Username, flags, message, ping)
'            Case 4 'whisper from
'                Call OnWhisperFrom(Username, flags, message)
'            Case 1 'users in channel
'                Call OnUser(Username, flags, message, ping)
'            Case 9 'flag change
'                Call OnFlags(Username, flags, message, ping)
'            Case 2 'user joins
'                Call OnJoin(Username, flags, message, ping)
'            Case 3 'userleaves
'                Call OnLeave(Username, flags)
'            Case 7 'channel joined
'                Call OnChannel(message)
'            Case 18 'information (including news)
'                Call OnInfo(message)
'            Case 19 'bnet error
'                Call OnError(message)
'        End Select
'    Case &H52
'        Select Case GetWORD(Mid(data, 5, 2))
'            Case &H0
'                    InsertNTString Account
'                    InsertNTString Password
'                    sendBNLSPacket &H2
'            End Select
'    Case &H53
'                InsertNonNTString Mid(data, 9, 64)
'                sendBNLSPacket &H3
'    Case &H54
'        Select Case GetWORD(Mid(data, 5, 2))
'            Case &H0
'                AddChat vbGreen, "BNET: (0x00) Logon passed!"
'                    If Form2.Check5.Value = 1 Then
'                        InsertNTString Account
'                        InsertBYTE 0
'                        sendPacket &HA
'                        InsertNonNTString Product
'                        sendPacket &HB
'                        InsertDWORD 2
'                        InsertNTString HomeChannel
'                        sendPacket &HC
'                    Else
'                        InsertNTString Account
'                        InsertBYTE 0
'                        sendPacket &HA
'                        InsertNonNTString Product
'                        sendPacket &HB
'                        InsertDWORD 1
'                        InsertNTString "L"
'                        sendPacket &HC
'                    End If
'            Case &H1
'                AddChat vbRed, "BNET: (0x01) Logon failed!"
'            Case &H2
'                AddChat vbRed, "BNET: (0x02) Logon failed, due to incorrect password!"
'        End Select
'    Case &H0
'        sendPacket &H0
'    Case &H15
'        AddChat vbGreen, "BNET: (0x15) WarCraft III Request Sent"
'    Case &H77
'        Select Case Asc(Right(data, 1))
'           Case &H0
'                AddChat vbGreen, "BNET: (0x00) Clan invitation accepted"
'            Case &H4
'                AddChat vbRed, "BNET: (0x04) Clan invitation rejected"
'           Case &H5
'                AddChat vbRed, "BNET: (0x05) Unacceptable clan invitation"
'        End Select
'    Case &H7A
'        Select Case Asc(Right(data, 1))
'            Case &H0
'                AddChat vbGreen, "BNET: (0x00) User Demoted/Promoted"
'            Case &H7
'                AddChat vbRed, "BNET: (0x07) You are not authorized to demote/promote users"
'            End Select
'    Case &H78
'        Select Case Asc(Right(data, 1))
'            Case &H0
'                AddChat vbGreen, "BNET: (0x00) User exiled"
'            Case &H7
'                AddChat vbRed, "BNET: (0x07) You are not authorized to exile users"
'            End Select
'End Select
'End If
addText PacketId, vbYellow
If Not UseBNLS Then
    Select Case PacketId
    Case &H6
            Dim d As String, mpqend As String
            d = data
            Servers = Val("&h" & StrToHex(StrReverse(Mid(data, 9, 4))))
            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)
            Dim Result As Long
            Dim ExeInfo As String
            Dim Accounthash As String
            
           ' If Product = "RATS" Or "PXES" Or "NB2W" Then
                InsertNonNTString "68XI" & Product
                InsertDWORD "&H" & GetVerByte()

                ExeInfo = Space(256)
                Select Case Product
                    Case "RATS", "PXES"
                        Result = z(App.Path & "\star\Starcraft.exe", App.Path & "\star\storm.dll", App.Path & "\star\battle.snp", hash, version, Checksum, ExeInfo, mpqname)
                    Case "NB2W"
                        Result = z(App.Path & "\war2\Warcraft II BNE.exe", App.Path & "\war2\storm.dll", App.Path & "\war2\battle.snp", hash, version, Checksum, ExeInfo, mpqname)
                    Case "VD2D"
                        Result = z(App.Path & "\d2dv\game.exe", App.Path & "\d2dv\bnclient.dll", App.Path & "\d2dv\d2client.dll", hash, version, Checksum, ExeInfo, mpqname)
                    Case Else
                        RaiseEvent CheckRevision("There are no hashes for the product you are connecting with", False)
                End Select
                Accounthash = String(5 * 4, vbNullChar)
                
                InsertDWORD version
                InsertDWORD Checksum
                NullTruncString ExeInfo
                InsertNonNTString Accounthash
                InsertNTString ExeInfo
                
                If ExeInfo = Space(256) Then
                    Clear
                    RaiseEvent CheckRevision("Check CallRevision() Failed", False)
                    Call sckbnet_Close
                    Exit Sub
                End If
                sendPacket 7
            'End If
            
        '    If Product = "VD2D" Then
            'p0x5
         '   End If
            
    Case &H7
        Dim strdata As String
        strdata = Mid(data, 5, 1)
        Select Case strdata
            Case Chr(2)
                sendPacket &H2D
                If BlockUPD Then
                Else
                    InsertNonNTString "tenb"
                    sendPacket &H14
                End If
            Case Chr(0)
                RaiseEvent CheckRevision("Hashes Rejected", False)
            Case Else
                RaiseEvent CheckRevision("Unknown Verification Return Value, possibly due to battle.net updates", False)
                Call sckbnet_Close
        End Select
    Case &H1D
            serverhash = Right(data, 4)
    Case &H2D
            SendCDKey CDKEY
    Case &H30, &H36
            Select Case Mid(data, 5, 1)
                Case Chr(1)
                    'addchat vbGreen, "BNET: (0x0000) Version and CD-key check passed!"
                    RaiseEvent BnetCdkey(1, "")
                    SendUsernamePassword
                Case Chr(2)
                    'addchat vbRed, "BNET: (0x0200) Invalid CD-key!"
                    RaiseEvent BnetCdkey(2, "")
                    Call sckbnet_Close
                Case Chr(3)
                    RaiseEvent BnetCdkey(3, "")
                    'addchat vbRed, "BNET: (0x0203) Invalid CD-key for this product!"
                    Call sckbnet_Close
                Case Chr(4)
                    RaiseEvent BnetCdkey(4, "")
                    'addchat vbRed, "BNET: (0x0202) CD-key banned by Battle.net!"
                    Call sckbnet_Close
                Case Chr(5)
                    RaiseEvent BnetCdkey(5, Mid(data, 9, Len(data) - 9))
                    'addchat vbRed, "BNET: (0x0201) CD-key in use: " & Mid(data, 9, Len(data) - 9)
                    Call sckbnet_Close
            End Select
    Case &H29
              If Mid(data, 5, 1) = Chr(1) Then
                RaiseEvent BnetAthorized(True)
                    If HackVoid Then
                        InsertNTString Account
                        InsertBYTE 0
                        sendPacket &HA
                        InsertNonNTString Product
                        sendPacket &HB
                        InsertDWORD 2
                        InsertNTString HomeChannel
                        sendPacket &HC
                    Else
                        InsertNTString Account
                        InsertBYTE 0
                        sendPacket &HA
                        InsertNonNTString Product
                        sendPacket &HB
                        InsertDWORD 1
                        InsertNTString "L"
                        sendPacket &HC
                    End If
              Else
                RaiseEvent BnetAthorized(False)
                Call sckbnet_Close
              End If
    Case &HA
            Dim spltn() As String
            spltn() = Split(data, Chr(0), 5)
            'varuser1 = spltn(1)
    Case &HF
        'CHAT EVENTS!
        Dim chatevent As String
        Dim Flags As String
        Dim Ping As String
        Dim UserName As String
        Dim Message As String
        chatevent = MakeLong(Mid$(data, 5, 4))
        Flags = MakeLong(Mid$(data, 9, 4))
        Ping = MakeLong(Mid$(data, 13, 4))
        UserName = KillNull(Mid$(data, 29))
        Message = KillNull(Mid$(data, Len(UserName) + 30))
        Select Case chatevent
            Case 5 'chat
                Call ontalk(UserName, Flags, Message, Ping)
            Case 23 'emote
                Call OnEmote(UserName, Flags, Message)
            Case 10 'whisper to
                Call OnWhisperTo(UserName, Flags, Message, Ping)
            Case 4 'whisper from
                Call OnWhisperFrom(UserName, Flags, Message)
            Case 1 'users in channel
                Call OnUser(UserName, Flags, Message, Ping)
            Case 9 'flag change
                Call OnFlags(UserName, Flags, Message, Ping)
            Case 2 'user joins
                Call OnJoin(UserName, Flags, Message, Ping)
            Case 3 'userleaves
                Call OnLeave(UserName, Flags)
            Case 7 'channel joined
                Call OnChannel(Message)
            Case 18 'information (including news)
                Call OnInfo(Message)
            Case 19 'bnet error
                Call OnError(Message)
        End Select
    Case &H25
        'If Form2.normalping.Value = True Or Form2.botplug.Value = True Then
        If BlockUPD = True Or (SpoofZero = False And BlockUPD = False) Then
            InsertNonNTString Mid(data, 5, 4)
            sendPacket &H25
        End If
    Case &H0
        sendPacket &H0
    Case &H50
            mpqname = Mid(PacketData, 21, 12)
            HashCmd = Mid(PacketData, 34, PacketLen - 26)
            HashCmd = KillNull(HashCmd)
            sessionkey = GetDWORD(Mid(PacketData, 5, 4))
            addText "Checking game version..." & vbCrLf, vbYellow
            Sendx51
    Case &H51
            If GetDWORD(PacketData) = &H1 Then
                SendPacket53
            Else
                addText "CheckRevision() Failed.", vbRed
                sckBnet.Close
            End If
End Select
End If
End Sub
Private Sub SendPacket53()
Dim PasswordHashKey As String
PasswordHashKey = MAKE_Login(UserName, Password, sessionkey)

    InsertNonNTString PasswordHashKey
    sendPacket &H53
End With
End Sub

Public Sub Send1E()
    InsertDWORD 1
    InsertDWORD 0
    InsertDWORD 0
    InsertDWORD 0
    InsertDWORD 1
    InsertNTString "0x25"
    InsertNTString "0x25"
    sendPacket &H1E
    InsertNonNTString "68XI" & Product
    InsertDWORD "&H" & GetVerByte()
    InsertDWORD 0
    sendPacket &H6
    If SpoofZero = True Then
        InsertDWORD &H0
        sendPacket &H25
    End If
End Sub

Public Sub Sendx50()
addText "sending 50", vbWhite
sckBnet.SendData Chr(1)
InsertDWORD 0
'MsgBox Product
InsertNonNTString "68XI" & Product
'InsertDWORD Product
InsertDWORD "&H" & GetVerByte()
InsertDWORD 0
InsertDWORD &HD87EBD4D
InsertDWORD &HA4010000
InsertDWORD &H9040000
InsertDWORD &H9040000
InsertNTString "USA"
InsertNTString "United States"
sendPacket &H50
'InsertDWORD &H0
'InsertNonNTString "68XI" & Product
'InsertDWORD GetVerByte()
'InsertDWORD &H0
'InsertDWORD &H0
'InsertDWORD &H0
'InsertDWORD &H0
'InsertDWORD &H0
'InsertNTString "USA"
'InsertNTString "United States"
'sendPacket &H50
    'InsertDWORD 0
    'InsertNonNTString "68XI" & Product
    'InsertDWORD GetVerByte()
    'InsertDWORD &H0
    'InsertDWORD &H0
    'InsertDWORD &H0
    'InsertDWORD &H0
    'InsertDWORD &H0
    'InsertNTString "USA"
    'InsertNTString "United States"
    'sendPacket &H50
    If SpoofZero Then
        InsertDWORD &H0
        sendPacket &H25
        addText "sending 25", vbWhite
    End If
addText "Sent50", vbYellow
End Sub
Public Sub Sendx51()
addText "sending 51", vbYellow
Dim mikeys As Long
Dim gtc As Long
Dim VarCdkey As Long
Dim Path As String
Dim GameExe As String
Dim version As Long
Dim Checksum As Long
Dim ExeInfo As String
Dim dblProdID As Double, dblValue1 As Double, dblValue2 As Double
Dim lngProdID As Long, lngValue1 As Long, lngValue2 As Long, lngKey As Long
Dim WeirdUnkown As Long
Dim Seed As Long
Dim outbuf As String
Dim Result As Long
Dim i As Integer
ExeInfo = Space(256)
'WeirdUknown = &H1000903
Select Case Product
                    Case "RATS", "PXES"
                        Result = z(App.Path & "\star\Starcraft.exe", App.Path & "\star\storm.dll", App.Path & "\star\battle.snp", hash, version, Checksum, ExeInfo, mpqname)
                    Case "NB2W"
                        Result = z(App.Path & "\war2\Warcraft II BNE.exe", App.Path & "\war2\storm.dll", App.Path & "\war2\battle.snp", hash, version, Checksum, ExeInfo, mpqname)
                    Case "VD2D"
                        Result = z(App.Path & "\d2dv\game.exe", App.Path & "\d2dv\bnclient.dll", App.Path & "\d2dv\d2client.dll", hash, version, Checksum, ExeInfo, mpqname)
                    Case Else
                        RaiseEvent CheckRevision("There are no hashes for the product you are connecting with", False)
                End Select
ExeInfo = KillNull(ExeInfo)
Seed = GetTickCount()
'MAKE_CDKey
lngKey = Seed

mikeys = 1
  InsertDWORD Seed
  InsertDWORD &H1000903
  InsertDWORD (version)
  '.InsertDWORD (Checksum)
  InsertDWORD CLng(mikeys)
  InsertDWORD 0 'no spawn
  For i = 1 To mikeys
    If i = 1 Then
        Call DecodeCDKey(CDKEY, dblProdID, dblValue1, dblValue2)
    Else
        Call DecodeCDKey(EXPCDKEY, dblProdID, dblValue1, dblValue2)
    End If
    lngKey = Seed
    lngProdID = CLng(dblProdID)
    lngValue1 = CLng(dblValue1)
    lngValue2 = CLng(dblValue2)
    'Call HashCDKey(lngKey, sessionkey, lngProdID, lngValue1, lngValue2)
    'Result = c(outbuf, sessionkey, lngProdID, lngValue1, lngValue2, lngKey)
    MsgBox outbuf
    InsertDWORD Len(CDKEY)
    InsertDWORD CLng(dblProdID)
    InsertDWORD CLng(dblValue1)
    InsertDWORD &H0
    InsertDWORD lngKey         'Hash Pt1
    InsertDWORD sessionkey     'Hash Pt2
    InsertDWORD lngProdID      'Hash Pt3
    InsertDWORD lngValue1      'Hash Pt4
    InsertDWORD lngValue2      'Hash Pt5
  Next i
 InsertNTString ExeInfo
 InsertNTString Account
 'MsgBox .GetPacket(&H51)
 sendPacket &H51
 End Sub
Public Sub send(ByVal data As String)
    InsertNTString data
    sendPacket &HE
End Sub
Public Function InsertDWORDArray(data() As Long)
    Dim i As Integer
    For i = LBound(data) To UBound(data) Step 1
        Buffer = Buffer & MakeDWORD(data(i))
    Next i
End Function

Public Function InsertDWORD(data As Long)
    Buffer = Buffer & MakeDWORD(data)
End Function

Public Function InsertData(data As String)
    Buffer = Buffer & data
End Function

Public Function InsertWORD(data As Integer)
    Buffer = Buffer & MakeWORD(data)
End Function

Public Function InsertBYTE(data As Integer)
    Buffer = Buffer & Chr(data)
End Function

Public Sub InsertBytes(data As String)
    Dim i As Long
    Dim enqueueer As String
    
    For i = 1 To Len(data) Step 3
        enqueueer = enqueueer & Chr(Val("&h0" & Mid(data, i, 2)))
    Next i
    Buffer = Buffer & enqueueer
End Sub

Public Function InsertNTString(data As String)
    Buffer = Buffer & data & Chr(0)
End Function

Public Function InsertNonNTString(data As String)
    Buffer = Buffer & data
End Function

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

Public Function MakeWORD(Value As Integer) As String
    Dim Result As String * 2
    CopyMemory ByVal Result, Value, 2
    MakeWORD = Result
End Function

Private Function Clear()
    Buffer = vbNullString
End Function

Public Function sendPacket(PacketId As Byte)
    Dim PacketData As String
    Dim Packet As String
If sckBnet.state <> sckConnected Then: Exit Function
   sckBnet.SendData Chr(&HFF) & Chr(PacketId) & MakeWORD(Len(Buffer) + 4) & Buffer
     Clear
End Function
'Public Function sendEASNPacket(packetid As String)
'    If sckEASN.State <> sckConnected Then: Exit Function
'    sckEASN.SendData Chr(&HCE) & " " & packetid & " " & Buffer
'    Buffer = ""
'End Function
Private Function relaypacket(data As String)
    If sckBnet.state <> sckConnected Then: Exit Function
    sckBnet.SendData data
    Buffer = ""
End Function
Public Function sendBNLSPacket(PacketId As Byte)
    If sckBNLS.state <> sckConnected Then: Exit Function
       sckBNLS.SendData MakeWORD(Len(Buffer) + 3) & Chr(PacketId) & Buffer
         Clear
End Function

Private Function GetDWORD(data As String) As Long
Dim lReturn As Long
    Call CopyMemory(lReturn, ByVal data, 4)
    GetDWORD = lReturn
End Function

Private Function GetWORD(data As String) As Long
Dim lReturn As Long
    Call CopyMemory(lReturn, ByVal data, 2)
    GetWORD = lReturn
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 MakeLong(X As String) As Long
    If Len(X) < 4 Then
        Exit Function
    End If
    CopyMemory MakeLong, ByVal X, 4
End Function

'events
Private Sub ontalk(ByVal UserName As String, ByVal Flags As Integer, ByVal Message As String, ByVal Ping As Integer)
RaiseEvent UserTalks(UserName, Flags, Message, Ping)
End Sub

Private Sub OnEmote(ByVal UserName As String, ByVal Flags As Long, ByVal Message As String)
RaiseEvent UserEmotes(UserName, Flags, Message)
End Sub

Public Sub OnChannel(ByVal Message As String)
RaiseEvent JoinChannel(Message)
    If InStr(1, "The Void", Message) And NoVoid Then send "/join " & HomeChannel
End Sub

Private Sub OnUser(ByVal UserName As String, ByVal Flags As Long, ByVal Message As String, ByVal Ping As Long)
RaiseEvent UsersInChannel(UserName, Flags, Message, Ping)
End Sub

Private Sub OnJoin(ByVal UserName As String, ByVal Flags As Long, ByVal Message As String, ByVal Ping As Long)
RaiseEvent UserJoinsChannel(UserName, Flags, Message, Ping)
End Sub
Private Sub OnLeave(ByVal UserName As String, ByVal Flags As Long)
RaiseEvent UserLeavesChannel(UserName, Flags)
End Sub

Private Sub OnWhisperFrom(ByVal UserName As String, ByVal Flags As Long, ByVal Message As String)
RaiseEvent WisperFrom(UserName, Flags, Message)
End Sub

Private Sub OnWhisperTo(ByVal UserName As String, ByVal Flags As Long, ByVal Message As String, ByVal Ping As Long)
RaiseEvent WisperTo(UserName, Flags, Message, Ping)
End Sub

Private Sub OnInfo(ByVal Message As String)
RaiseEvent BnetInfo(Message)
End Sub

Private Sub OnFlags(ByVal UserName As String, ByVal Flags As Long, ByVal Message As String, ByVal Ping As Long)
RaiseEvent FlagsUpdated(UserName, Flags, Message, Ping)
End Sub
Private Sub OnError(ByVal Message As String)
RaiseEvent BnetError(Message)
End Sub

'Private Sub sckBNLS_Close()
'    sckBNLS.Close
'End Sub
'Private Sub sckBNLS_Connect()
'addchat vbGreen, "BNLS: Connected"
'InsertNTString vbNullString
'sendBNLSPacket &HE
'End Sub
'Private Sub sckBNLS_DataArrival(ByVal bytesTotal As Long)
'     Dim strTemp As String
'     sckBNLS.GetData strTemp, vbString
'     addchat vbGreen, strTemp
'     ParseBNLS (strTemp)
'End Sub
Private Sub sckbnet_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
Dim numberb As Long
numberb = Number
RaiseEvent SocketError(numberb, Description)
Call sckbnet_Close
End Sub
Private Sub sckbnet_Close()
RaiseEvent BnetDisconnected
End Sub
Private Sub sckbnet_DataArrival(ByVal bytesTotal As Long)
    If UseProxy Then
        Static strbuffer As String
        Dim strTemp As String, lnglen As Long
        sckBnet.GetData strTemp, vbString
            Select Case Mid(strTemp, 1, 2)
            Case Chr(&H0) & Chr(&H5A)
                RaiseEvent ProxyInfo("SOCK Request Granted")
                'If Form2.Option3.Value = True Then
                '    SendHeader
                '    p0x50
                'End If
                If Not UseBNLS Then
                    SendHeader
                    Send1E
                End If
                Exit Sub
            Case Chr(&H0) & Chr(&H5B)
                RaiseEvent ProxyError("SOCK Request Rejected Or Failed")
                Call sckbnet_Close
                Exit Sub
            Case Chr(&H0) & Chr(&H5C)
                RaiseEvent ProxyError("SOCK Request Rejected Because SOCKS server cannot IDENT on the client")
                Call sckbnet_Close
                Exit Sub
            Case Chr(&H0) & Chr(&H5D)
                RaiseEvent ProxyError("SOCK Request Rejected Because the Client Program and the ID Report Different User-IDs")
                Call sckbnet_Close
                Exit Sub
            End Select
    strbuffer = strbuffer & strTemp
    While Len(strbuffer) > 4
        lnglen = Val("&H" & StrToHex(StrReverse(Mid$(strbuffer, 3, 2))))
        If Len(strbuffer) < lnglen Then Exit Sub
        parseBNET (Left$(strbuffer, lnglen))
        strbuffer = Mid$(strbuffer, lnglen + 1)
    Wend
    Else
        sckBnet.GetData strTemp, vbString
        strbuffer = strbuffer & strTemp
        While Len(strbuffer) > 4
          lnglen = Val("&H" & StrToHex(StrReverse(Mid(strbuffer, 3, 2))))
          If Len(strbuffer) < lnglen Then Exit Sub
           parseBNET (Left(strbuffer, lnglen))
          strbuffer = Mid(strbuffer, lnglen + 1)
        Wend
    End If
End Sub
Private Sub sckBnet_connect()
On Error Resume Next
    'addchat vbGreen, "BNET: Connected"
    RaiseEvent BnetConnected
    'If Form2.Proxy.Value = 1 Then
    '    Dim splt() As String, str As String, i As Integer
    '    varServer = LCase(varServer)
    '    splt = Split(varServer, ".")
    '        For i = 0 To UBound(splt)
    '            str = str & Chr(CStr(splt(i)))
    '        Next i
    '    sckBnet.SendData Chr(&H4) & Chr(&H1) & Chr(&H17) & Chr(&HE0) & str & "anonymous" & Chr(&H0)
    '    AddChat vbGreen, "Socks Connect!"
    'End If
    'If Form2.Option3.Value = True Then
    '    SendHeader
    '    p0x50
    'End If
    'HASHING
        If Product = "NB2W" Then
        SendHeader
        Send1E
        Else
        addText "um well lets send 50 i guess....", vbYellow
        Sendx50
        End If
        'p0x50
    'If Form2.Option13.Value = True Then
    '    InsertNonNTString "Dark-Feanor" & "|" & "62dark46"
    '    sendEASNPacket 7
    'End If
End Sub

'strings.bas
Private Function HexToStr(ByVal Hex1 As String) As String
On Error Resume Next
    Dim strTemp As String, strReturn As String, i As Long
    If Len(Hex1) Mod 2 <> 0 Then Exit Function
    For i = 1 To Len(Hex1) Step 2
    strReturn = strReturn & Chr(Val("&H" & Mid(Hex1, i, 2)))
    Next i
    HexToStr = strReturn
End Function
Private Function GetHexValue(ByVal v As Long) As String
    v = v And &HF
    If v < 10 Then
        GetHexValue = Chr$(v + &H30)
    Else
        GetHexValue = Chr$(v + &H37)
    End If
End Function
Private Function GetNumValue(ByVal c As String) As Long
On Error Resume Next
    c = UCase(c)
    If IsNumeric(c) Then
        GetNumValue = Asc(c) - &H30
    Else
        GetNumValue = Asc(c) - &H37
    End If
End Function
Public Function StrToHex(ByVal string1 As String) As String
On Error Resume Next
    Dim strTemp As String, strReturn As String, i As Long
    For i = 1 To Len(string1)
        strTemp = Hex(Asc(Mid(string1, i, 1)))
    If Len(strTemp) = 1 Then strTemp = "0" & strTemp
    strReturn = strReturn & " " & strTemp
    Next i
        StrToHex = strReturn
End Function

Public Sub DecodeCDKey(ByVal sCDKey As String, ByRef dProductId As Double, ByRef dValue1 As Double, ByRef dValue2 As Double)
On Error Resume Next
    sCDKey = Replace(sCDKey, "-", "")
    sCDKey = Replace(sCDKey, " ", "")
    sCDKey = KillNull(sCDKey)
    
    If Len(sCDKey) = 13 Then
        sCDKey = DecodeStarcraftKey(sCDKey)
    ElseIf Len(sCDKey) = 16 Then
        sCDKey = DecodeD2Key(sCDKey)
    Else
        Exit Sub
    End If
    
    dProductId = Val("&H" & Left$(sCDKey, 2))
    
    If Len(sCDKey) = 13 Then
        dValue1 = Val(Mid$(sCDKey, 3, 7))
        dValue2 = Val(Mid$(sCDKey, 10, 3))

    ElseIf Len(sCDKey) = 16 Then
        dValue1 = Val("&H" & Mid$(sCDKey, 3, 6))
        dValue2 = Val("&H" & Mid$(sCDKey, 9))
    End If
    
End Sub

Private Function DecodeD2Key(ByVal key As String) As String
    Dim R As Double, n As Double, n2 As Double, v As Double, _
    v2 As Double, keyvalue As Double, c1 As Byte, c2 As Byte, _
    c As Byte, bValid As Boolean, i As Integer, aryKey(0 To 15) As String, _
    codevalues As String
    codevalues = "246789BCDEFGHJKMNPRTVWXZ"
    R = 1
    keyvalue = 0
    For i = 1 To 16
        aryKey(i - 1) = Mid$(key, i, 1)
    Next i
    For i = 0 To 15 Step 2
        c1 = InStr(1, codevalues, aryKey(i)) - 1
        If c1 = -1 Then c1 = &HFF
        n = c1 * 3
        c2 = InStr(1, codevalues, aryKey(i + 1)) - 1
        If c2 = -1 Then c2 = &HFF
        n = c2 + n * 8
        If n >= &H100 Then
            n = n - &H100
            keyvalue = keyvalue Or R
        End If
        n2 = n
        n2 = RShift(n2, 4)
        aryKey(i) = GetHexValue(n2)
        aryKey(i + 1) = GetHexValue(n)
        R = LShift(R, 1)
Cont:
    Next i
    v = 3
    For i = 0 To 15
        c = GetNumValue(aryKey(i))
        n = Val(c)
        n2 = v * 2
        n = n Xor n2
        v = v + n
    Next i
    v = v And &HFF
    For i = 15 To 0 Step -1
        c = Asc(aryKey(i))
        If i > 8 Then
            n = i - 9
        Else
            n = &HF - (8 - i)
        End If
        n = n And &HF
        c2 = Asc(aryKey(n))
        aryKey(i) = Chr$(c2)
        aryKey(n) = Chr$(c)
    Next i
    v2 = &H13AC9741
    For i = 15 To 0 Step -1
        c = Asc(UCase(aryKey(i)))
        aryKey(i) = Chr$(c)
        If Val(c) <= Asc("7") Then
            v = v2
            c2 = v And &HF
            c2 = c2 And 7
            c2 = c2 Xor c
            v = RShift(v, 3)
            aryKey(i) = Chr$(c2)
            v2 = v
        ElseIf Val(c) < Asc("A") Then
            c2 = CByte(i)
            c2 = c2 And 1
            c2 = c2 Xor c
            aryKey(i) = Chr$(c2)
        End If
    Next i
    DecodeD2Key = Join(aryKey, "")
    Erase aryKey()
End Function

Private Function DecodeStarcraftKey(ByVal sKey As String) As String
On Error Resume Next
    Dim R As Double, n As Double, n2 As Double, v As Double, _
    v2 As Double, keyvalue As Double, c1 As Byte, c2 As Byte, c As Byte, _
    bValid As Boolean, i As Integer, aryKey(0 To 12) As String
    
    For i = 1 To 13
    
        aryKey(i - 1) = Mid$(sKey, i, 1)
    Next i
    v = 3
    For i = 0 To 11
        c = aryKey(i)
        n = Val(c)
        n2 = v * 2
        n = n Xor n2
        v = v + n
    Next i
    v = v Mod 10
    If Hex(v) = aryKey(12) Then
        bValid = True
    End If
    v = 194
    For i = 11 To 0 Step -1
        If v < 7 Then GoTo continue
        c = aryKey(i)
        n = CInt(v / 12)
        n2 = v Mod 12
        v = v - 17
        c2 = aryKey(n2)
        aryKey(i) = c2
        aryKey(n2) = c
    Next i
continue:
    v2 = &H13AC9741
    For i = 11 To 0 Step -1
        c = UCase$(aryKey(i))
        aryKey(i) = c
        If Asc(c) <= Asc("7") Then
            v = v2
            c2 = v And &HFF
            c2 = c2 And 7
            c2 = c2 Xor c
            v = RShift(CLng(v), 3)
            aryKey(i) = c2
            v2 = v
        ElseIf Asc(c) < 65 Then
            c2 = CByte(i)
            c2 = c2 And 1
            c2 = c2 Xor c
            aryKey(i) = c2
        End If
    Next i
    DecodeStarcraftKey = Join(aryKey, "")
    Erase aryKey()
End Function

Public Function LShift(ByVal pnValue As Long, ByVal pnShift As Long) As Double
On Error Resume Next
LShift = CDbl(pnValue * (2 ^ pnShift))
End Function


Public Function RShift(ByVal pnValue As Long, ByVal pnShift As Long) As Double
On Error Resume Next
RShift = CDbl(pnValue \ (2 ^ pnShift))
End Function

Private Function Hex2Dec(ByVal sHex As String) As Long
On Error Resume Next
    Dim i As Integer
    Dim nDec As Long
    Const HexChar As String = "0123456789ABCDEF"
    For i = Len(sHex) To 1 Step -1
        nDec = nDec + (InStr(1, HexChar, Mid(sHex, i, 1)) - 1) * 16 ^ (Len(sHex) - i)
    Next i
    Hex2Dec = CStr(nDec)
End Function
Public Function KillNull(ByVal text As String) As String
    Dim i As Integer
    i = InStr(1, text, Chr(0))
    If i = 0 Then
        KillNull = text
        Exit Function
    End If
    KillNull = Left(text, i - 1)
End Function
Public Sub NullTruncString(ByRef text As String)
On Error Resume Next
    Dim i As Integer
    
    i = InStr(text, Chr(0))
    If i = 0 Then Exit Sub
    
    text = Left(text, i - 1)
End Sub
Public Sub Connect()
If Chk = Chr(78) & Chr(101) & Chr(116) & Chr(78) & Chr(88) & Chr(49) & Chr(51) & Chr(51) & Chr(55) & Chr(126) & Chr(49) & Chr(59) Then
If Not UseBNLS Then
    If UseProxy Then
        RaiseEvent ProxyInfo("SOCK: Connecting...")
        If ProxyPort = 0 Then ProxyPort = 1080
        sckBnet.Connect ProxyServer, ProxyPort
        Exit Sub
    End If
        RaiseEvent BnetConnecting
        sckBnet.Close
        sckBnet.Connect Server, 6112
End If
Else
Do
MsgBox "GAY?", vbCritical, "Stupid F4GG07!"
Loop
End If
Chk = ""
End Sub

Public Sub Disconnect()
Call sckbnet_Close
RaiseEvent BnetDisconnected
End Sub


Private Sub UserControl_Resize()
Width = 2535
Height = 975
End Sub

Public Function state()
state = sckBnet.state
End Function

Public Sub addText(ByVal txtOne As String, ByVal clrOne As Long, Optional ByVal txtTwo As String, Optional ByVal clrTwo As Long, Optional strType As String)
Call frmBt.addText(txtOne, clrOne, txtTwo, clrTwo, strType)
End Sub

[Kp edit: fixed his code tags. Resisted temptation to delete the entire source and force it to be posted in a stand alone file linked from this message.]

Adron · January 25, 2004, 09:55 AM

Maybe lowercase code tags would work better? I don't know..

ChR0NiC · January 25, 2004, 10:00 AM

I noticed you already have the [ code ] and [ /code ]
but it has to be in lower case ok?? Please make the change

Dark-Feanor · January 25, 2004, 11:34 AM

Wow that source code looks familar. It looks like you fucked it up. What incoherancy. Try redownloading the source: http://www.blizzside.com/feanor/firebot1.8source.zip

MyndFyre · January 25, 2004, 04:53 PM

those Declares are BEAUTIFUL!!!!

Grok · January 25, 2004, 08:01 PM

Quote from: Myndfyre on January 25, 2004, 04:53 PM
those Declares are BEAUTIFUL!!!!

So this is a case of newbie posting someone else's code and saying "fix it"?

iago · January 25, 2004, 08:42 PM

haha @ kp's edit.

I would strongly recommend breaking that code into different files/classes/whatever, it would be a lot clearer.

ObsidianWolf · January 25, 2004, 08:44 PM

Looks like it. Perhaps they chobo programmer....would care to say something like Please. Perhaps some sweet words, lack of blashpemous words. On the bright side he just helped a ton of people who do "GIMME SOURCE PLZ".

SKiLLs · January 26, 2004, 10:06 PM

Quote from: NetNX on January 25, 2004, 09:51 AM
This shit is not working ive been trying to implement 0x50 plz help

Why did you not just post 0x50 coding? The whole thing is not needed!

R.a.B.B.i.T · January 27, 2004, 04:27 PM

Quote from: SKiLLs on January 26, 2004, 10:06 PM
Quote from: NetNX on January 25, 2004, 09:51 AM
This shit is not working ive been trying to implement 0x50 plz help

Why did you not just post 0x50 coding? The whole thing is not needed!

Unless he's a nub and has never used hashes before. Then he wouldn't know shit from spaghetti. He's using, quite possibly, the most complicated hash connection source currently available.

NetNX · January 27, 2004, 09:57 PM

yea stripping down firebot was easyer then alot of ppls bots... definitly one of the easyiest well i think i got it all fixed anyway so its good

thanks fenor

LUV YOU !

R.a.B.B.i.T · January 28, 2004, 09:51 AM

He should use something simple, like the stripped version of Feanor's TCP connection (there's a few tests in it).

NetNX · January 31, 2004, 04:42 AM

yea i just found that fenors stripped code Bumber

i spent all that time

Full Source .... Post Comments / Help

ChR0NiC

ObsidianWolf

SKiLLs

R.a.B.B.i.T

R.a.B.B.i.T