مشکل در انلاین کردن ایدی یاهو با winsock لطفا راهنمای کنید

[saji777]

سلام من سورس قرارمیدم ببینید چرا انلاین نمیشه و اررور میده


Option Explicit
Dim StrYcook As String
Dim StrTcook As String
Dim Data As String
Private Sub cmdcon_Click()
Winsock2.Close
Winsock2.Connect "login.yahoo.com", "80"
End Sub

Private Sub cmddis_Click()
Winsock2.Close
End Sub


Private Sub Winsock2_Connect()
Dim LoginYahoo As String
Dim Data As String
Dim StrYcook 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
Winsock2.SendData LoginYahoo
End Sub
Public Function Header(YMSGPacketData As String, YMSGStatus As String, YMSGKey As String, YMSGCommand As Long) As String
Dim YMSGVendor As Long
Dim YMSGVersion As Integer
YMSGVendor = 0
YMSGVersion = 17
Header = "YMSG" & Chr(Int(YMSGVersion / 256)) & Chr(Int(YMSGVersion Mod 256)) & Chr(Int(0 / 256)) & Chr(Int(0 Mod 256)) & Chr(Int(Len(YMSGPacketData) / 256)) & Chr(Int(Len(YMSGPacketData) Mod 256)) & Chr(Int(YMSGCommand / 256)) & Chr(Int(YMSGCommand Mod 256)) & Mid(YMSGStatus, 1, 4) & Mid(YMSGKey, 1, 4) & YMSGPacketData
End Function
Public Function Login(YahooID As String, YCookie As String, TCookie As String)
On Error Resume Next
Dim InVType As String
InVType = Chr(0)
Login = Header("0A`€" & YahooID & "A`€2A`€" & YahooID & "A`€1A`€" & YahooID & "A`€244A`€" & "0" & "A`€6A`€" & YCookie & " " & TCookie & "A`€98A`€usA`€", String(3, Chr(0)) & InVType, String(3, Chr(0)) & InVType, 550)
End Function

Private Sub Winsock2_DataArrival(ByVal bytesTotal As Long)
'On Error Resume Next


Winsock2.GetData Data

If InStr(Data, "Yahoo! - 400 Bad Request") Then
status.Caption = "Bad ID/Password"
Winsock2.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
Debug.Print "connect to port 80"
Winsock2.Close
Winsock3.Close
Winsock3.Connect "scs.msg.yahoo.com", 5050
Else
status.Caption = "Error"
Exit Sub
End If
End If
End Sub

Private Sub Winsock3_Connect()
Winsock3.SendData Login(id.Text, StrYcook, StrTcook)
End Sub

Private Sub Winsock3_DataArrival(ByVal bytesTotal As Long)
Dim Data As String
Dim Types As Integer
Winsock2.GetData Data
Types = Asc(Mid(Data, 12, 1))
Print Types
End Sub