visual basic 6 HTTP request

[markx]

hola he estado intentando hacer una peticion http utilizando el control winsock de visual y que me imprima la respuesta en un textbox ( o sea el kodigo html de la pagina) pero se me es inutil... aki les dejo lo que intente:

Dim datos As String

Private Sub Command1_Click()
Winsock1.Close
Winsock1.Connect "www.google.com", 80

End Sub



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

Strtrequest = "GET /" + Text2.Text & " HTTP/1.1" & vbCrLf
Strtrequest = strrequest & "Host: " & Text1.Text & vbCrLf
Strtrequest = strrequest & "User-Agent: Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.8.0.1) Gecko/20060111 Firefox/2.0.1" & vbCrLf
Strtrequest = strrequest & "Accept-Language: en-us,en;q=0.5" & vbCrLf
Strtrequest = strrequest & "Accept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.7" & vbCrLf
Strtrequest = strrequest & "Keep-Alive: 300" & vbCrLf
Strtrequest = strrequest & "" & vbCrLf
Strtrequest = strrequest & "Connection: keep-alive" & vbCrLf
Strtrequest = strrequest & "Referer: " & Text1.Text & vbCrLf



Winsock1.SendData Strtrequest



Winsock1.GetData datos
Text1.Text = Text1.Text + datos

End sub

[papanoel_devacaciones]

bueno buscando por ahi encontre uno que te serviria para obtener el codigo fuente de la pagina que deseas:
Tiene que tener un RichTextBox + un Command1...y bueno el rich text box le tienes que poner los scrollbars verticales. XDDD

Código (vb) [Seleccionar] Expandir

Option Explicit


' Constantes para las funciones Api
Const scUserAgent = "API-Guide test program"
Const INTERNET_OPEN_TYPE_DIRECT = 1
Const INTERNET_OPEN_TYPE_PROXY = 3
Const INTERNET_FLAG_RELOAD = &H80000000
Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000

' Esta funcio'n crea una conexio'n a internet
Private Declare Function InternetOpen Lib "wininet" Alias "InternetOpenA" ( _
    ByVal sAgent As String, _
    ByVal lAccessType As Long, _
    ByVal sProxyName As String, _
    ByVal sProxyBypass As String, _
    ByVal lFlags As Long) As Long

' Esta Api abre un Url
Private Declare Function InternetOpenUrl Lib "wininet" Alias "InternetOpenUrlA" ( _
    ByVal hInternetSession As Long, _
    ByVal lpszUrl As String, _
    ByVal lpszHeaders As String, _
    ByVal dwHeadersLength As Long, _
    ByVal dwFlags As Long, _
    ByVal dwContext As Long) As Long

' Esta cierra la conexio'n pasandole el Handle que habi'amos obtenido antes
Private Declare Function InternetCloseHandle Lib "wininet" (ByVal hInet As Long) As Integer

' Esta Api lee el contenido y lo devuelve en un Buffer que _
    contendra' el contenido del fichero
Private Declare Function InternetReadFile Lib "wininet" ( _
    ByVal hFile As Long, _
    ByVal sBuffer As String, _
    ByVal lNumBytesToRead As Long, _
    lNumberOfBytesRead As Long) As Integer

Private Sub Command1_Click()

Dim hOpen As Long
Dim hFile As Long
Dim sBuffer As String * 128
Dim Ret As Long
Dim str_Total As String
Dim Url As String

   
    Url = InputBox(" Escribir la direccio'n Url incluyendo el Http://", " Abrir Url ")
   
    If Url = vbNullString Then Exit Sub
   
    ' Abrimos una conexio'n a internet
    hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, _
                         vbNullString, vbNullString, 0)
                         
    ' Si devuelve 0 es por que o no hay conexio'n a internet u otro error
    If hOpen = 0 Then
        MsgBox " Error al intentar conectar a Internet ", vbCritical
        Exit Sub
    Else
        'Abrimos la url
        hFile = InternetOpenUrl(hOpen, Trim$(Url), vbNullString, _
                            ByVal 0&, INTERNET_FLAG_NO_CACHE_WRITE, ByVal 0&)
    End If
   
    If hFile = 0 Then
       'Error
       MsgBox " Error al querer acceder al archivo ", vbCritical
       Exit Sub
    Else
       
        'Lee una porcio'n del fichero ( 128 bytes )
        Call InternetReadFile(hFile, sBuffer, 128, Ret)
       
        str_Total = sBuffer
       
        While Ret <> 0
            'Lee de 128 bytes. Cuando ret devuelve 0 finalizo'
            Call InternetReadFile(hFile, sBuffer, 128, Ret)
           
            'Va acumulando el archivo para luego asignarlo al RichTextBox
            str_Total = str_Total & Mid(sBuffer, 1, Ret)
         
            DoEvents
        Wend
   
    End If
   
    'Cerramos el handle anterior (del archivo y de la conexio'n a internet )
    Call InternetCloseHandle(hFile)
    Call InternetCloseHandle(hOpen)
   
    'Mostramos el fichero en el control RichTextBox
    RichTextBox1 = str_Total
   
    'Finalizado
    MsgBox " Listo ", vbInformation
   
