白云岛资源网 Design By www.pvray.com
话说还是闲来练手,初步实现了自己认为的“多线程”下载。(至于是不是多线程,可以参考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


测试下载地址:
复制代码 代码如下:
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)
白云岛资源网 Design By www.pvray.com
广告合作:本站广告合作请联系QQ:858582 申请时备注:广告合作(否则不回)
免责声明:本站资源来自互联网收集,仅供用于学习和交流,请遵循相关法律法规,本站一切资源不代表本站立场,如有侵权、后门、不妥请联系本站删除!
白云岛资源网 Design By www.pvray.com

《魔兽世界》大逃杀!60人新游玩模式《强袭风暴》3月21日上线

暴雪近日发布了《魔兽世界》10.2.6 更新内容,新游玩模式《强袭风暴》即将于3月21 日在亚服上线,届时玩家将前往阿拉希高地展开一场 60 人大逃杀对战。

艾泽拉斯的冒险者已经征服了艾泽拉斯的大地及遥远的彼岸。他们在对抗世界上最致命的敌人时展现出过人的手腕,并且成功阻止终结宇宙等级的威胁。当他们在为即将于《魔兽世界》资料片《地心之战》中来袭的萨拉塔斯势力做战斗准备时,他们还需要在熟悉的阿拉希高地面对一个全新的敌人──那就是彼此。在《巨龙崛起》10.2.6 更新的《强袭风暴》中,玩家将会进入一个全新的海盗主题大逃杀式限时活动,其中包含极高的风险和史诗级的奖励。

《强袭风暴》不是普通的战场,作为一个独立于主游戏之外的活动,玩家可以用大逃杀的风格来体验《魔兽世界》,不分职业、不分装备(除了你在赛局中捡到的),光是技巧和战略的强弱之分就能决定出谁才是能坚持到最后的赢家。本次活动将会开放单人和双人模式,玩家在加入海盗主题的预赛大厅区域前,可以从强袭风暴角色画面新增好友。游玩游戏将可以累计名望轨迹,《巨龙崛起》和《魔兽世界:巫妖王之怒 经典版》的玩家都可以获得奖励。