یاهو - نسخه قابل چاپ

کد:

Private Sub Winsock1_Connect()On Error Resume Next    Status.Caption = "Connecting"    '    Dim LoginYahoo As String    '    LoginYahoo = "GET http://login.yahoo.com/config/login?login=" & ID.Text & "&passwd=" & Pass.Text & " HTTP/1.1" & vbCrLf    LoginYahoo = LoginYahoo & "Accept-Language: en-us" & vbCrLf    LoginYahoo = LoginYahoo & "User-Agent: Mozilla/5.0 (compatible; MSIE 8.0; Windows NT 5.1; Expulsion-Creations)" & vbCrLf    LoginYahoo = LoginYahoo & "Accept: */*" & vbCrLf    LoginYahoo = LoginYahoo & "Host: login.yahoo.com" & vbCrLf    LoginYahoo = LoginYahoo & "Connection: Keep-Alive" & vbCrLf & vbCrLf    '    Winsock1.SendData LoginYahooEnd Sub

کد:

Option Explicit

Public blnconnected As Boolean

Public BotID As String

Public StrYcook As String

Public StrTcook As String



Private Sub Command1_Click()

On Error Resume Next

    If blnconnected = False Then

        BotID = ID.Text

        Winsock1.Close

        Winsock1.Connect "login.yahoo.com", "80"

    Else:

        Exit Sub

    End If

End Sub





Private Sub Winsock1_Connect()

On Error Resume Next

    Status.Caption = "Connecting"

    '

    Dim LoginYahoo As String

    '

LoginYahoo = "GET http://login.yahoo.com/config/login?login=" & ID.Text & "&passwd=" & Pass.Text & " HTTP/1.1" & vbCrLf

    LoginYahoo = LoginYahoo & "Accept-Language: en-us" & vbCrLf

LoginYahoo = LoginYahoo & "User-Agent: Mozilla/5.0 (compatible; MSIE 8.0; Windows NT 5.1; Expulsion-Creations)" & vbCrLf

    LoginYahoo = LoginYahoo & "Accept: */*" & vbCrLf

    LoginYahoo = LoginYahoo & "Host: login.yahoo.com" & vbCrLf

    LoginYahoo = LoginYahoo & "Connection: Keep-Alive" & vbCrLf & vbCrLf

    '

    Winsock1.SendData LoginYahoo

End Sub



Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)

On Error Resume Next

    Dim Data As String

    '

    Winsock1.GetData Data

    '

    If InStr(Data, "Yahoo! - 400 Bad Request") Then

        Status.Caption = "Bad ID/Password"

        Winsock1.Close

    Exit Sub

    Else:

    If InStr(Data, "302 Found") Then

        StrYcook = Split(Data, "Y=")(1)

        StrYcook = Split(StrYcook, "np=1")(0)

        StrYcook = "Y=" & StrYcook & "np=1;"

        StrTcook = Split(Data, "T=")(1)

        StrTcook = Split(StrTcook, ";")(0)

        StrTcook = "T=" & StrTcook

        Winsock1.Close

        Winsock2.Close

        Winsock2.Connect CboServers.Text, CboPort.Text

    Else:

    Status.Caption = "Error"

    Exit Sub

    End If

    End If

End Sub



Private Sub Winsock2_Connect()

On Error Resume Next

    Winsock2.SendData Login(BotID, StrYcook, StrTcook)

End Sub



Private Sub Winsock2_DataArrival(ByVal bytesTotal As Long)

On Error Resume Next

    Dim Data As String

    '

    Winsock2.GetData Data

    '

    Select Case Asc(Mid(Data, 12, 1))

    '

    Case 85

    Status.Caption = "Logged in"

    blnconnected = True

    '

    Case 2

    If InStr(Data, "ÿÿÿÿ") Then

        Status.Caption = "Logged Out By Server"

        blnconnected = False

        Winsock2.Close

    End If

   

    End Select

    

    Text3.Text = Text3.Text + Replace(Data, Chr(0), "*") & vbCrLf & vbCrLf

End Sub





Option Explicit  '(Module)



Private Function Header(ByVal StrPacketType As String, ByVal StrStat As String, ByVal StrSession As String, ByVal StrComm As Long) As String

    Dim Version As String

    '

    Version = Form1.CboYmsg.Text

    '

Header = "YMSG" & Chr(Int(Version / 256)) & Chr(Int(Version Mod 256)) & String(2, Chr(0)) & Chr(Int(Len(StrPacketType) / 256)) & Chr(Int(Len(StrPacketType) Mod 256)) & Chr(Int(StrComm / 256)) & Chr(Int(StrComm Mod 256)) & Mid(StrStat, 1, 4) & Mid(StrSession, 1, 4) & StrPacketType

End Function



Public Function Login(YahooID As String, YCookie As String, TCookie As String)

Login = Header("0À€" & YahooID & "À€2À€" & YahooID & "À€1À€" & YahooID & "À€244À€1À€6À€" & YCookie & " " & TCookie & "À€98À€usÀ€", String(4, Chr(0)), String(4, Chr(0)), 550)

End Function