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