Cliente MSN, problemas conectando por HTTP

Iniciado por Nork, 30 Abril 2008, 17:55 PM

0 Miembros y 1 Visitante están viendo este tema.

Nork

Hola, pues estoy haciendo un cliente MSN y no llego a pasar el momento en el que me tengo que loguear por HTTP... expongo el código que utilizo:

Código (vb) [Seleccionar]
"GET / HTTP/1.1" + vbCrLf + "Accept: */*" + vbCrLf + "Accept -Language: es" + vbCrLf + "UA -CPU: x86" + vbCrLf + "Accept -Encoding: gzip , deflate" + vbCrLf + "User-Agent: Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.1; .NET CLR 1.1.4322; .NET CLR 2.0.50727; WinuE v6; WinuE v6)" + vbCrLf + "Proxy -Connection: Keep -Alive" + vbCrLf + "Authorization: Passport1.4 OrgVerb=GET,OrgURL=http%3A%2F%2Fmessenger%2Emsn%2Ecom,sign-in=" + Text1.Text + ",pwd=" + Text2.Text + "," + lc(code) + "," + id(code) + "," + tw(code) + "," + fs(code) + "," + wp(code) + "," + ru(code) + "," + rn(code) + "," + ct(code) + "," + kpp(code) + "," + kv(code) + "," + ver(code) + "," + tpf(code) + "Host: login.passport.com"

Donde text1 y text2 son la cuenta y el pass y lo que coge la variable code es para sacar unos valores que me envió antes otro servidor. Al enviar esto lógicamente envío los 2 retorno de carros. Pues cuando me toca enviar esto a login.passport.com 443 el servidor no me envía nada ( de lo que me envíe me interesaría una variable bastante importante).

A ver si alguien me puede echar una mano  :P
C' Est La Vie

Karcrack

Esta es la función que yo uso me costo bastante, así que espero que la sepas valorar  :xD:
Código (vb) [Seleccionar]

dim SSL as object

Public Function SetHTTPLib()
    Set SSL = Nothing
    Set SSL = CreateObject("WinHttp.WinHttpRequest.5.1")
    SSL.Option(WinHttpRequestOption_EnableRedirects) = False
End Function

Public Function SendRecvSSL(Method As String, Data As String, _
    Optional ReqHeaderN As String, Optional ReqHeaderD As String) As String
    On Error GoTo REPEAT
REPEAT:
    SSL.Open Method, Data
    If ReqHeaderN <> "" And ReqHeaderD <> "" Then SSL.SetRequestHeader ReqHeaderN, ReqHeaderD
    SSL.Send
    SendRecvSSL = SSL.Status & " " & SSL.StatusText & vbCrLf & _
    SSL.GetAllResponseHeaders
End Function

Public Function pKey(AuthKey As String, User As String, Pass As String) As String
    Dim sData As String, sLoginServ As String, sHeader As String
    Call SetHTTPLib
    sHeader = "Passport1.4 OrgVerb=GET,OrgURL=http%3A%2F%2Fmessenger%2Emsn%2Ecom,sign-in=" & _
    Replace$(User, "@", "%40") & ",pwd=" & URLEncode(Pass) & "," & AuthKey
           
    sData = SendRecvSSL("GET", "https://nexus.passport.com/rdr/pprdr.asp")
    If Entre(sData, , vbCrLf) = "200 OK" Then
    sLoginServ = "https://" & Entre(sData, "DALogin=", ",")
       
ConnectionSSL:
        DoEvents
        Sleep 100
        sData = SendRecvSSL("GET", sLoginServ, "Authorization", sHeader)
       
        Select Case Entre(sData, , vbCrLf)
            Case "302 Found"
                sLoginServ = Entre(sData, "Location: ", vbCrLf)
                DoEvents
                GoTo ConnectionSSL
            Case "401 Unauthorized"
                'MsgBox "Wrong username / password!": frmMain.sckNS.Close
            Case "200 OK"
                pKey = Entre(sData, "from-PP='", "'")
            Case Else
                'MsgBox "Received unknown packet from SSL!": frmMain.sckNS.Close
        End Select
    Else
    'MsgBox "Could not retrieve data from SSL!": frmMain.sckNS.Close
    End If
End Function

Public Function Entre(ByVal Str As String, Optional dStart As String, Optional dEnd As String, Optional Length As Long) As String
    'Esta funcion obtiene un texto entre dos variables.
    Dim x1 As Long, x2 As Long
    x1 = IIf(dStart = "", 1, InStr(1, LCase$(Str), LCase$(dStart)) + Len(dStart))
    If x1 > 0 Then
        If dEnd = "" Then
            Entre = Mid$(Str, x1)
        Else
            x2 = InStr(x1, LCase$(Str), LCase$(dEnd)) - x1
            If x2 > 0 Then
                Entre = Mid$(Str, x1, x2)
            Else
                Entre = ""
            End If
        End If
    Else
        Entre = ""
    End If
    If Length > 0 And Entre <> "" Then Entre = Left$(Entre, Length)
End Function


La función la llamas así:
Código (vb) [Seleccionar]

Informacion=pkey(Todo,User,Pass)

Donde pone Todo es la información que te da el servidor ( lo de lc, tw...) va todo junto, como te lo da, con comas y todo lo demas ;D

Saludos ::)!

Nork

Se agradece tu ayuda, pero aún no he conseguido que el server me responda. Tu código sirve actualmente?  :-\
C' Est La Vie

Tengu


Encuentros por Video y Chat !!

Nork

C' Est La Vie