关于VB内存中提取网页图片高难度问题！大家可以多多讨论！

Question

最近打算 写一个 小工具 获取 已经打开的网页中显示图片，保存到 本地设置的 目录下。 很简单的是 每张图片上 都可以右键 图片另存为 ，但是如果图片很多，一张一张的另存太麻烦了。 
所以想了2个思路：
第一：能否写个控件或者啥的直接调用ie中右键 图片另存为的 接口 ，这样就可以批量保存图片到本地目录 第二：每张图片并不一定都是在ie缓存中（这里只临时文件夹中），而是有些在内存中，所以，能否将ie当前页面中所有在内存中的图片提取出来？？ 如果采用这个方法需要知道哪些？？才能提取？希望大家能帮帮忙哈，希望用能VB 给出一点思路。

Answer 1

Private Sub FindFiles(doc As IHTMLDocument2)    On Error GoTo FindFiles_Err
    
    Dim i, j, nElements As Long
    Dim pElements As IHTMLElementCollection
    Dim pElement As IHTMLElement
    Dim nPos As Integer
    Dim sURL As String
    
    'Get all the BODY elements of the current page
    Set pElement = doc.body
    Set pElements = pElement.All
    
    'Get number of elements on the current page
    nElements = pElements.length
    
    For i = 0 To nElements - 1
    
        Dim sTag As String
        
        Set pElement = pElements.Item(i)
        
        'Check every "anchor" for file type
        sTag = UCase(pElement.tagName)
        
        If sTag = "A" Then
            
            Dim pAnchor As IHTMLAnchorElement
            Dim shref As String
            
            Set pAnchor = pElement
            shref = LCase$(pAnchor.href)
            
            For j = 0 To m_nTypes - 1
                nPos = InStr(shref, m_sTypes(j))
                If nPos Then
                    sURL = ParseURL(shref)
                    'Just show file name in list box, but store
                    'the rest of the url in a hidden list box
                    nPos = InStrRev(sURL, "/")
                    If (nPos) Then
                        lstURL.AddItem Left$(sURL, nPos)
                        lstFiles.AddItem Right(sURL, Len(sURL) - nPos)
                        
                        SaveSetting "FileSpider", "Files", _
                                lstFiles.List(lstFiles.NewIndex), _
                                lstURL.List(lstURL.NewIndex)                    Else
                        lstFiles.AddItem sURL
                    End If
                End If
            Next j
            
            Set pAnchor = Nothing
            
        End If
       
    Next i
    
FindFiles_Cleanup:
    
    Set pElement = Nothing
    Set pElements = Nothing
    
    Exit Sub
    
FindFiles_Err:    frmAlert.Alert = "Function: FindFiles" & Chr$(13) & _
        "Error: " & Hex(Err.Number) & Chr$(13) & _
        Err.Description
        
    GoTo FindFiles_Cleanup
    
End Sub

Answer 2

上面的代码是提取链接的，你修改下，        
If sTag = "A" Then
换成
If sTag = "IMG" Then
就行了。至于下载，可以用 inet，代码如下：
Private Sub cmdDL_Click()
    
    On Error GoTo Errs
    
    Dim intFile As Integer   ' FreeFile variable
    Dim sLocalFile As String
    Dim sRemoteFile As String
                
    Dim vFileTypes As Variant
    Dim buffer() As Byte
    Dim i As Long
    
    If m_fDownloading Then
        Exit Sub
    End If
    
    'Make sure there are file types
    vFileTypes = GetAllSettings("FileSpider", "Types")
    If IsEmpty(vFileTypes) Then
        frmAlert.Alert = "You have not specified the file types you wish to download.  Please edit your Preferences to add new file types."
        Exit Sub
    End If
    
    'Make sure a download directory has been set
    m_sDir = GetSetting("FileSpider", "Data", "Directory", "")
    If Len(m_sDir) = 0 Then
        frmAlert.Alert = "You have not specified a download directory."
        Exit Sub
    End If
    
    'Make sure there are selected files
    If lstFiles.SelCount = 0 Then
        frmAlert.Alert = "You have not selected any files from the list!"
        Exit Sub
    End If
    
    m_fDownloading = True
    Call BandState(False)
    
    For i = 0 To lstFiles.ListCount - 1
        If (lstFiles.Selected(i) = True) And (m_fDownloading = True) Then
            sLocalFile = m_sDir & "\" & lstFiles.List(i)
            sRemoteFile = lstURL.List(i) & lstFiles.List(i)
            intFile = FreeFile()
            lblStatus.Caption = "Downloading " & lstFiles.List(i)
            Open sLocalFile For Binary Access Write As #intFile
            buffer() = inet.OpenURL(sRemoteFile, icByteArray)
            Put #1, , buffer()
            Close #intFile
        End If
    Next i
    
    lblStatus.Caption = ""
    m_fDownloading = False
    
    Call BandState(True)
    
    Exit Sub
Errs:
    
    Call BandState(True)
    
    frmAlert.Alert = "Function: Download" & Chr$(13) & _
        "Error: " & Hex(Err.Number) & Chr$(13) & _
        Err.Description
    
End Sub

Answer 3

完整的代码在 VB Shell Programming 这本书里面。我的BLOG有。