話說還是閑來練手，初步實現了自己認為的“多線程”下載。(至于是不是多線程，可以參考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(filePathfileName) Then fso.DeleteFile(filePathfileName)
fso.DeleteFile(filePath"TmpFile")
ado.SaveToFile(filePathfileName)
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=GetFilePatharrTmp(i)"\"
Next
End Function
測試下載地址：
復制代碼 代碼如下:
https://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
apos;By Demon
apos;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)
您可能感興趣的文章:- VBS讀取注冊表的兩種方法
- VB實現的倒計時類代碼詳解
- VB調用Word拼寫檢查功能實例
- VB6中的LSet語句和RSet語句詳解
- VB實現的16位和32位md5加密代碼分享
- 通過VB6將ASP編譯封裝成DLL組件最簡教程 附全部工程源文件
- VB6反編譯軟件VB RezQV2.4a 正式版注冊碼
- VB讀取線程、句柄及寫入內存的API代碼實例
