vbs结合wget 实现下载网站图片
vbs函数过程：
1.调用wget:下载网站所有页面到本脚本目录……
2.扫描本脚本目录中所有文件……
3.读取本脚本目录中的所有网页，匹配图片URL地址……
4.保存所有图片URL地址到url-img.txt文件……
5.调用wget:下载url-img.txt指定的图片到本脚本img目录……
'wget_img.vbs
CallMain()
SubMain()
'CMD模式
IfNot(LCase(Right(WScript.FullName,11))=LCase("CScript.exe"))Then
CreateObject("WScript.Shell").Run"cscript.exe//nologo"""&WScript.ScriptFullName&"""",1,False
WScript.Quit(1)
EndIf
Dimwso,strMeDir
Setwso=WScript.CreateObject("WScript.Shell")
strMeDir=Left(WScript.ScriptFullName,InStrRev(WScript.ScriptFullName,"\")-1)
'启动wget下载网站所有页面到本脚本目录的720.hao2046.net文件夹
WScript.Echo"1.启动wget下载网站所有页面到本脚本目录的720.hao2046.net文件夹……"
wso.Run"wget-r-p-k-c-x-A=jpg,htm,html720.hao2046.net-P"""&strMeDir&"""",1,True
'扫描720.hao2046.net文件夹中所有文件
WScript.Echo"2.扫描720.hao2046.net文件夹中所有文件……"
DimstrFolderspec,strHTML,strURL
Dimarr():ReDimPreservearr(0)
strFolderspec=strMeDir&"\720.hao2046.net"
CallScanFolder(arr,strFolderspec)
'建立正则表达式。
DimregEx
SetregEx=CreateObject("VBScript.RegExp")'建立正则表达式。
regEx.IgnoreCase=True'设置是否区分大小写。
regEx.Global=True'设置全局替换。
regEx.MultiLine=True'设置多行匹配模式
'查找所有文件
WScript.Echo"3.读取720.hao2046.net文件夹中的所有网页，匹配图片URL地址……"
Fori=0ToUBound(arr)
IfLCase(Right(arr(i),5))=".html"OrLCase(Right(arr(i),4))=".htm"Then
'读取文件，匹配图片URL地址
strHTML=ReadPfile(arr(i),"gb2312")
regEx.Pattern="src=['""]http://\S+\.jpg['""]"
SetMatches=regEx.Execute(strHTML)'执行搜索。
ForEachMatchinMatches'遍历匹配集合。
IfNotMatch.Value=""Then
regEx.Pattern="(src=['""])*(['""])*"
strURL=strURL®Ex.Replace(Match.Value,"")&vbCrLf
EndIf
Next
EndIf
Next
'保存所有图片URL地址
WScript.Echo"4.保存所有图片URL地址到url-img.txt文件……"
CallSavePfile(strMeDir&"\url-img.txt","utf-8",strURL)
'启动wget下载图片到本脚本img目录
WScript.Echo"5.启动wget下载url-img.txt指定的图片到本脚本img目录……"
wso.Run"wget-c-x-t5-i"""&strMeDir&"\url-img.txt""-P"""&strMeDir&"\img""",1,True
Msgbox"完成！"
EndSub
'===========================================================================================
'按编码读取txt文件内容
FunctionReadPfile(ByValFileName,ByValFileCode)
DimobjStream
SetobjStream=CreateObject("ADODB.Stream")
'
WithobjStream
.Type=2
.Mode=3
.open
.Charset=FileCode'不同编码时自己换,Chinese(Simplified)(GB2312),中文GBK,繁体中文Big5,日文EUC-JP,韩文EUC-KR,charset=UTF-8(国际化编码),ANSI,Unicode,unicodebigendian
.LoadFromFileFileName
ReadPfile=.ReadText
.Close
EndWith
SetobjStream=Nothing
EndFunction
'===========================================================================================
'保存文件为unicode格式文本
FunctionSavePfile(ByValFileName,ByValFileCode,ByValTextString)
DimobjStream
SetobjStream=CreateObject("ADODB.Stream")
WithobjStream
.Type=2
.Mode=3
.Charset=FileCode'不同编码时自己换,Chinese(Simplified)(GB2312),中文GBK,繁体中文Big5,日文EUC-JP,韩文EUC-KR,charset=UTF-8(国际化编码),ANSI,Unicode,unicodebigendian
.open
.WriteTextTextString
.SaveToFileFileName,2
.Close
EndWith
SetobjStream=Nothing
EndFunction
'Dimarr():ReDimPreservearr(0)
'CallScanFolder(arr,"V:\")
SubScanFolder(ByRefarr,ByValstrFolderspec)
OnErrorResumeNext
Dimfso,objFolder
Setfso=Createobject("Scripting.FileSystemObject")
SetobjFolder=fso.getfolder(strFolderspec)
ReDimPreservearr(UBound(arr)+1)
arr(UBound(arr))=strFolderspec&"\"
ForEachsubFileInobjFolder.files
ReDimPreservearr(UBound(arr)+1)
arr(UBound(arr))=subFile.path
Next
ForEachsubFolderInobjFolder.subfolders
ScanFolderarr,subFolder.path
Next
Setfso=NoThing
SetobjFolder=NoThing
EndSub
附网页文件查找字符串代码(findstr_html.vbs)：
'findstr_html.vbs
CallMain()
SubMain()
'CMD模式
IfNot(LCase(Right(WScript.FullName,11))=LCase("CScript.exe"))Then
CreateObject("WScript.Shell").Run"cscript.exe//nologo"""&WScript.ScriptFullName&"""",1,False
WScript.Quit(1)
EndIf
DimstrMeDir
strMeDir=Left(WScript.ScriptFullName,InStrRev(WScript.ScriptFullName,"\")-1)
DimregEx,strHTML,strURL
'扫描文件夹
Dimarr():ReDimPreservearr(0)
CallScanFolder(arr,strMeDir&"\720.hao2046.net")
IfUBound(arr)=0Then
WScript.EchostrMeDir&"\720.hao2046.net"&",NotFound!"
ExitSub
EndIf
'建立正则表达式。
SetregEx=CreateObject("VBScript.RegExp")'建立正则表达式。
regEx.IgnoreCase=True'设置是否区分大小写。
regEx.Global=True'设置全局替换。
regEx.MultiLine=True'设置多行匹配模式
Do
strPattern=InputBox("请输入要匹配的正则表达式：","查找所有网页文件","123456")
strInfo=strPattern&vbCrLf&"NotFound!"
Fori=0ToUBound(arr)
IfLCase(Right(arr(i),5))=".html"OrLCase(Right(arr(i),4))=".htm"Then
'WScript.Echoarr(i)
strHTML=ReadPfile(arr(i),"gb2312")
IfInStr(strHTML,strPattern)>0Then
strInfo=strPattern&vbCrLf&arr(i)&vbCrLf
ExitFor
Else
'regEx.Pattern="src=['""]http://\S+\.jpg['""]"
regEx.Pattern=strPattern
SetMatches=regEx.Execute(strHTML)'执行搜索。
ForEachMatchinMatches'遍历匹配集合。
IfNotMatch.Value=""Then
'regEx.Pattern="(src=['""])*(['""])*"
'strURL=strURL®Ex.Replace(Match.Value,"")&vbCrLf
strInfo=strPattern&vbCrLf&arr(i)&vbCrLf
ExitFor
EndIf
Next
EndIf
EndIf
Next
WScript.EchostrInfo
Loop
EndSub
'===========================================================================================
'按编码读取txt文件内容
FunctionReadPfile(ByValFileName,ByValFileCode)
DimobjStream
SetobjStream=CreateObject("ADODB.Stream")
'
WithobjStream
.Type=2
.Mode=3
.open
.Charset=FileCode'不同编码时自己换,Chinese(Simplified)(GB2312),中文GBK,繁体中文Big5,日文EUC-JP,韩文EUC-KR,charset=UTF-8(国际化编码),ANSI,Unicode,unicodebigendian
.LoadFromFileFileName
ReadPfile=.ReadText
.Close
EndWith
SetobjStream=Nothing
EndFunction
'Dimarr():ReDimPreservearr(0)
'CallScanFolder(arr,"V:\")
SubScanFolder(ByRefarr,ByValstrFolderspec)
OnErrorResumeNext
Dimfso,objFolder
Setfso=Createobject("Scripting.FileSystemObject")
SetobjFolder=fso.getfolder(strFolderspec)
ReDimPreservearr(UBound(arr)+1)
arr(UBound(arr))=strFolderspec&"\"
ForEachsubFileInobjFolder.files
ReDimPreservearr(UBound(arr)+1)
arr(UBound(arr))=subFile.path
Next
ForEachsubFolderInobjFolder.subfolders
ScanFolderarr,subFolder.path
Next
Setfso=NoThing
SetobjFolder=NoThing
EndSub
提示：
1.警告：请不要直接运行代码，这里的示范网址可能无法访问、或缺乏安全性，请改为其他网址再使用。
2.请将wget.exe放置于脚本同一目录下，然后执行。文件结构如下：
..\wget.exe
..\wget_img.vbs
..\findstr_html.vbs