有其他办法获取网页某IMG元素的图像么

Question

比如用webbrowser打开地址 http://www.xici.net/user/reg.asp
目的想在picture上显示出当前网页验证码的图像目前大家貌似都是用下面这个方法获取的
Set CtrlRange = WebBrowser1.Document.body.createControlRange()
CtrlRange.Add WebBrowser1.getelementbyid("showverifyimg")
CtrlRange.execCommand ("Copy")
Picture1.Picture = Clipboard.GetData
但是感觉不太方便用读取图片缓存地址的方法，有的网站读取不到，不知道为什么
还有没有其他的方法呢？？？？？求代码

Answer 1

Private Sub CommandButton1_Click()
    Dim arr() As Byte
    On Error Resume Next
    Set ms = CreateObject("msscriptcontrol.scriptcontrol")
    ms.Language = "JavaScript"    With CreateObject("WinHttp.WinHttpRequest.5.1")
        .Open "GET", "http://www.xici.net/user/reg.asp", False
        .setRequestHeader "Connection", "Keep-Alive"
        .Send        .Open "POST", "http://www.xici.net/setcode.asp", False
        .setRequestHeader "Referer", "http://www.xici.net/user/reg.asp"
        .setRequestHeader "x-requested-with", "XMLHttpRequest"
        .setRequestHeader "Accept", "application/json, text/javascript, */*; q=0.01"
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
        .setRequestHeader "Connection", "Keep-Alive"
        .Send "act=setkeyvalue"
        tt1 = Split(.responsetext, """")(3)        .Open "GET", "http://www.xici.net/xiciservice/verifyimg2.asp?key=" & tt1, False
        .setRequestHeader "Referer", "http://www.xici.net/user/reg.asp"
        .setRequestHeader "Connection", "Keep-Alive"
        .Send   '获得验证码
        arr = .responseBody        Open "D:\tp1.gif" For Binary As #1
        Put #1, , arr
        Close #1        Do Until Dir("D:\tp1.gif") <> ""
            DoEvents
        Loop        ActiveSheet.Cells(2, 2).Select
        Set s = ActiveSheet.Pictures.Insert("D:\tp1.gif")
        s.ShapeRange.ScaleWidth 2, msoFalse, msoScaleFromTopLeft
        s.ShapeRange.ScaleHeight 2, msoFalse, msoScaleFromTopLeft        sryzm = InputBox("请输入验证码")
        s.Delete
        Set WshShell = CreateObject("WScript.Shell")
        WshShell.Run Environ$("comspec") & " /c Del /F /Q """ & "D:\tp1.gif""", vbHide, False
        Set WshShell = Nothing    End With
End Sub

Answer 2

谢谢你的回复，但是我不想要这样的
我之所以用webbrowser,是有一定原因的，如果可以用其他的我就不用webbrowser了
现在我是想在软件的picture控件上显示某个网页图片元素的图像，因为有的时候图片不在可见范围内，移动显示很不方便

Answer 3

你的意思，是用internetexplorer.application方法吗？

Answer 4

Public Const ERROR_CACHE_FiND_FAiL As Long = 0
Public Const ERROR_CACHE_FiND_SUCCESS As Long = 1
Public Const ERROR_FiLE_NOT_FOUND As Long = 2
Public Const ERROR_ACCESS_DENiED As Long = 5
Public Const ERROR_iNSUFFiCiENT_BUFFER As Long = 122
Public Const MAX_PATH As Long = 260
Public Const MAX_CACHE_ENTRY_iNFO_SiZE As Long = 4096Public Const LMEM_FiXED As Long = &H0
Public Const LMEM_ZEROiNiT As Long = &H40
Public Const LPTR As Long = (LMEM_FiXED Or LMEM_ZEROiNiT)Public Const NORMAL_CACHE_ENTRY As Long = &H1
Public Const EDiTED_CACHE_ENTRY As Long = &H8
Public Const TRACK_OFFLiNE_CACHE_ENTRY As Long = &H10
Public Const TRACK_ONLiNE_CACHE_ENTRY As Long = &H20
Public Const STiCKY_CACHE_ENTRY As Long = &H40
Public Const SPARSE_CACHE_ENTRY As Long = &H10000
Public Const COOKiE_CACHE_ENTRY As Long = &H100000
Public Const URLHiSTORY_CACHE_ENTRY As Long = &H200000
Public Const URLCACHE_FiND_DEFAULT_FiLTER As Long = NORMAL_CACHE_ENTRY Or COOKiE_CACHE_ENTRY Or URLHiSTORY_CACHE_ENTRY Or TRACK_OFFLiNE_CACHE_ENTRY Or TRACK_ONLiNE_CACHE_ENTRY Or STiCKY_CACHE_ENTRY
Public Type FiLETiME
    dwLowDateTime As Long
    dwHighDateTime As Long
End TypePublic Type iNTERNET_CACHE_ENTRY_iNFO
    dwStructSize As Long
    lpszSourceUrlName As Long
    lpszLocalFileName As Long
    CacheEntryType As Long
    dwUseCount As Long
    dwHitRate As Long
    dwSizeLow As Long
    dwSizeHigh As Long
    LastModifiedTime As FiLETiME
    ExpireTime As FiLETiME
    LastAccessTime As FiLETiME
    LastSyncTime As FiLETiME
    lpHeaderinfo As Long
    dwHeaderinfoSize As Long
    lpszFileExtension As Long
    dwExemptDelta As Long
End Type
Public 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 Declare Function FindFirstUrlCacheEntry Lib "wininet" Alias "FindFirstUrlCacheEntryA" (ByVal lpszUrlSearchPattern As String, lpFirstCacheEntryinfo As Any, lpdwFirstCacheEntryinfoBufferSize As Long) As Long
Public Declare Function FindNextUrlCacheEntry Lib "wininet" Alias "FindNextUrlCacheEntryA" (ByVal hEnumHandle As Long, lpNextCacheEntryinfo As Any, lpdwNextCacheEntryinfoBufferSize As Long) As Long
Public Declare Function FindCloseUrlCache Lib "wininet" (ByVal hEnumHandle As Long) As Long
Public Declare Function DeleteUrlCacheEntry Lib "wininet" Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
Public Declare Function lstrcpyA Lib "kernel32" (ByVal RetVal As String, ByVal Ptr As Long) As Long
Public Declare Function lstrlenA Lib "kernel32" (ByVal Ptr As Any) As Long
Public Declare Function LocalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal uBytes As Long) As Long
Public Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As LongSub qinli_ie_fc()
    Dim icei As iNTERNET_CACHE_ENTRY_iNFO
    Dim hFile As Long
    Dim cachefile As String
    Dim posUrl As Long
    Dim posEnd As Long
    Dim dwBuffer As Long
    Dim pntrICE As Long
    Dim arr(0 To 10000)
    hFile = FindFirstUrlCacheEntry(0&, ByVal 0, dwBuffer)
    k = 0
    If (hFile = ERROR_CACHE_FiND_FAiL) And (Err.LastDllError = ERROR_iNSUFFiCiENT_BUFFER) Then
        pntrICE = LocalAlloc(LMEM_FiXED, dwBuffer)
        If pntrICE <> 0 Then
            CopyMemory ByVal pntrICE, dwBuffer, 4
            hFile = FindFirstUrlCacheEntry(vbNullString, ByVal pntrICE, dwBuffer)
            If hFile <> ERROR_CACHE_FiND_FAiL Then
                Do
                    CopyMemory icei, ByVal pntrICE, Len(icei)
                    If (icei.CacheEntryType And NORMAL_CACHE_ENTRY) = NORMAL_CACHE_ENTRY Then
                        cachefile = GetStrFromPtrA(icei.lpszSourceUrlName)
                        arr(k) = cachefile
                        k = k + 1
                        Cells(k, 1) = cachefile
                    End If
                    Call LocalFree(pntrICE)
                    dwBuffer = 0
                    Call FindNextUrlCacheEntry(hFile, ByVal 0, dwBuffer)
                    pntrICE = LocalAlloc(LMEM_FiXED, dwBuffer)
                    CopyMemory ByVal pntrICE, dwBuffer, 4
                Loop While FindNextUrlCacheEntry(hFile, ByVal pntrICE, dwBuffer)
            End If
        End If
    End If
    Call LocalFree(pntrICE)
    Call FindCloseUrlCache(hFile)
    For cnt = 0 To UBound(arr)
        cachefile = arr(cnt)
        If InStr(cachefile, "Cookie") = 0 Then
            Call DeleteUrlCacheEntry(cachefile)
        End If
    Next
