vbs 多线程下载实现代码

话说还是闲来练手，初步实现了自己认为的“多线程”下载。(至于是不是多线程，可以参考12楼链接)
为避免冗余，省了一些错误检查。我觉得没多大实际用途，有兴趣的兄弟一起学习讨论呗。欢迎大家指正:

'by wankoilz

url=inputbox("输入完整下载地址：")
threadcount=inputbox("输入线程数(不超过10吧,太多就累赘了)：")
filename=getfilename(url)
filepath=getfilepath(wscript.scriptfullname)
set ohttp=createobject("msxml2.xmlhttp")
set ado=createobject("adodb.stream")
set fso=createobject("scripting.filesystemobject")
ado.type=1
ado.mode=3
ado.open
ohttp.open "head",url,true
ohttp.send
do while ohttp.readystate<>4
wscript.sleep 200
loop
'获得文件大小
filesize=ohttp.getresponseheader("content-length")
ohttp.abort
'创建一个和下载文件同样大小的临时文件,供下面ado分段重写
fso.createtextfile(filepath&"tmpfile",true,false).write(space(filesize))
ado.loadfromfile(filepath&"tmpfile")

blocksize=fix(filesize/threadcount):remaindersize=filesize-threadcount*blocksize
upbound=threadcount-1
'定义包含msxml2.xmlhttp对象的数组,·成员数量便是线程数
'直接 dim 数组名(变量名) 是不行的，这里用execute变通了一下
execute("dim arrhttp("&upbound&")")
for i=0 to ubound(arrhttp)
startpos=i*blocksize
endpos=(i+1)*blocksize-1
if i=ubound(arrhttp) then endpos=endpos+remaindersize
set arrhttp(i)=createobject("msxml2.xmlhttp")
arrhttp(i).open "get",url,true
'分段下载
arrhttp(i).setrequestheader "range","bytes="&startpos&"-"&endpos
arrhttp(i).send
next
do
wscript.sleep 200
for i=0 to ubound(arrhttp)
if arrhttp(i).readystate=4 then
'每当一个线程下载完毕就将其写入临时文件的相应位置
ado.position=i*blocksize
msgbox "线程"&i&"下载完毕！"
ado.write arrhttp(i).responsebody
arrhttp(i).abort
complete=complete+1
end if
next
if complete=ubound(arrhttp)+1 then exit do
timeout=timeout+1
if timeout=5*30 then
'根据文件大小设定
msgbox "30秒超时！"
wscript.quit
end if
loop
if fso.fileexists(filepath&filename) then fso.deletefile(filepath&filename)
fso.deletefile(filepath&"tmpfile")
ado.savetofile(filepath&filename)
msgbox "文件下载完毕！"

function getfilename(url)
arrtmp=split(url,"/")
getfilename=arrtmp(ubound(arrtmp))
end function

function getfilepath(fullname)
arrtmp=split(fullname,"\")
for i=0 to ubound(arrtmp)-1
getfilepath=getfilepath&arrtmp(i)&"\"
next
end function

测试下载地址：

//www.jb51.net/images/logo.gif

vbs实现 多线程 补充

今天有人发邮件问我一个问题：

想请教一下vbs中inputbox函数能否超时关闭?
如果可以的话,应该如何超时关闭输入框? 万分感谢

乍一看这是不可能实现的，因为inputbox函数本身没有超时关闭的参数，而且程序会一直等待inputbox返回才继续运行，后面的语句不可能在inputbox返回之前执行。

如果vbs能实现高级语言的多线程的话……只可惜vbs不可能实现多线程，但是可以用settimeout方法模拟“多线程”。

dim ie
set ie = createobject("internetexplorer.application")
ie.navigate "about:blank"
set window = ie.document.parentwindow
id = window.settimeout(getref("on_timeout"),3000,"vbscript")
name = inputbox("please enter your name","inputbox timeout")
window.cleartimeout id
if name <> "" then msgbox "hello," & name
ie.quit

'by demon
'http://demon.tw

sub on_timeout()
dim wshshell
set wshshell = createobject("wscript.shell")
wshshell.sendkeys "{esc}"
end sub

用settimeout方法设定3秒超时，3秒后用sendkeys方法发送esc键结束inputbox。当然，用sendkeys是很不靠谱的，我一般很少用sendkeys方法，因为它做了太多的假设，万一inputbox不是激活窗口呢？这里只是为了程序简单而用了sendkeys，可以换成结束脚本本身。

同理，想在vbs中实现vb中的timer事件的话可以用setinterval方法，我就不写例子了，自己看文档。

参考链接：settimeout method (window, window constructor)