RE:Insertar imagen desde una Web
COLOCA ESTE CODIGO EN UN FORMULARIO Y CREA UN PICTURE BOX...
Const scUserAgent = "PonTuNombreAqui"
Const INTERNET_OPEN_TYPE_DIRECT = 1
Const INTERNET_OPEN_TYPE_PROXY = 3
Const INTERNET_FLAG_RELOAD = &H80000000
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
Private Declare Function InternetCloseHandle Lib "wininet" (ByVal hInet As Long) As Integer
Private Declare Function InternetReadFile Lib "wininet" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
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
Function BajarFichero(sURL As String, sFichero As String, Optional sProxy As String = vbNullString, Optional sNoProxy As String = vbNullString) As Boolean
Dim hOpen As Long, hFile As Long, sBuffer As String, Ret As Long, Res As Integer
Dim Fich As Integer, aux As String
sBuffer = Space(1000)
BajarFichero = False
hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, sProxy, sNoProxy, 0)
If hOpen = 0 Then Exit Function
hFile = InternetOpenUrl(hOpen, sURL, vbNullString, ByVal 0&, INTERNET_FLAG_RELOAD, ByVal 0&)
If hFile = 0 Then Exit Function
Fich = FreeFile()
If Dir(sFichero) <> "" Then Kill sFichero
Open sFichero For Binary As Fich
Res = 1: Ret = 1000
While Res = 1 And Ret = 1000
Res = InternetReadFile(hFile, sBuffer, 1000, Ret)
If Ret > 0 Then
aux = Left(sBuffer, Ret)
Put Fich, , aux
End If
Wend
Close Fich
InternetCloseHandle hFile
InternetCloseHandle hOpen
BajarFichero = True
End Function
Private Sub Form_Load()
On Error GoTo OUT
Dim BResultado As Boolean
Dim Strln As String
'AQUI PON LA DIRECCION DE LA IMAGEN QUE DESEAS DESCARGAR
BResultado = BajarFichero("http://www.pscode.com/vb/images/PscLogo1.jpg", App.Path & "\Temp.jpg")
Me.Caption = BResultado
If BResultado Then
Picture1.Picture = LoadPicture(App.Path & "\Temp.jpg")
Kill App.Path & "\Temp.jpg"
End If
Exit Sub
OUT:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, Err.Source
End Sub
SUERTE.