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

本文主要实现了使用vbs脚本调用wget，下载网站所有页面到本脚本目录，并扫描本脚本目录中所有文件，读取本脚本目录中的所有网页，匹配图片 URL 地址，保存所有图片 URL 地址到 url-img.txt 文件，然后调用wget: 下载 url-img.txt 指定的图片到本脚本 img 目录

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.  
5. ' CMD 模式 
6. If Not (LCase(Right(WScript.FullName,11)) = LCase("CScript.exe")) Then 
7. CreateObject("WScript.Shell").Run "cscript.exe //nologo """ & WScript.ScriptFullName & """", 1, False 
8. WScript.Quit(1) 
9. End If 
10.  
11. Dim wso, strMeDir 
12. Set wso = WScript.CreateObject("WScript.Shell") 
13. strMeDir = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName,"/")-1) 
14. ' 启动 wget下载网站所有页面到本脚本目录的 720.hao2046.net 文件夹 
15. WScript.Echo "1. 启动 wget下载网站所有页面到本脚本目录的 720.hao2046.net 文件夹 ……" 
16. wso.Run "wget -r -p -k -c -x -A=jpg,htm,html 720.hao2046.net -P """ & strMeDir & """", 1, True 
17.  
18. ' 扫描 720.hao2046.net 文件夹中所有文件 
19. WScript.Echo "2. 扫描 720.hao2046.net 文件夹中所有文件 ……" 
20. Dim strFolderspec, strHTML, strURL 
21. Dim arr() : ReDim Preserve arr(0) 
22. strFolderspec = strMeDir & "/720.hao2046.net" 
23. Call ScanFolder(arr, strFolderspec) 
24.  
25. ' 建立正则表达式。 
26. Dim regEx 
27. Set regEx = CreateObject("VBScript.RegExp") ' 建立正则表达式。 
28. regEx.IgnoreCase = True ' 设置是否区分大小写。 
29. regEx.Global = True ' 设置全局替换。 
30. regEx.MultiLine = True ' 设置多行匹配模式 
31.  
32. ' 查找所有文件 
33. WScript.Echo "3. 读取 720.hao2046.net 文件夹中的所有网页，匹配图片 URL 地址 ……" 
34. For i = 0 To UBound(arr) 
35. If LCase(Right(arr(i),5)) = ".html" Or LCase(Right(arr(i),4)) = ".htm" Then 
36. ' 读取文件，匹配图片 URL 地址 
37. strHTML = ReadPfile(arr(i), "gb2312") 
38. regEx.Pattern = "src=['""]http:///S+/.jpg['""]" 
39. Set Matches = regEx.Execute(strHTML) ' 执行搜索。 
40. For Each Match in Matches ' 遍历匹配集合。 
41. If Not Match.Value = "" Then 
42. regEx.Pattern = "(src=['""])*(['""])*" 
43. strURL = strURL & regEx.Replace(Match.Value, "") & vbCrLf 
44. End If 
45. Next 
46. End If 
47. Next 
48.  
49. ' 保存所有图片 URL 地址 
50. WScript.Echo "4. 保存所有图片 URL 地址到 url-img.txt 文件 ……" 
51. Call SavePfile(strMeDir & "/url-img.txt", "utf-8", strURL)  
52.  
53. ' 启动 wget 下载图片到本脚本 img 目录 
54. WScript.Echo "5. 启动 wget 下载 url-img.txt 指定的图片到本脚本 img 目录 ……" 
55. wso.Run "wget -c -x -t 5 -i """ & strMeDir & "/url-img.txt"" -P """ & strMeDir & "/img""", 1, True 
56.  
57. Msgbox "完成！" 
58. End Sub 
59.  
60. '=========================================================================================== 
61. '按编码读取txt文件内容 
62. Function ReadPfile(ByVal FileName, ByVal FileCode) 
63. Dim objStream 
64. Set objStream = CreateObject("ADODB.Stream") 
65. ' 
66. With objStream 
67. .Type = 2 
68. .Mode = 3 
69. .open 
70. .Charset = FileCode '不同编码时自己换,Chinese (Simplified) (GB2312),中文 GBK ,繁体中文 Big5 ,日文 EUC-JP ,韩文 EUC-KR,charset=UTF-8(国际化编码),ANSI,Unicode,unicode big endian 
71. .LoadFromFile FileName 
72. ReadPfile = .ReadText 
73. .Close 
74. End With 
75. Set objStream = Nothing 
76. End Function 
77.  
78. '=========================================================================================== 
79. '保存文件为unicode格式文本 
80. Function SavePfile(ByVal FileName, ByVal FileCode, ByVal TextString) 
81. Dim objStream 
82. Set objStream = CreateObject("ADODB.Stream") 
83. With objStream 
84. .Type = 2 
85. .Mode = 3 
86. .Charset = FileCode '不同编码时自己换,Chinese (Simplified) (GB2312),中文 GBK ,繁体中文 Big5 ,日文 EUC-JP ,韩文 EUC-KR,charset=UTF-8(国际化编码),ANSI,Unicode,unicode big endian 
87. .open 
88. .WriteText TextString 
89. .SaveToFile FileName, 2 
90. .Close 
91. End With 
92. Set objStream = Nothing 
93. End Function 
94.  
95. ' Dim arr() : ReDim Preserve arr(0) 
96. ' Call ScanFolder(arr, "V:/") 
97. Sub ScanFolder(ByRef arr, ByVal strFolderspec) 
98. On Error Resume Next 
99. Dim fso, objFolder 
100. Set fso = Createobject("Scripting.FileSystemObject") 
101. Set objFolder = fso.getfolder(strFolderspec) 
102. ReDim Preserve arr(UBound(arr)+1) 
103. arr(UBound(arr)) = strFolderspec & "/" 
104. For Each subFile In objFolder.files 
105. ReDim Preserve arr(UBound(arr)+1) 
106. arr(UBound(arr)) = subFile.path 
107. Next 
108. For Each subFolder In objFolder.subfolders 
109. ScanFolder arr, subFolder.path 
110. Next 
111. Set fso = NoThing 
112. Set objFolder = NoThing 
113. End Sub 