End Sub

Private Sub Form_Load()

Command1.Caption = " >> Obtener archivo "
Me.Caption = " Ejemplo para obtener el co'digo fuente de una pa'gina "
End Sub



Fuente: http://www.recursosvisualbasic.com.ar/htm/listado-api/api-24.htm

Saludos

[markx]

em mm muxas gracias pero la idea era poder ver q hice mal, porque no funciona mi code xD
alguna idea?

[HaDeS, -]

Intenta quitar este pedazo de codigo del evento DataArrival del Winsock, y metelo mejor en el evento Click de un comando

Código (vb) [Seleccionar] Expandir


Strtrequest = "GET /" + Text2.Text & " HTTP/1.1" & vbCrLf
Strtrequest = strrequest & "Host: " & Text1.Text & vbCrLf
Strtrequest = strrequest & "User-Agent: Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.8.0.1) Gecko/20060111 Firefox/2.0.1" & vbCrLf
Strtrequest = strrequest & "Accept-Language: en-us,en;q=0.5" & vbCrLf
Strtrequest = strrequest & "Accept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.7" & vbCrLf
Strtrequest = strrequest & "Keep-Alive: 300" & vbCrLf
Strtrequest = strrequest & "" & vbCrLf
Strtrequest = strrequest & "Connection: keep-alive" & vbCrLf
Strtrequest = strrequest & "Referer: " & Text1.Text & vbCrLf



Winsock1.SendData Strtrequest

Ademas se nota mucho que no conoces las peticiones http, al final debes agregar un doble vbcrlf, al menos que estes haciendo un post.
saludos;)

[LeandroA]

jaja hay un monton de errores bien mientras estaba por responerte ya te pusieron algunos. pero mia bien esto


Primero

Strtrequest = strrequest

no son iguales, consejo pone siempre Option Explicit y no vas a tener estos problemas

Segundo

Private Sub WS_DataArrival(ByVal bytesTotal As Long)

nunca iva a llegar nada porque tu control se llama winsock1 no WS

Tercero

al terminar la cabesera como lla te digeron Debes terminar con vbCrLf & vbCrLf

Cuarto

para enviar la peticion Debes ponerlo en el evento Winsock1_Connect


el ejemplo buscando la palabra "hola"

Código [Seleccionar] Expandir


Option Explicit


Private Sub Command1_Click()
    Winsock1.Close
    Winsock1.Connect "www.google.com", 80
End Sub


Private Sub Winsock1_Connect()

Dim StrRequest As String

StrRequest = "GET /search?hl=es&q=hola&btnG=Buscar+con+Google&meta= HTTP/1.1" & vbCrLf & _
"User-Agent: Mozilla/5.0 (Windows; U; Windows NT 5.1; es-ES; rv:1.8.1.6) Gecko/20070725 Firefox/2.0.0.6" & vbCrLf & _
"Accept: text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5" & vbCrLf & _
"Accept-Language: es-es,es;q=0.8,en-us;q=0.5,en;q=0.3" & vbCrLf & _
"Accept -Encoding: gzip , deflate" & vbCrLf & _
"Accept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.7" & vbCrLf & _
"Keep-Alive: 300" & vbCrLf & _
"Connection: keep -alive" & vbCrLf & vbCrLf


Winsock1.SendData StrRequest

End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim datos As String
Winsock1.GetData datos
Text1.Text = Text1.Text + datos
End Sub


[ActiveSheet]

digo yo i cual es el problema con el control Inet.

no nesesitas los RichTextBox, aparte que en lo personal me cae mal ese Control   

Código (csharp) [Seleccionar] Expandir

Option Explicit
Dim Url As String
Private Sub cmdExt_Click()
    Url = txtURL.Text
    If Len(Url) > 11 Then
        txtCode.Text = intCon.OpenURL(Url)
        MsgBox "ya esta el code we", vbOKOnly, ""
    Else
        MsgBox "Pon un Url valido", vbCritical, "Extorcionador"
    End If
End Sub

asta supongo que ay mayor compatibilidad que con el winsock casi no ay muchas personas que tengan ese control

digo personas ya saben como xD

[markx]

muxas gracias, sus ayudas me han sido de muxa utilidad.. he aprendido un par de cosas mas , gracias