话说还是闲来练手，初步实现了自己认为的“多线程”下载。(至于是不是多线程，可以参考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方法，我就不写例子了，自己看文档。