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
 
 

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
 

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