End SubPublic Function GetStrFromPtrA(ByVal lpszA As Long) As String
    GetStrFromPtrA = String$(lstrlenA(ByVal lpszA), 0)
    Call lstrcpyA(ByVal GetStrFromPtrA, ByVal lpszA)
End FunctionSub 读取mLogin_js文件()    qinli_ie_fc    On Error Resume Next
    With CreateObject("internetexplorer.application")
        .Visible = True
        .Navigate "http://www.xici.net/user/reg.asp"
        Do Until .ReadyState = 4
            DoEvents
        Loop
    End With    Dim icei As iNTERNET_CACHE_ENTRY_iNFO
    Dim hFile As Long
    Dim cachefile As String
    Dim posUrl As Long
    Dim posEnd As Long
    Dim dwBuffer As Long
    Dim pntrICE As Long
    Dim leiji As Integer
    hFile = FindFirstUrlCacheEntry(0&, ByVal 0, dwBuffer)
    If (hFile = ERROR_CACHE_FiND_FAiL) And (Err.LastDllError = ERROR_iNSUFFiCiENT_BUFFER) Then
        pntrICE = LocalAlloc(LMEM_FiXED, dwBuffer)
        If pntrICE <> 0 Then
            CopyMemory ByVal pntrICE, dwBuffer, 4
            hFile = FindFirstUrlCacheEntry(vbNullString, ByVal pntrICE, dwBuffer)
            If hFile <> ERROR_CACHE_FiND_FAiL Then
                Do
                    CopyMemory icei, ByVal pntrICE, Len(icei)
                    If (icei.CacheEntryType And NORMAL_CACHE_ENTRY) = NORMAL_CACHE_ENTRY Then
                        cachefile = GetStrFromPtrA(icei.lpszSourceUrlName)
                        If cachefile Like "http://www.xici.net/xiciservice/verifyimg2.asp?key=*" Then
                            URLDownloadToFile 0, cachefile, "d:\图片.gif", 0, 0
                        End If
                    End If
                    Call LocalFree(pntrICE)
                    dwBuffer = 0
                    Call FindNextUrlCacheEntry(hFile, ByVal 0, dwBuffer)
                    pntrICE = LocalAlloc(LMEM_FiXED, dwBuffer)
                    CopyMemory ByVal pntrICE, dwBuffer, 4
                Loop While FindNextUrlCacheEntry(hFile, ByVal pntrICE, dwBuffer)
            End If
        End If
    End If
    Call LocalFree(pntrICE)
    Call FindCloseUrlCache(hFile)
    With CreateObject("internetexplorer.application")
        .Visible = True
        .Navigate "d:\图片.gif"
        Do Until .ReadyState = 4
            DoEvents
        Loop
    End With
