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

测试下载地址：
复制代码代码如下:
http://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）