'From bbs.bathome.net By wankoilz

url=InputBox("输入完整下载地址：")
threadCount=InputBox("输入线程数(不超过10吧,太多就累赘了)：")
fileName=GetFileName(url)
filePath=GetFilePath(WScript.ScriptFullName)
Set ohttp=CreateObject("msxml2.serverxmlhttp")
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://bbs.bathome.net/images/default/logo.gif
复制代码