vbs 函數(shù)過(guò)程：
1. 調(diào)用wget: 下載網(wǎng)站所有頁(yè)面到本腳本目錄 ……
2. 掃描本腳本目錄中所有文件 ……
3. 讀取本腳本目錄中的所有網(wǎng)頁(yè)，匹配圖片 URL 地址 ……
4. 保存所有圖片 URL 地址到 url-img.txt 文件 ……
5. 調(diào)用wget: 下載 url-img.txt 指定的圖片到本腳本 img 目錄 ……
' wget_img.vbs
Call Main()
Sub Main()
' CMD 模式
If Not (LCase(Right(WScript.FullName,11)) = LCase("CScript.exe")) Then
CreateObject("WScript.Shell").Run "cscript.exe //nologo """ & WScript.ScriptFullName & """", 1, False
WScript.Quit(1)
End If
Dim wso, strMeDir
Set wso = WScript.CreateObject("WScript.Shell")
strMeDir = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName,"\")-1)
' 啟動(dòng) wget下載網(wǎng)站所有頁(yè)面到本腳本目錄的 720.hao2046.net 文件夾
WScript.Echo "1. 啟動(dòng) wget下載網(wǎng)站所有頁(yè)面到本腳本目錄的 720.hao2046.net 文件夾 ……"
wso.Run "wget -r -p -k -c -x -A=jpg,htm,html 720.hao2046.net -P """ & strMeDir & """", 1, True
' 掃描 720.hao2046.net 文件夾中所有文件
WScript.Echo "2. 掃描 720.hao2046.net 文件夾中所有文件 ……"
Dim strFolderspec, strHTML, strURL
Dim arr() : ReDim Preserve arr(0)
strFolderspec = strMeDir & "\720.hao2046.net"
Call ScanFolder(arr, strFolderspec)
' 建立正則表達(dá)式。
Dim regEx
Set regEx = CreateObject("VBScript.RegExp") ' 建立正則表達(dá)式。
regEx.IgnoreCase = True ' 設(shè)置是否區(qū)分大小寫(xiě)。
regEx.Global = True ' 設(shè)置全局替換。
regEx.MultiLine = True ' 設(shè)置多行匹配模式
' 查找所有文件
WScript.Echo "3. 讀取 720.hao2046.net 文件夾中的所有網(wǎng)頁(yè)，匹配圖片 URL 地址 ……"
For i = 0 To UBound(arr)
If LCase(Right(arr(i),5)) = ".html" Or LCase(Right(arr(i),4)) = ".htm" Then
' 讀取文件，匹配圖片 URL 地址
strHTML = ReadPfile(arr(i), "gb2312")
regEx.Pattern = "src=['""]http://\S+\.jpg['""]"
Set Matches = regEx.Execute(strHTML) ' 執(zhí)行搜索。
For Each Match in Matches ' 遍歷匹配集合。
If Not Match.Value = "" Then
regEx.Pattern = "(src=['""])*(['""])*"
strURL = strURL & regEx.Replace(Match.Value, "") & vbCrLf
End If
Next
End If
Next
' 保存所有圖片 URL 地址
WScript.Echo "4. 保存所有圖片 URL 地址到 url-img.txt 文件 ……"
Call SavePfile(strMeDir & "\url-img.txt", "utf-8", strURL)
' 啟動(dòng) wget 下載圖片到本腳本 img 目錄
WScript.Echo "5. 啟動(dòng) wget 下載 url-img.txt 指定的圖片到本腳本 img 目錄 ……"
wso.Run "wget -c -x -t 5 -i """ & strMeDir & "\url-img.txt"" -P """ & strMeDir & "\img""", 1, True
Msgbox "完成！"
End Sub
'===========================================================================================
'按編碼讀取txt文件內(nèi)容
Function ReadPfile(ByVal FileName, ByVal FileCode)
Dim objStream
Set objStream = CreateObject("ADODB.Stream")
'
With objStream
.Type = 2
.Mode = 3
.open
.Charset = FileCode '不同編碼時(shí)自己換,Chinese (Simplified) (GB2312),中文 GBK ,繁體中文 Big5 ,日文 EUC-JP ,韓文 EUC-KR,charset=UTF-8(國(guó)際化編碼),ANSI,Unicode,unicode big endian
.LoadFromFile FileName
ReadPfile = .ReadText
.Close
End With
Set objStream = Nothing
End Function
'===========================================================================================
'保存文件為unicode格式文本
Function SavePfile(ByVal FileName, ByVal FileCode, ByVal TextString)
Dim objStream
Set objStream = CreateObject("ADODB.Stream")
With objStream
.Type = 2
.Mode = 3
.Charset = FileCode '不同編碼時(shí)自己換,Chinese (Simplified) (GB2312),中文 GBK ,繁體中文 Big5 ,日文 EUC-JP ,韓文 EUC-KR,charset=UTF-8(國(guó)際化編碼),ANSI,Unicode,unicode big endian
.open
.WriteText TextString
.SaveToFile FileName, 2
.Close
End With
Set objStream = Nothing
End Function
' Dim arr() : ReDim Preserve arr(0)
' Call ScanFolder(arr, "V:\")
Sub ScanFolder(ByRef arr, ByVal strFolderspec)
On Error Resume Next
Dim fso, objFolder
Set fso = Createobject("Scripting.FileSystemObject")
Set objFolder = fso.getfolder(strFolderspec)
ReDim Preserve arr(UBound(arr)+1)
arr(UBound(arr)) = strFolderspec & "\"
For Each subFile In objFolder.files
ReDim Preserve arr(UBound(arr)+1)
arr(UBound(arr)) = subFile.path
Next
For Each subFolder In objFolder.subfolders
ScanFolder arr, subFolder.path
Next
Set fso = NoThing
Set objFolder = NoThing
End Sub
附網(wǎng)頁(yè)文件查找字符串代碼(findstr_html.vbs)：
' findstr_html.vbs
Call Main()
Sub Main()
' CMD 模式
If Not (LCase(Right(WScript.FullName,11)) = LCase("CScript.exe")) Then
CreateObject("WScript.Shell").Run "cscript.exe //nologo """ & WScript.ScriptFullName & """", 1, False
WScript.Quit(1)
End If
Dim strMeDir
strMeDir = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName,"\")-1)
Dim regEx, strHTML, strURL
' 掃描文件夾
Dim arr() : ReDim Preserve arr(0)
Call ScanFolder(arr, strMeDir & "\720.hao2046.net")
If UBound(arr) = 0 Then
WScript.Echo strMeDir & "\720.hao2046.net" & ", Not Found!"
Exit Sub
End If
' 建立正則表達(dá)式。
Set regEx = CreateObject("VBScript.RegExp") ' 建立正則表達(dá)式。
regEx.IgnoreCase = True ' 設(shè)置是否區(qū)分大小寫(xiě)。
regEx.Global = True ' 設(shè)置全局替換。
regEx.MultiLine = True ' 設(shè)置多行匹配模式
Do
strPattern = InputBox("請(qǐng)輸入要匹配的正則表達(dá)式：","查找所有網(wǎng)頁(yè)文件","123456")
strInfo = strPattern & vbCrLf & "Not Found!"
For i = 0 To UBound(arr)
If LCase(Right(arr(i),5)) = ".html" Or LCase(Right(arr(i),4)) = ".htm" Then
'WScript.Echo arr(i)
strHTML = ReadPfile(arr(i), "gb2312")
If InStr(strHTML, strPattern)>0 Then
strInfo = strPattern & vbCrLf & arr(i) & vbCrLf
Exit For
Else
'regEx.Pattern = "src=['""]http://\S+\.jpg['""]"
regEx.Pattern = strPattern
Set Matches = regEx.Execute(strHTML) ' 執(zhí)行搜索。
For Each Match in Matches ' 遍歷匹配集合。
If Not Match.Value = "" Then
'regEx.Pattern = "(src=['""])*(['""])*"
'strURL = strURL & regEx.Replace(Match.Value, "") & vbCrLf
strInfo = strPattern & vbCrLf & arr(i) & vbCrLf
Exit For
End If
Next
End If
End If
Next
WScript.Echo strInfo
Loop
End Sub
'===========================================================================================
'按編碼讀取txt文件內(nèi)容
Function ReadPfile(ByVal FileName, ByVal FileCode)
Dim objStream
Set objStream = CreateObject("ADODB.Stream")
'
With objStream
.Type = 2
.Mode = 3
.open
.Charset = FileCode '不同編碼時(shí)自己換,Chinese (Simplified) (GB2312),中文 GBK ,繁體中文 Big5 ,日文 EUC-JP ,韓文 EUC-KR,charset=UTF-8(國(guó)際化編碼),ANSI,Unicode,unicode big endian
.LoadFromFile FileName
ReadPfile = .ReadText
.Close
End With
Set objStream = Nothing
End Function
' Dim arr() : ReDim Preserve arr(0)
' Call ScanFolder(arr, "V:\")
Sub ScanFolder(ByRef arr, ByVal strFolderspec)
On Error Resume Next
Dim fso, objFolder
Set fso = Createobject("Scripting.FileSystemObject")
Set objFolder = fso.getfolder(strFolderspec)
ReDim Preserve arr(UBound(arr)+1)
arr(UBound(arr)) = strFolderspec & "\"
For Each subFile In objFolder.files
ReDim Preserve arr(UBound(arr)+1)
arr(UBound(arr)) = subFile.path
Next
For Each subFolder In objFolder.subfolders
ScanFolder arr, subFolder.path
Next
Set fso = NoThing
Set objFolder = NoThing
End Sub
提示：
1. 警告：請(qǐng)不要直接運(yùn)行代碼，這里的示范網(wǎng)址可能無(wú)法訪問(wèn)、或缺乏安全性，請(qǐng)改為其他網(wǎng)址再使用。
2. 請(qǐng)將 wget.exe 放置于腳本同一目錄下，然后執(zhí)行。文件結(jié)構(gòu)如下：
..\wget.exe
..\wget_img.vbs
..\findstr_html.vbs