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