End Sub

Answer 5

谢谢，请问，我用浏览器打开
http://reg.email.163.com/unireg/call.do?cmd=register.entrance&from=email163&regPage=163
这个页面，刷新几下验证码
Private Sub Command1_Click()
    Dim icei As iNTERNET_CACHE_ENTRY_iNFO
    Dim hFile As Long
    Dim cachefile As String
    Dim posUrl As Long
    Dim posEnd As Long
    Dim dwBuffer As Long
    Dim pntrICE As Long
    Dim leiji As Integer    hFile = FindFirstUrlCacheEntry(0&, ByVal 0, dwBuffer)
    If (hFile = ERROR_CACHE_FiND_FAiL) And (Err.LastDllError = ERROR_iNSUFFiCiENT_BUFFER) Then
        pntrICE = LocalAlloc(LMEM_FiXED, dwBuffer)
        If pntrICE <> 0 Then
            CopyMemory ByVal pntrICE, dwBuffer, 4
            hFile = FindFirstUrlCacheEntry(vbNullString, ByVal pntrICE, dwBuffer)
            If hFile <> ERROR_CACHE_FiND_FAiL Then
                Do
                    CopyMemory icei, ByVal pntrICE, Len(icei)
                    If (icei.CacheEntryType And NORMAL_CACHE_ENTRY) = NORMAL_CACHE_ENTRY Then
                        cachefile = GetStrFromPtrA(icei.lpszSourceUrlName)
                        
                        If cachefile Like "*http://reg.email.163.com/unireg/call.do[?]cmd=register.verifyCode&v=common/verifycode/vc_en&env=*" Then
                            Set Picture1 = LoadPicture(GetStrFromPtrA(icei.lpszLocalFileName))
                            MsgBox cachefile, , GetStrFromPtrA(icei.lpszLocalFileName)
                        End If
                    End If
                    Call LocalFree(pntrICE)
                    dwBuffer = 0
                    Call FindNextUrlCacheEntry(hFile, ByVal 0, dwBuffer)
                    pntrICE = LocalAlloc(LMEM_FiXED, dwBuffer)
                    CopyMemory ByVal pntrICE, dwBuffer, 4
                Loop While FindNextUrlCacheEntry(hFile, ByVal pntrICE, dwBuffer)
            End If
        End If
    End If
    Call LocalFree(pntrICE)
    Call FindCloseUrlCache(hFile)
