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
Mostrar Mensajes
.