如何抓取网页上的图片

[hwmfly]

如题，给出思路即可，谢谢

[renjun24]

不懂，学习来了，帮顶吧
你能给我一分就不错了，谢谢!

[hwmfly]

谢谢 wocoolbila() 的回复，但是我觉得既然webbrowser已经显示出图片来了，没有必要再去下载了，因为图片已经在本地机子上了，应该有方法直接把webbrowser显示的图片保存下来

[wocoolbila]

1、创建InternetExplorer.Application对象，并得到document对象
2、使用html文档对象解析document对象，得到图片的url
3、使用urlmon API直接下载图片即可

[蒋晟]

Use UrlDownloadToFile
it will check local cache first

[Hotus]

For Each WX In Web.Document.All
If WX.tagName = "IMG" Then
If WX.src="http://www.11111.com/1111.bmp" Then
Set CtrlRange = Web.Document.body.createControlRange()
CtrlRange.Add (WX)
CtrlRange.execCommand ("Copy")
SavePicture Clipboard.GetData, "c:\1.bmp"
Exit For
End If
End If
Next

[CathySun118]

up

[afei2003]

收藏一下

[awperpvip]

mark,是截图还是下载文件？

[sss2002]

直接用 winsock 去下载图片，收到的数据为2进制流，保存文件就是你要的图片了

[caterp]

HotUs的答案正解

[jjkk123]

这种方法是可用的，但用到了剪贴板，若你在用电脑或其他软件用到剪贴板，会有冲突的呀，如何解决？！！

[hwmfly]

我用了 HotUs() 的方法，确实可行，但是又出来一个新问题，怎么判断图片已加载完毕
因为我用document_compelete 事件不能判断图片加载完毕
我是用vb 2005写的，已经另开贴子讨论这个问题了，
http://community.csdn.net/Expert/topic/5462/5462536.xml?temp=.4668848

[jjkk123]

我用了这种方法，在用电脑的时候很不好用！！

[eslbs]

1、搜索url
2、判断是否在缓存，文件路径多少
3、在缓存拷贝，不在缓存下载

1、HotUs() 的方法
2、网上可以搜索。记得vbgood好像有那个代码
3、 UrlDownloadToFile 这个是调用ie的下载方式

[Ulick]

Option Explicit