End SubPublic Function GetStrFromPtrA(ByVal lpszA As Long) As String
    GetStrFromPtrA = String$(lstrlenA(ByVal lpszA), 0)
    Call lstrcpyA(ByVal GetStrFromPtrA, ByVal lpszA)
End Function
然后用你这个代码尝试下获取验证码图片的缓存文件地址，为什么获取不到呢？？？

Answer 6

有的是没缓存的,简单一点,你在软件中模拟刷新一下验证码,这个时候用VB做个WINSOCK 代理,80端口连一下,这样就直接把图片的二进制数据读出来了,读完了马上关闭IE代理,这样是最实在的,还有一种方法是HOOK一下,一般情况下,是HOOK WINNET.DLL,或者是HOOK有关WINHTTP的函数

Answer 7

还有一种方法是做接口,有个IE什么的TLB文件,应该有办法把所有的相关文件的下载,打开,全接口下来,这样就有办法取出二进制内容了

Answer 8

谢谢，请问，我用浏览器打开
http://reg.email.163.com/unireg/call.do?cmd=register.entrance&from=email163&regPage=163
这个页面，刷新几下验证码
Private Sub Command1_Click()
    Dim icei As iNTERNET_CACHE_ENTRY_iNFO
    Dim hFile As Long
    Dim cachefile As String
    Dim posUrl As Long
    Dim posEnd As Long
    Dim dwBuffer As Long
    Dim pntrICE As Long
    Dim leiji As Integer    hFile = FindFirstUrlCacheEntry(0&, ByVal 0, dwBuffer)
    If (hFile = ERROR_CACHE_FiND_FAiL) And (Err.LastDllError = ERROR_iNSUFFiCiENT_BUFFER) Then
        pntrICE = LocalAlloc(LMEM_FiXED, dwBuffer)
        If pntrICE <> 0 Then
            CopyMemory ByVal pntrICE, dwBuffer, 4
            hFile = FindFirstUrlCacheEntry(vbNullString, ByVal pntrICE, dwBuffer)
            If hFile <> ERROR_CACHE_FiND_FAiL Then
                Do
                    CopyMemory icei, ByVal pntrICE, Len(icei)
                    If (icei.CacheEntryType And NORMAL_CACHE_ENTRY) = NORMAL_CACHE_ENTRY Then
                        cachefile = GetStrFromPtrA(icei.lpszSourceUrlName)
                        
                        If cachefile Like "*http://reg.email.163.com/unireg/call.do[?]cmd=register.verifyCode&v=common/verifycode/vc_en&env=*" Then
                            Set Picture1 = LoadPicture(GetStrFromPtrA(icei.lpszLocalFileName))
                            MsgBox cachefile, , GetStrFromPtrA(icei.lpszLocalFileName)
                        End If
                    End If
                    Call LocalFree(pntrICE)
                    dwBuffer = 0
                    Call FindNextUrlCacheEntry(hFile, ByVal 0, dwBuffer)
                    pntrICE = LocalAlloc(LMEM_FiXED, dwBuffer)
                    CopyMemory ByVal pntrICE, dwBuffer, 4
                Loop While FindNextUrlCacheEntry(hFile, ByVal pntrICE, dwBuffer)
            End If
        End If
    End If
    Call LocalFree(pntrICE)
    Call FindCloseUrlCache(hFile)
