Jugoso.. ahora si que me entraron ganas de ver el source, la parte de inicio de sesion llevaba tiempo planeando usarla para un juguete

Private Sub Command1_Click()
 Winsock.RemoteHost = separar_host(Text3.Text, "host")
 Winsock.RemotePort = "80"
 Winsock.Connect
 Estado.Caption = "Conectando ..."
End Sub
 
Private Sub Command2_Click()
End
End Sub
 
Public Function separar_host(Ruta As String, Tipo As String) As String
Dim Datos() As String
If Not Left$(Ruta, 7) = "http://" Then
 Ruta = "http://" & Ruta
End If
If Tipo = "host" Then
 Datos = Split(Ruta, "/")
 separar_host = Datos(2)
ElseIf Tipo = "ruta" Then
 Datos = Split(Ruta, separar_host(Ruta, "host"))
 separar_host = Datos(1)
End If
End Function
 
Private Sub Winsock_Connect()
 Dim Post_Data As String
 Estado.Caption = "Enviando datos ..."
 Post_Data = "user=" & URLEncode(Text1.Text) & "&passwrd=" & URLEncode(Text2.Text)
 
 Winsock.SendData _
 "POST " & separar_host(Text3.Text, "ruta") & "?action=login2 HTTP/1.1" & vbCrLf & _
 "Host: " & separar_host(Text3.Text, "host") & vbCrLf & _
 "User-Agent: Mozilla/5.0 (Windows; U; Windows NT 5.1; es-ES; rv:1.9.0.8) Gecko/2009032609 Firefox/3.0.8 (.NET CLR 3.5.30729)" & vbCrLf & _
 "Connection: Close" & vbCrLf & _
 "Content-Type: application/x-www-form-urlencoded" & vbCrLf & _
 "Content-Length: " & Len(Post_Data) & vbCrLf & vbCrLf & _
 Post_Data & vbCrLf
End Sub
 
Private Sub Winsock_DataArrival(ByVal bytesTotal As Long)
 Dim Paquetes As String
 Estado.Caption = "Obteniendo paquetes ..."
 Winsock.GetData Paquetes
 If Not Eregi("302 Found", Paquetes) Then Estado.Caption = "Error de datos"
 
 Text4.Text = Obtener_Cookies(Paquetes)
 DoEvents
 Winsock.Close
 Estado.Caption = "Finalizado"
End Sub
 
Private Function Obtener_Cookies(Buffer As String) As String
Rebuscar:
Cookie = InStr(1, Buffer, "Set-Cookie: ")
If Cookie = 0 Then
 Exit Function
Else
 Buffer = Mid$(Buffer, Cookie, Len(Buffer))
 Cookie = InStr(1, Buffer, ";")
 Temporal = Mid$(Buffer, 1, Cookie)
 Buffer = Mid$(Buffer, Cookie, Len(Buffer))
 Temporal = Replace(Temporal, "Set-Cookie: ", "")
 Obtener_Cookies = Obtener_Cookies & " " & Temporal
 Pause "0.01"
 GoTo Rebuscar
End If
End Function
 
Public Function Eregi(Condicion As String, Buffer As String) As Boolean
If InStr(1, Buffer, Condicion) > 0 Then Eregi = True Else Eregi = False
End Function
 
 
Public Function URLEncode(sRawURL As String) As String
 
    On Error GoTo Catch
    Dim iLoop As Integer
    Dim sRtn As String
    Dim sTmp As String
    Const sValidChars = "1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz:/.?=_-$(){}~&"
 
 
    If Len(sRawURL) > 0 Then
        ' Loop through each char

 
        For iLoop = 1 To Len(sRawURL)
            sTmp = Mid(sRawURL, iLoop, 1)
 
 
            If InStr(1, sValidChars, sTmp, vbBinaryCompare) = 0 Then
                ' If not ValidChar, convert to HEX and p
                '     refix with %
                sTmp = Hex(Asc(sTmp))
 
                If sTmp = "20" Then
                    sTmp = "+"
                ElseIf Len(sTmp) = 1 Then
                    sTmp = "%0" & sTmp
                Else
                    sTmp = "%" & sTmp
                End If
 
            End If
 
            sRtn = sRtn & sTmp
        Next iLoop
 
        URLEncode = sRtn
    End If
 
Finally:
    Exit Function
Catch:
    URLEncode = ""
    Resume Finally
End Function
 
Public Sub Pause(interval)
 On Error Resume Next
 Dim atime
 atime = Timer
 Do While Timer - atime < Val(interval)
  DoEvents
 Loop
End Sub