VB脚本实现:批量下载并保留原始目录

 

案例:

批量下载以下链接中的任意文件,并分别按照原始目录进行储存

http://web/2016/pic/1.jpg

http://web/2017/img/2.jpg

http://web/2018/zip/3.zip

 

脚本(保存为vbs格式或下载):


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

 

使用方法:

在D盘中新建文本文档 list.txt  ,并将所有下载链接复制到此文件中。将脚本存于D盘根目录并运行即可

 

发表评论

昵称

沙发空缺中,还不快抢~