批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程
[批处理文件精品]批处理版照片整理器[批处理文件精品]纯批处理备份&还原驱动在线第三方下载
返回列表 发帖

[原创] vbs+wget 实现网站图片下载 by yu2n

本帖最后由 yu2n 于 2014-7-1 04:52 编辑

vbs 函数过程:
1. 调用wget: 下载网站所有页面到本脚本目录 ……
2. 扫描本脚本目录中所有文件 ……
3. 读取本脚本目录中的所有网页,匹配图片 URL 地址 ……
4. 保存所有图片 URL 地址到 url-img.txt 文件 ……
5. 调用wget: 下载 url-img.txt 指定的图片到本脚本 img 目录 ……
  1. ' wget_img.vbs
  2. Call Main()
  3. Sub Main()
  4.   ' CMD 模式
  5.   If Not (LCase(Right(WScript.FullName,11)) = LCase("CScript.exe")) Then
  6.     CreateObject("WScript.Shell").Run "cscript.exe //nologo """ & WScript.ScriptFullName & """", 1, False
  7.     WScript.Quit(1)
  8.   End If
  9.   
  10.   Dim wso, strMeDir
  11.   Set wso = WScript.CreateObject("WScript.Shell")
  12.   strMeDir = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName,"\")-1)
  13.   ' 启动 wget下载网站所有页面到本脚本目录的 720.hao2046.net 文件夹
  14.   WScript.Echo "1. 启动 wget下载网站所有页面到本脚本目录的 720.hao2046.net 文件夹 ……"
  15.   wso.Run "wget -r -p -k -c -x -A=jpg,htm,html 720.hao2046.net -P """ & strMeDir & """", 1, True
  16.   ' 扫描 720.hao2046.net 文件夹中所有文件
  17.   WScript.Echo "2. 扫描 720.hao2046.net 文件夹中所有文件 ……"
  18.   Dim strFolderspec, strHTML, strURL
  19.   Dim arr() : ReDim Preserve arr(0)
  20.   strFolderspec = strMeDir & "\720.hao2046.net"
  21.   Call ScanFolder(arr, strFolderspec)
  22.   
  23.   ' 建立正则表达式。
  24.   Dim regEx
  25.   Set regEx = CreateObject("VBScript.RegExp")     ' 建立正则表达式。
  26.   regEx.IgnoreCase = True     ' 设置是否区分大小写。
  27.   regEx.Global = True         ' 设置全局替换。
  28.   regEx.MultiLine = True      ' 设置多行匹配模式
  29.   
  30.   ' 查找所有文件
  31.   WScript.Echo "3. 读取 720.hao2046.net 文件夹中的所有网页,匹配图片 URL 地址 ……"
  32.   For i = 0 To UBound(arr)
  33.       If LCase(Right(arr(i),5)) = ".html" Or LCase(Right(arr(i),4)) = ".htm" Then
  34.           ' 读取文件,匹配图片 URL 地址
  35.           strHTML = ReadPfile(arr(i), "gb2312")
  36.           regEx.Pattern = "src=['""]http://\S+\.jpg['""]"
  37.           Set Matches = regEx.Execute(strHTML)      ' 执行搜索。
  38.           For Each Match in Matches  ' 遍历匹配集合。
  39.               If Not Match.Value = "" Then
  40.                   regEx.Pattern = "(src=['""])*(['""])*"
  41.                   strURL = strURL & regEx.Replace(Match.Value, "") & vbCrLf
  42.               End If
  43.           Next
  44.       End If
  45.   Next
  46.   
  47.   ' 保存所有图片 URL 地址
  48.   WScript.Echo "4. 保存所有图片 URL 地址到 url-img.txt 文件 ……"
  49.   Call SavePfile(strMeDir & "\url-img.txt", "utf-8", strURL)
  50.   
  51.   ' 启动 wget 下载图片到本脚本 img 目录
  52.   WScript.Echo "5. 启动 wget 下载 url-img.txt 指定的图片到本脚本 img 目录 ……"
  53.   wso.Run "wget -c -x -t 5 -i """ & strMeDir & "\url-img.txt"" -P """ & strMeDir & "\img""", 1, True
  54.   
  55.   Msgbox "完成!"
  56. End Sub
  57. '===========================================================================================
  58. '按编码读取txt文件内容
  59. Function ReadPfile(ByVal FileName, ByVal FileCode)
  60.     Dim objStream
  61.     Set objStream = CreateObject("ADODB.Stream")
  62.     '
  63.     With objStream
  64.         .Type = 2
  65.         .Mode = 3
  66.         .open
  67.         .Charset = FileCode      '不同编码时自己换,Chinese (Simplified) (GB2312),中文 GBK ,繁体中文 Big5 ,日文 EUC-JP ,韩文 EUC-KR,charset=UTF-8(国际化编码),ANSI,Unicode,unicode big endian
  68.         .LoadFromFile FileName
  69.          ReadPfile = .ReadText
  70.         .Close
  71.     End With
  72.     Set objStream = Nothing
  73. End Function
  74. '===========================================================================================
  75. '保存文件为unicode格式文本
  76. Function SavePfile(ByVal FileName, ByVal FileCode, ByVal TextString)
  77.     Dim objStream
  78.     Set objStream = CreateObject("ADODB.Stream")
  79.     With objStream
  80.         .Type = 2
  81.         .Mode = 3
  82.         .Charset = FileCode      '不同编码时自己换,Chinese (Simplified) (GB2312),中文 GBK ,繁体中文 Big5 ,日文 EUC-JP ,韩文 EUC-KR,charset=UTF-8(国际化编码),ANSI,Unicode,unicode big endian
  83.         .open
  84.         .WriteText TextString
  85.         .SaveToFile FileName, 2
  86.         .Close
  87.     End With
  88.     Set objStream = Nothing
  89. End Function
  90. '    Dim arr() : ReDim Preserve arr(0)
  91. '    Call ScanFolder(arr, "V:\")
  92. Sub ScanFolder(ByRef arr, ByVal strFolderspec)
  93.     On Error Resume  Next
  94.     Dim fso, objFolder
  95.     Set fso = Createobject("Scripting.FileSystemObject")
  96.     Set objFolder = fso.getfolder(strFolderspec)
  97.     ReDim Preserve arr(UBound(arr)+1)
  98.     arr(UBound(arr)) = strFolderspec & "\"
  99.     For Each subFile In objFolder.files
  100.         ReDim Preserve arr(UBound(arr)+1)
  101.         arr(UBound(arr)) = subFile.path
  102.     Next
  103.     For Each subFolder In objFolder.subfolders
  104.         ScanFolder arr, subFolder.path
  105.     Next
  106.     Set fso = NoThing
  107.     Set objFolder = NoThing
  108. End Sub  
