Esta es la función que yo uso me costo bastante, así que espero que la sepas valorar
:
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í:
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
Saludos
!