一、使用 API 函数 URLDownloadToFile,下载网页文件(也可以是图片等其他文件)到硬盘
Dim nUrl As String, F As String, S As Long
nUrl = "http://www.baidu.com/img/baidu_logo.gif": F = App.Path & "\My-1.bmp" '下载百度图片
S = URLDownloadToFile(0, nUrl, F, 0, 0) '下载文件,0 表示成功
nUrl = "http://www.baidu.com": F = App.Path & "\Baidu.html" '下载百度首页的网页
S = URLDownloadToFile(0, nUrl, F, 0, 0) '下载文件,0 表示成功
二、使用 API 函数 OleLoadPicturePath,下载图片文件到变量,注意要勾选引用:OLEAutomation
Private Declare Function OleLoadPicturePath Lib "oleaut32.dll" (ByVal szURLorPath As Long, ByVal punkCaller As Long, ByVal dwReserved As Long, ByVal clrReserved As OLE_COLOR, ByRef riid As TGUID, ByRef ppvRet As IPicture) As Long
Private Type TGUID
Data1 As Long: Data2 As Integer: Data3 As Integer: Data4(0 To 7) As Byte
End Type
Public Function LoadNetPicture(ByVal ImgSrc As String) As Picture
Dim riid As TGUID
riid.Data1 = &H7BF80980: riid.Data2 = &HBF32: riid.Data3 = &H101A
riid.Data4(0) = &H8B: riid.Data4(1) = &HBB: riid.Data4(2) = &H0
riid.Data4(3) = &HAA: riid.Data4(4) = &H0: riid.Data4(5) = &H30
riid.Data4(6) = &HC: riid.Data4(7) = &HAB
OleLoadPicturePath StrPtr(ImgSrc), 0&, 0&, 0&, riid, LoadNetPicture
End Function
'使用方法:
Dim ImgSrc As String, nPicture As Picture
ImgSrc = "http://www.baidu.com/img/baidu_logo.gif"
Set nPicture = LoadNetPicture(ImgSrc) '将图片下载到变量
SavePicture nPicture, App.Path & "\MyImg.bmp" '保存到硬盘
Picture1.Picture = nPicture
'如果要将图片装载到控件,可以直接这样:
Picture1.Picture = LoadNetPicture(ImgSrc)
三、使用 Microsoft.XMLHTTP 对象,下载网页文件(也可以是图片等其他文件)到硬盘
Private Sub DownNetFile(ByVal nUrl As String, ByVal nFile As String)
Dim XmlHttp, B() As Byte
Set XmlHttp = CreateObject("Microsoft.XMLHTTP")
XmlHttp.Open "GET", nUrl, False
XmlHttp.Send
If XmlHttp.ReadyState = 4 Then
B() = XmlHttp.ResponseBody
Open nFile For Binary As #1
Put #1, , B()
Close #1
End If
Set XmlHttp = Nothing
End Sub
'使用方法:
DownNetFile "http://www.baidu.com/img/baidu_logo.gif", App.Path & "\My-1.bmp" '下载百度图片
DownNetFile "http://www.baidu.com", App.Path & "\Baidu.html" '下载百度首页的网页
四、使用 WebBrowser 的 Document 对象,保存网页的所有图片
Dim nPath As String, K As Long, E, nRange
nPath = App.Path & "\Tu\"
WebBrowser1.Silent = True '关闭交互 禁止脚本错误
For Each E In WebBrowser1.Document.All
If E.tagName = "IMG" Then
Set nRange = WebBrowser1.Document.body.createControlRange()
nRange.Add E
nRange.execCommand "Copy" '复制到剪贴板
K = K + 1
SavePicture Clipboard.GetData, nPath & K & ".bmp" '保存到硬盘
End If
Next
五、用API调用系统的另存为下载对话框
Private Declare Function DoFileDownload Lib "shdocvw.dll" (ByVal lpszFile As String) As Long
使用方法:
Dim nUrl As String
nUrl = StrConv("http://www.baidu.com", vbUnicode)
Call DoFileDownload(nUrl)
六、用 WebBrowser1 的 ExecWB 方法调用网页另存为对话框:
WebBrowser1.ExecWB OLECMDID_SAVEAS, OLECMDEXECOPT_DODEFAULT
以上方法各有优缺点。
Microsoft.XMLHTTP 对于大文件有利,支持断点续传,但需调用 getResponseHeader 进行数据检查。
对于谷歌地图图片,图片链接形如 http://mt1.google.cn/vt/lyrs=s@63&gl=cn&x=51694&s=&y=26884&z=16&s=Galile,仅第四种方法有效