End SubPublic Function GetStrFromPtrA(ByVal lpszA As Long) As String
    GetStrFromPtrA = String$(lstrlenA(ByVal lpszA), 0)
    Call lstrcpyA(ByVal GetStrFromPtrA, ByVal lpszA)
End Function
然后用你这个代码尝试下获取验证码图片的缓存文件地址，为什么获取不到呢？？？Public Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Public Declare Function CloseClipboard Lib "user32" () As Long
Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Const CF_DIB = 8Sub ie同步下载验证码()
    Dim img
    Dim CtrlRange
    Dim bytClipData() As Byte
    Dim crr() As Byte
    Dim brr(0 To 13) As Byte
    On Error Resume Next
    For j = 0 To 13
        brr(j) = 0
    Next j
    brr(0) = 66
    brr(1) = 77
    brr(2) = 70
    brr(3) = 14
    brr(10) = 54
    With CreateObject("internetExplorer.application")
        .Visible = True
        .Navigate "http://reg.email.163.com/unireg/call.do?cmd=register.entrance&from=email163&regPage=163"
        Do Until .ReadyState = 4
            DoEvents
        Loop
        Set img = .document.getElementById("vcodeImg")
        Set CtrlRange = .document.body.createControlRange()
        CtrlRange.Add img
        CtrlRange.execCommand "Copy", True    'internet 选项——>安全——>脚本——>允许对剪贴板进行编程访问——>启用        Dim hMem As Long, lpData As Long
        OpenClipboard 0&
        hMem = GetClipboardData(8)
        If CBool(hMem) Then
            lpData = GlobalLock(hMem)
            lClipSize = GlobalSize(hMem)
            If lpData <> 0 And lClipSize > 0 Then
                ReDim bytClipData(0 To lClipSize - 1)
                CopyMemory bytClipData(0), ByVal lpData, lClipSize
            End If
            GlobalUnlock hMem
        End If
        CloseClipboard
        
        Open "c:\123.bmp" For Binary Access Write As #1
        Put #1, , brr
        Put #1, , bytClipData
        Close #1        ActiveSheet.Cells(2, 2).Select
        Set vCode = ActiveSheet.Pictures.Insert("c:\123.bmp")
        ActiveSheet.Cells(2, 1).Select
        Kill "c:\123.bmp"
        '.Quit
    End With
End Sub