這期內(nèi)容當(dāng)中小編將會給大家?guī)碛嘘P(guān)vbs 中怎么實現(xiàn)多線程下載功能,文章內(nèi)容豐富且以專業(yè)的角度為大家分析和敘述,閱讀完這篇文章希望大家可以有所收獲。
成都創(chuàng)新互聯(lián)歡迎來電:028-86922220,為您提供成都網(wǎng)站建設(shè)網(wǎng)頁設(shè)計及定制高端網(wǎng)站建設(shè)服務(wù),成都創(chuàng)新互聯(lián)網(wǎng)頁制作領(lǐng)域十年,包括效果圖設(shè)計等多個行業(yè)擁有豐富的網(wǎng)站設(shè)計經(jīng)驗,選擇成都創(chuàng)新互聯(lián),為企業(yè)錦上添花。代碼如下:
'by wankoilz
url=InputBox("輸入完整下載地址:")
threadCount=InputBox("輸入線程數(shù)(不超過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
'創(chuàng)建一個和下載文件同樣大小的臨時文件,供下面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對象的數(shù)組,·成員數(shù)量便是線程數(shù)
'直接 Dim 數(shù)組名(變量名) 是不行的,這里用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
'每當(dāng)一個線程下載完畢就將其寫入臨時文件的相應(yīng)位置
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
'根據(jù)文件大小設(shè)定
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
測試下載地址:
復(fù)制代碼 代碼如下:
/tupian/20230522/13829.gif
VBS實現(xiàn) 多線程 補充
今天有人發(fā)郵件問我一個問題:
想請教一下VBS中INPUTBOX函數(shù)能否超時關(guān)閉?
如果可以的話,應(yīng)該如何超時關(guān)閉輸入框? 萬分感謝
乍一看這是不可能實現(xiàn)的,因為InputBox函數(shù)本身沒有超時關(guān)閉的參數(shù),而且程序會一直等待InputBox返回才繼續(xù)運行,后面的語句不可能在InputBox返回之前執(zhí)行。
如果VBS能實現(xiàn)高級語言的多線程的話……只可惜VBS不可能實現(xiàn)多線程,但是可以用setTimeout方法模擬“多線程”。
復(fù)制代碼 代碼如下:
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
'/tupian/20230522/demon.tw
Sub on_timeout()
Dim WshShell
set WshShell = CreateObject("wscript.Shell")
WshShell.SendKeys "{ESC}"
End Sub
上述就是小編為大家分享的vbs 中怎么實現(xiàn)多線程下載功能了,如果剛好有類似的疑惑,不妨參照上述分析進行理解。如果想知道更多相關(guān)知識,歡迎關(guān)注創(chuàng)新互聯(lián)行業(yè)資訊頻道。