首页 > 编程 > VBScript > 正文

vbs 多线程下载实现代码

2020-06-26 18:33:28
字体:
来源:转载
供稿:网友
昨天重新看了下《深入挖掘Windows脚本技术》(原文不知道是谁写的,网上到处都是)。里面提到了vbs多线程下载,今天尝试写了一下
 
话说还是闲来练手,初步实现了自己认为的“多线程”下载。(至于是不是多线程,可以参考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.vevb.com/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方法,我就不写例子了,自己看文档。

参考链接:setTimeout Method (window, Window Constructor)

发表评论 共有条评论
用户名: 密码:
验证码: 匿名发表