'WININET访问网络API
Private Declare Function InternetOpen Lib "wininet.dll" 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 InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Long, ByVal lpszServerName As String, ByVal nProxyPort As Integer, ByVal lpszUsername As String, ByVal lpszPassword As String, ByVal dwService As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hInternet As Long, ByVal lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function HttpOpenRequest Lib "wininet.dll" Alias "HttpOpenRequestA" (ByVal hHttpSession As Long, ByVal sVerb As String, ByVal sObjectName As String, ByVal sVersion As String, ByVal sReferer As String, ByVal something As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" (ByVal hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal sOptional As String, ByVal lOptionalLength As Long) As Integer
Private Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" (ByVal hHttpRequest As Long, ByVal lInfoLevel As Long, ByRef sBuffer As Any, ByRef lBufferLength As Long, ByRef lIndex As Long) As Integer
Private Declare Function HttpAddRequestHeaders Lib "wininet.dll" Alias "HttpAddRequestHeadersA" (ByVal hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal lModifiers As Long) As Integer
Private Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetReadFileByte Lib "wininet.dll" Alias "InternetReadFile" (ByVal hFile As Long, ByRef sBuffer As Byte, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer

Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000
Private Const HTTP_QUERY_CONTENT_LENGTH = 5
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const INTERNET_INVALID_PORT_NUMBER = 0
Private Const INTERNET_FLAG_RELOAD = &H80000000
Private Const INTERNET_SERVICE_HTTP = 3
Private Const INTERNET_DEFAULT_HTTP_PORT = 80
Private Const HTTP_ADDREQ_FLAG_ADD = &H20000000
Private Const HTTP_ADDREQ_FLAG_REPLACE = &H80000000

Private Const UserAgent = "Mozilla/4.0 (UlickBOT(www.Ulick.Net); MSIE 6.0; Windows NT 5.1)"
Private hNet As Long
Private hConnect As Long
Private hRequest As Long
Private hUrlFile As Long
Private bRet As Long

Private Sub Class_Initialize()
hNet = InternetOpen(UserAgent, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, INTERNET_INVALID_PORT_NUMBER, 0)
End Sub

Private Sub Class_Terminate()
If hRequest Then InternetCloseHandle hRequest
If hConnect Then InternetCloseHandle hConnect
If hNet Then InternetCloseHandle hNet
End Sub

'发送URL
Public Function SendUrl(ByVal sUrl As String) As Long
'On Error Resume Next
Dim hUrl As Long
hUrl = InternetOpenUrl(hNet, sUrl, vbNullString, 0, INTERNET_FLAG_RELOAD, 0)
SendUrl = hUrl
End Function

'发送URL，返回这个URL文件的HTML代码，可选Referer参数
Public Function GetUrlFile(ByVal sUrl As String, Optional sReferer As String) As String
'On Error Resume Next
Dim dwSize As Long
Dim htmlBody As String
Dim dwBuf As String * 1024
If Len(sReferer) Then
hUrlFile = SendReferer(sUrl, sReferer)
Else
hUrlFile = SendUrl(sUrl)
End If
If hUrlFile = 0 Then Exit Function
Do
dwBuf = vbNullString
bRet = InternetReadFile(hUrlFile, dwBuf, 1024, dwSize)
htmlBody = htmlBody & Mid(dwBuf, 1, dwSize)
Loop While (dwSize <> 0)
If hUrlFile Then InternetCloseHandle hUrlFile
GetUrlFile = htmlBody
End Function

Public Function FileDownload(ByVal sUrl As String, ByVal sFile As String, Optional sReferer As String) As Boolean
Dim B(999) As Byte
Dim EndByte() As Byte
Dim bDoLoop As Boolean
Dim sReadBuffer As String
Dim lNumberOfBytesRead As Long
Dim FileID As Integer
Dim StrSize As String
Dim Size As Long
StrSize = String$(1024, " ")
FileID = FreeFile
If Len(sReferer) Then
hUrlFile = SendReferer(sUrl, sReferer)
Else
hUrlFile = SendUrl(sUrl)
End If
HttpQueryInfo hUrlFile, HTTP_QUERY_CONTENT_LENGTH Or INTERNET_INVALID_PORT_NUMBER, ByVal StrSize, Len(StrSize), 0
Size = CLng(Trim(StrSize))
If Size = 0 Then Exit Function
Open sFile For Output As FileID
Close FileID
Open sFile For Binary As FileID
Dim j As Long
For j = 1 To Size \ 1000
bDoLoop = InternetReadFileByte(hUrlFile, B(0), 1000, lNumberOfBytesRead)
Put FileID, , B
If Not CBool(lNumberOfBytesRead) Then Exit For
Next
If Size Mod 1000 <> 0 Then
Dim tmp As Long
tmp = (Size Mod 1000) - 1
ReDim EndByte(tmp)
bDoLoop = InternetReadFileByte(hUrlFile, EndByte(0), tmp + 1, lNumberOfBytesRead)
Put FileID, , EndByte
End If
Close FileID
If hUrlFile Then InternetCloseHandle hUrlFile
FileDownload = True
End Function

Private Function SendReferer(ByVal sUrl As String, ByVal sReferer As String) As Long
Dim Srv, Url, sHeader As String
Dim i As Long
i = InStr(sUrl, "/")
Srv = Mid(sUrl, i + 2, Len(sUrl) - (i + 1))
i = InStr(Srv, "/")
Url = Mid(Srv, i, Len(Srv) + 1 - i)
Srv = Left$(Srv, i - 1)
If hRequest Then InternetCloseHandle hRequest
If hConnect Then InternetCloseHandle hConnect
hConnect = InternetConnect(hNet, Srv, 0, vbNullString, "HTTP/1.0", INTERNET_SERVICE_HTTP, 0, 0)
If hConnect = 0 Then Exit Function
hRequest = HttpOpenRequest(hConnect, "GET", Url, "HTTP/1.0", vbNullString, 0, INTERNET_FLAG_RELOAD, 0)
If hRequest = 0 Then Exit Function
sHeader = "Referer:" & IIf(Len(sReferer) = 0, sUrl, sReferer) & vbCrLf
bRet = HttpAddRequestHeaders(hRequest, sHeader, Len(sHeader), HTTP_ADDREQ_FLAG_REPLACE Or HTTP_ADDREQ_FLAG_ADD)
bRet = HttpSendRequest(hRequest, vbNullString, 0, vbNullString, 0)
SendReferer = hRequest
End Function

[Ulick]

用：GetUrlFile下载网页代码，用正则表答式分析，用：FileDownload下载图片。

[panyulirong]

分析网页源码来获取图片路径

[Hotus]

如果知道图片路径，
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Public Function DownFile(URL As String, LocalFilename As String) As Boolean '下载文件
Dim lngRetVal As Long
lngRetVal = URLDownloadToFile(0, URL, LocalFilename, 0, 0)
If lngRetVal = 0 Then
DownloadFile = True
Else
Debug.Print "DownloadFile Error"
End If
End Function

如果是图片存在缓存中，那么就是直接从缓存中下载