批量下载文件保存到不同的原始路径

今天有一个需求,想找个工具来实现,结果搜遍了整个网络都没有找到,最后在一个论坛里看到一个哥们写的VBS脚本实现了,特此记录。

原帖地址:http://bbs.et8.net/bbs/showthread.php?t=932274
批量下载网络的文件,但是保存到网络地址的原始路径里面,比如:

http://xxx/a/a.jpg
下载到
d:\a\a.jpg

http://xxx/b/b.jpg
下载到
d:\b\b.jpg

http://xxx/c/c.jpg
下载到
d:\c\c.jpg

http://xxx/d/d.jpg
下载到
d:\d\d.jpg

下面是测试成功的VBS脚本代码:
把所有目标URL保存在的盘的list.txt文件中,运行即可批量保存在D盘根目录,支持无数级子目录。
程序代码 程序代码
dim ofs, oif
dim sof, slf, data, strloc, info

Const OPEN_FILE_FOR_READING = 1

strloc="d:" 'any path string
sof = "d:\list.txt" 'list file location
set ofs=createobject("Scripting.fileSystemObject")
set oif=ofs.opentextfile(sof, OPEN_FILE_FOR_READING)

data=split(oif.readall, vbnewline)

for each d In data
    slf=getlocal(d, strloc)
    info=makedir(ofs.getparentfoldername(slf))
    httpsave d, slf
next

oif.close
Set ofs = Nothing

WScript.Quit(0)

sub httpsave(surl , slocal)

dim oxmlhttp,ostream

on error resume next
set oxmlhttp=createobject("msxml2.xmlhttp")
if err.number<>0 then
    wscript.echo "msxml2.xmlhttp not installed. Operation aborted."
    wscript.quit(1)
end if
with oxmlhttp
    .open "get",surl,false
    .send
end with
if err.number<>0 then
    wscript.echo "Resource unavailable for varied reasons. Operation aborted."
    set oxmlhttp=nothing : wscript.quit(2)
end if

set ostream = createobject("adodb.stream")
with ostream
    .type=1    'binary
    .mode=3    'read-write
    .open
    .write oxmlhttp.responsebody
    .savetofile slocal,2    'save-create-overwrite
    .close
end with
if err.number<>0 then
    wscript.echo err.description & " Operation aborted"
else
    wscript.echo "Done!" & vbcrlf & "Source : " & surl & vbcrlf & "Local : " & slocal
end if
on error goto 0
set ostream=nothing : set oxmlhttp=nothing

end sub

function getlocal(surl, lloc)

dim re, tstr
set re=new regexp

re.pattern=".*?://.*?/(.*)"
re.ignorecase=true
re.global=true
tstr=re.replace(surl, "$1")

if right(lloc, 1)<>"\" then
  lloc=lloc & "\"
end if

getlocal=lloc & replace(tstr, "/", "\")

end function

function makedir (strpath)
  dim strppath, fso
  set fso=createobject("Scripting.fileSystemObject")
  on error resume next
  strppath=fso.getparentfoldername(strpath)

  If not fso.folderexists(strppath) then makedir strppath
    If not fso.folderexists(strpath) then fso.createfolder strpath
    on error goto 0
  makedir = fso.folderexists(strpath)
end function



[本日志由 刚子 于 2014-09-24 08:51 PM 编辑]
文章来自: 本站原创
引用通告: 查看所有引用 | 我要引用此文章
Tags:
相关日志:
评论: 0 | 引用: 0 | 查看次数: -
发表评论
昵 称:
密 码: 游客发言不需要密码.
内 容:
验证码: 验证码
选 项:
虽然发表评论不用注册,但是为了保护您的发言权,建议您注册帐号.