怎样用VB提取网页所有图片地址
这是有可能实现的吧.
最新回答
筱冰蜜子
2024-10-16 10:43:13
然后在窗体上画一个WebBrowser1 随便画多大。
接着画两个文本框(Text1, Text2)，和一个按钮(Command1) Text1用来输入网址，Text2用来输入保存路径，按钮用来执行
复制以下代码
Option Explicit
'公共的
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
Private DocComplete As Boolean
'Form的Resize事件，作用：使用户看不到这个控件
Private Sub Form_Resize()
WebBrowser1.Top = Me.Height + 1
WebBrowser1.Left = Me.Width + 1
End Sub
'WebBrowser1的DownloadComplete事件，作用：标记网页已下载完成
Private Sub WebBrowser1_DownloadComplete()
DocComplete = True
End Sub
'WebBrowser1的NavigateComplete2事件，作用：阻止弹窗
Private Sub WebBrowser1_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
pDisp.Document.parentWindow.execScript "window.alert=null;"
pDisp.Document.parentWindow.execScript "window.confirm=null;"
pDisp.Document.parentWindow.execScript "window.prompt=null;"
pDisp.Document.parentWindow.execScript "window.showModalDialog=null;"
pDisp.Document.parentWindow.execScript "window.showModalessDialog=null;"
pDisp.Document.parentWindow.execScript "window.open=null;"
End Sub
'按钮事件，这就是核心代码
Private Sub Command1_Click()
'转到页面
DocComplete = False
WebBrowser1.Navigate Text1.Text
Do Until DocComplete
DoEvents
Loop
'枚举图片
Dim ImgCount As Long
Dim aryImgs() As String
Dim doc
Dim eles
Dim ele
Dim i
Set doc = WebBrowser1.Document
Set eles = doc.getElementsByTagName("img")
For i = 1 To eles.length
Set ele = eles.Item(i - 1) 'Set ele = eles.Item(, i)
If Not Trim(ele.src) = vbNullString Then
ImgCount = ImgCount + 1
ReDim Preserve aryImgs(1 To ImgCount)
aryImgs(ImgCount) = Trim(ele.src)
End If
Next
'下载图片
Dim strPath As String, newPath As String
strPath = Text2.Text
If Not Right(strPath, 1) = "\" Then strPath = strPath & "\"
If Dir(strPath, vbDirectory) = vbNullString Then MkDir strPath
If Not ImgCount = 0 Then
For i = 1 To ImgCount
newPath = aryImgs(i)
'替换文件名中不可使用的字符
newPath = Replace(newPath, "/", "_")
newPath = Replace(newPath, "\", "_")
newPath = Replace(newPath, ":", "_")
newPath = Replace(newPath, "?", "_")
newPath = Replace(newPath, "<", "_")
newPath = Replace(newPath, ">", "_")
newPath = Replace(newPath, "|", "_")
newPath = Replace(newPath, "*", "_")
newPath = Replace(newPath, Chr(34), "_")
Call URLDownloadToFile(0, aryImgs(i), strPath & newPath, 0, 0)
Next i
End If
MsgBox "完成"
End Sub
代码就是这些，调试时在Text1中输入"
http://www.hao123.com
" Text2中输入"D:\Hao123Img\" 然后再按按钮，等待“完成”弹出来后，你就去D:\Hao123Img\看看，里面就会有hao123主页上的几个图片了。
山间雾安
2024-10-16 10:28:00
content=sContent1
regstr="src\=.+?\.(gif|jpg)"
url=Replace(Replace(Replace(RegExp_Execute(regstr‚content)‚"'"‚"")‚""""‚"")‚"src="‚"")
Response.Write(url)
Response.end
'返回匹配值
Function RegExp_Execute(patrn‚ strng)
Dim regEx‚ Match‚ Matches‚values '建立变量。
Set regEx = New RegExp '建立正则表达式。
regEx.Pattern = patrn '设置模式。
regEx.IgnoreCase = true '设置是否区分字符大小写。
regEx.Global = True '设置全局可用性。
Set Matches = regEx.Execute(strng) '执行搜索。
For Each Match in Matches '遍历匹配集合。
values=values&Match.Value&"‚"
Next
RegExp_Execute = values
End Function
热门标签