复制代码
附网页文件查找字符串代码(findstr_html.vbs):
  1. ' findstr_html.vbs
  2. Call Main()
  3. Sub Main()
  4.   ' CMD 模式
  5.   If Not (LCase(Right(WScript.FullName,11)) = LCase("CScript.exe")) Then
  6.     CreateObject("WScript.Shell").Run "cscript.exe //nologo """ & WScript.ScriptFullName & """", 1, False
  7.     WScript.Quit(1)
  8.   End If
  9.   Dim strMeDir
  10.   strMeDir = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName,"\")-1)
  11.   Dim regEx, strHTML, strURL
  12.   
  13.   ' 扫描文件夹
  14.   Dim arr() : ReDim Preserve arr(0)
  15.   Call ScanFolder(arr, strMeDir & "\720.hao2046.net")
  16.   If UBound(arr) = 0 Then
  17.     WScript.Echo strMeDir & "\720.hao2046.net" & ", Not Found!"
  18.     Exit Sub
  19.   End If
  20.   ' 建立正则表达式。
  21.   Set regEx = CreateObject("VBScript.RegExp")     ' 建立正则表达式。
  22.   regEx.IgnoreCase = True     ' 设置是否区分大小写。
  23.   regEx.Global = True         ' 设置全局替换。
  24.   regEx.MultiLine = True      ' 设置多行匹配模式
  25.   
  26.   
  27.   Do
  28.     strPattern = InputBox("请输入要匹配的正则表达式:","查找所有网页文件","123456")
  29.     strInfo = strPattern & vbCrLf & "Not Found!"
  30.     For i = 0 To UBound(arr)
  31.       If LCase(Right(arr(i),5)) = ".html" Or LCase(Right(arr(i),4)) = ".htm" Then
  32.         'WScript.Echo arr(i)
  33.         strHTML = ReadPfile(arr(i), "gb2312")
  34.         If InStr(strHTML, strPattern)>0 Then
  35.           strInfo = strPattern & vbCrLf & arr(i) & vbCrLf
  36.           Exit For
  37.         Else
  38.           'regEx.Pattern = "src=['""]http://\S+\.jpg['""]"
  39.           regEx.Pattern = strPattern
  40.           Set Matches = regEx.Execute(strHTML)      ' 执行搜索。
  41.           For Each Match in Matches  ' 遍历匹配集合。
  42.             If Not Match.Value = "" Then
  43.               'regEx.Pattern = "(src=['""])*(['""])*"
  44.               'strURL = strURL & regEx.Replace(Match.Value, "") & vbCrLf
  45.               strInfo = strPattern & vbCrLf & arr(i) & vbCrLf
  46.               Exit For
  47.             End If
  48.           Next
  49.         End If
  50.       End If
  51.     Next
  52.     WScript.Echo strInfo
  53.     Loop
  54. End Sub
  55. '===========================================================================================
  56. '按编码读取txt文件内容
  57. Function ReadPfile(ByVal FileName, ByVal FileCode)
  58.     Dim objStream
  59.     Set objStream = CreateObject("ADODB.Stream")
  60.     '
  61.     With objStream
  62.         .Type = 2
  63.         .Mode = 3
  64.         .open
  65.         .Charset = FileCode      '不同编码时自己换,Chinese (Simplified) (GB2312),中文 GBK ,繁体中文 Big5 ,日文 EUC-JP ,韩文 EUC-KR,charset=UTF-8(国际化编码),ANSI,Unicode,unicode big endian
  66.         .LoadFromFile FileName
  67.          ReadPfile = .ReadText
  68.         .Close
  69.     End With
  70.     Set objStream = Nothing
  71. End Function
  72. '    Dim arr() : ReDim Preserve arr(0)
  73. '    Call ScanFolder(arr, "V:\")
  74. Sub ScanFolder(ByRef arr, ByVal strFolderspec)
  75.     On Error Resume  Next
  76.     Dim fso, objFolder
  77.     Set fso = Createobject("Scripting.FileSystemObject")
  78.     Set objFolder = fso.getfolder(strFolderspec)
  79.     ReDim Preserve arr(UBound(arr)+1)
  80.     arr(UBound(arr)) = strFolderspec & "\"
  81.     For Each subFile In objFolder.files
  82.         ReDim Preserve arr(UBound(arr)+1)
  83.         arr(UBound(arr)) = subFile.path
  84.     Next
  85.     For Each subFolder In objFolder.subfolders
  86.         ScanFolder arr, subFolder.path
  87.     Next
  88.     Set fso = NoThing
  89.     Set objFolder = NoThing
  90. End Sub  
复制代码
提示:
1. 警告:请不要直接运行代码,这里的示范网址可能无法访问、或缺乏安全性,请改为其他网址再使用。
2. 请将 wget.exe 放置于脚本同一目录下,然后执行。文件结构如下:
  ..\wget.exe
  ..\wget_img.vbs
  ..\findstr_html.vbs
『千江有水千江月』千江有水,月映千江;万里无云,万里青天。    http://yu2n.qiniudn.com/

感谢分享,很强大

TOP

O(∩_∩)O谢谢楼主,高手!!!

TOP

返回列表