附网页文件查找字符串代码(findstr_html.vbs)：

1. ' findstr_html.vbs 
2. Call Main() 
3. Sub Main() 
4.  
5. ' CMD 模式 
6. If Not (LCase(Right(WScript.FullName,11)) = LCase("CScript.exe")) Then 
7. CreateObject("WScript.Shell").Run "cscript.exe //nologo """ & WScript.ScriptFullName & """", 1, False 
8. WScript.Quit(1) 
9. End If 
10.  
11. Dim strMeDir 
12. strMeDir = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName,"/")-1) 
13. Dim regEx, strHTML, strURL 
14.  
15. ' 扫描文件夹 
16. Dim arr() : ReDim Preserve arr(0) 
17. Call ScanFolder(arr, strMeDir & "/720.hao2046.net") 
18. If UBound(arr) = 0 Then 
19. WScript.Echo strMeDir & "/720.hao2046.net" & ", Not Found!" 
20. Exit Sub 
21. End If 
22.  
23. ' 建立正则表达式。 
24. Set regEx = CreateObject("VBScript.RegExp") ' 建立正则表达式。 
25. regEx.IgnoreCase = True ' 设置是否区分大小写。 
26. regEx.Global = True ' 设置全局替换。 
27. regEx.MultiLine = True ' 设置多行匹配模式 
28.  
29.  
30. Do 
31. strPattern = InputBox("请输入要匹配的正则表达式：","查找所有网页文件","123456") 
32. strInfo = strPattern & vbCrLf & "Not Found!" 
33. For i = 0 To UBound(arr) 
34. If LCase(Right(arr(i),5)) = ".html" Or LCase(Right(arr(i),4)) = ".htm" Then 
35. 'WScript.Echo arr(i) 
36. strHTML = ReadPfile(arr(i), "gb2312") 
37. If InStr(strHTML, strPattern)>0 Then 
38. strInfo = strPattern & vbCrLf & arr(i) & vbCrLf 
39. Exit For 
40. Else 
41. 'regEx.Pattern = "src=['""]http:///S+/.jpg['""]" 
42. regEx.Pattern = strPattern 
43. Set Matches = regEx.Execute(strHTML) ' 执行搜索。 
44. For Each Match in Matches ' 遍历匹配集合。 
45. If Not Match.Value = "" Then 
46. 'regEx.Pattern = "(src=['""])*(['""])*" 
47. 'strURL = strURL & regEx.Replace(Match.Value, "") & vbCrLf 
48. strInfo = strPattern & vbCrLf & arr(i) & vbCrLf 
49. Exit For 
50. End If 
51. Next 
52. End If 
53. End If 
54. Next 
55. WScript.Echo strInfo 
56. Loop 
57. End Sub 
58.  
59.  
60. '=========================================================================================== 
61. '按编码读取txt文件内容 
62. Function ReadPfile(ByVal FileName, ByVal FileCode) 
63. Dim objStream 
64. Set objStream = CreateObject("ADODB.Stream") 
65. ' 
66. With objStream 
67. .Type = 2 
68. .Mode = 3 
69. .open 
70. .Charset = FileCode '不同编码时自己换,Chinese (Simplified) (GB2312),中文 GBK ,繁体中文 Big5 ,日文 EUC-JP ,韩文 EUC-KR,charset=UTF-8(国际化编码),ANSI,Unicode,unicode big endian 
71. .LoadFromFile FileName 
72. ReadPfile = .ReadText 
73. .Close 
74. End With 
75. Set objStream = Nothing 
76. End Function 
77.  
78. ' Dim arr() : ReDim Preserve arr(0) 
79. ' Call ScanFolder(arr, "V:/") 
80. Sub ScanFolder(ByRef arr, ByVal strFolderspec) 
81. On Error Resume Next 
82. Dim fso, objFolder 
83. Set fso = Createobject("Scripting.FileSystemObject") 
84. Set objFolder = fso.getfolder(strFolderspec) 
85. ReDim Preserve arr(UBound(arr)+1) 
86. arr(UBound(arr)) = strFolderspec & "/" 
87. For Each subFile In objFolder.files 
88. ReDim Preserve arr(UBound(arr)+1) 
89. arr(UBound(arr)) = subFile.path 
90. Next 
91. For Each subFolder In objFolder.subfolders 
92. ScanFolder arr, subFolder.path 
93. Next 
94. Set fso = NoThing 
95. Set objFolder = NoThing 
96. End Sub 

提示：

1. 警告：请不要直接运行代码，这里的示范网址可能无法访问、或缺乏安全性，请改为其他网址再使用。

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

../wget.exe

../wget_img.vbs

../findstr_html.vbs