vbs结合wget 实现下载网站图片
来源:易贤网 阅读:1073 次 日期:2016-06-30 10:35:11
温馨提示:易贤网小编为您整理了“vbs结合wget 实现下载网站图片”,方便广大网友查阅!

vbs 函数过程:

1. 调用wget: 下载网站所有页面到本脚本目录 ……

2. 扫描本脚本目录中所有文件 ……

3. 读取本脚本目录中的所有网页,匹配图片 URL 地址 ……

4. 保存所有图片 URL 地址到 url-img.txt 文件 ……

5. 调用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)

 ' 启动 wget下载网站所有页面到本脚本目录的 720.hao2046.net 文件夹

 WScript.Echo "1. 启动 wget下载网站所有页面到本脚本目录的 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)

 ' 建立正则表达式。

 Dim regEx

 Set regEx = CreateObject("VBScript.RegExp")   ' 建立正则表达式。

 regEx.IgnoreCase = True   ' 设置是否区分大小写。

 regEx.Global = True     ' 设置全局替换。

 regEx.MultiLine = True   ' 设置多行匹配模式

 ' 查找所有文件

 WScript.Echo "3. 读取 720.hao2046.net 文件夹中的所有网页,匹配图片 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)   ' 执行搜索。

     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) 

 ' 启动 wget 下载图片到本脚本 img 目录

 WScript.Echo "5. 启动 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文件内容

Function ReadPfile(ByVal FileName, ByVal FileCode)

  Dim objStream

  Set objStream = CreateObject("ADODB.Stream")

  '

  With objStream

    .Type = 2

    .Mode = 3

    .open

    .Charset = FileCode   '不同编码时自己换,Chinese (Simplified) (GB2312),中文 GBK ,繁体中文 Big5 ,日文 EUC-JP ,韩文 EUC-KR,charset=UTF-8(国际化编码),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   '不同编码时自己换,Chinese (Simplified) (GB2312),中文 GBK ,繁体中文 Big5 ,日文 EUC-JP ,韩文 EUC-KR,charset=UTF-8(国际化编码),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

附网页文件查找字符串代码(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

 ' 建立正则表达式。

 Set regEx = CreateObject("VBScript.RegExp")   ' 建立正则表达式。

 regEx.IgnoreCase = True   ' 设置是否区分大小写。

 regEx.Global = True     ' 设置全局替换。

 regEx.MultiLine = True   ' 设置多行匹配模式

 Do

  strPattern = InputBox("请输入要匹配的正则表达式:","查找所有网页文件","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)   ' 执行搜索。

     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文件内容

Function ReadPfile(ByVal FileName, ByVal FileCode)

  Dim objStream

  Set objStream = CreateObject("ADODB.Stream")

  '

  With objStream

    .Type = 2

    .Mode = 3

    .open

    .Charset = FileCode   '不同编码时自己换,Chinese (Simplified) (GB2312),中文 GBK ,繁体中文 Big5 ,日文 EUC-JP ,韩文 EUC-KR,charset=UTF-8(国际化编码),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. 警告:请不要直接运行代码,这里的示范网址可能无法访问、或缺乏安全性,请改为其他网址再使用。

2. 请将 wget.exe 放置于脚本同一目录下,然后执行。文件结构如下:

..\wget.exe

..\wget_img.vbs

..\findstr_html.vbs

更多信息请查看脚本栏目
易贤网手机网站地址:vbs结合wget 实现下载网站图片
由于各方面情况的不断调整与变化,易贤网提供的所有考试信息和咨询回复仅供参考,敬请考生以权威部门公布的正式信息和咨询为准!
关于我们 | 联系我们 | 人才招聘 | 网站声明 | 网站帮助 | 非正式的简要咨询 | 简要咨询须知 | 加入群交流 | 手机站点 | 投诉建议
工业和信息化部备案号:滇ICP备2023014141号-1 云南省教育厅备案号:云教ICP备0901021 滇公网安备53010202001879号 人力资源服务许可证:(云)人服证字(2023)第0102001523号
云南网警备案专用图标
联系电话:0871-65317125(9:00—18:00) 获取招聘考试信息及咨询关注公众号:hfpxwx
咨询QQ:526150442(9:00—18:00)版权所有:易贤网
云南网警报警专用图标