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