vbs结合wget 实现下载网站图片

2024-04-08 12:13:03 348

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&regEx.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&regEx.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

vbs结合wget 实现下载网站图片

热门推荐

随机推荐