vbs 多线程下载实现代码_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

测试下载地址:

复制代码 代码如下:

yun_qi_img/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)

时间: 2024-09-16 05:19:45

vbs 多线程下载实现代码_vbs的相关文章

Android的HTTP多线程下载示例代码

本示例介绍在Android平台下通过HTTP协议实现断点续传下载. 多线程断点需要的功能 1.多线程下载, 2.支持断点. 使用多线程的好处:使用多线程下载会提升文件下载的速度. 多线程下载文件的过程是: (1)首先获得下载文件的长度,然后设置本地文件的长度. HttpURLConnection.getContentLength();//获取下载文件的长度 RandomAccessFile file = new RandomAccessFile("QQWubiSetup.exe",&q

发老兵及海洋VBS解包工具代码_vbs

关于为什么提供打包程序和打包压缩文件.MDB的解压 2006.asp 海阳顶端网asp木马2006版文件   unpack.vbs 打包文件"hytop.mdb"的解开器   2006x.exe 海阳顶端网asp木马2006 c/s模式转换器   2006x2.exe 海阳顶端网asp木马2006 专用短服务器端   c/s模式转换器   2006z.exe 海阳顶端网asp木马2006_lite版本组合器   用来自定义生成相应功能的lite版木马   hididi.ini 2006

vbs获取当前路径的代码_vbs

CMD当前路径 复制代码 代码如下: test = createobject("Scripting.FileSystemObject").GetFolder(".").PathWscript.echo test 当前VBS路径 复制代码 代码如下: test = createobject("Scripting.FileSystemObject").GetFile(Wscript.ScriptFullName).ParentFolder.PathW

VBS中常用脚本代码_vbs

将域用户或租添加到本地组 Set objGroup = GetObject("WinNT://./Administrators") Set objUser = GetObject("WinNT://testnet/Engineers") objGroup.Add(objUser.ADsPath) 修改本地管理员密码 Set objcnlar = GetObject("WinNT://./administrator, user") objcnla.

VBS文本文件操作实现代码_vbs

对于文件的操作,例如:生成一个或者打开一个或者删除一个.txt格式文件.虽然官方的FILE插件提供了一些基本功能,但功能不多.你并不需要理解什么是fso模版,什么是vbs语句,直接套用下面的语句吧!红色字为自己定义的部分,蓝色字为任意选一部分 如果你看不懂,请参考下面的例子!操作同一个文件红色部分必须相同 请认真看括号内的解释内容定义一个名为fso的关系文件问题的对象,对于一个文件的操作只需写一次,此句必须写VBS Set fso = CreateObject("Scripting.FileSy

VBS读网页的代码_vbs

直接将下面的代码保存为test.vbs双击运行就可,如果不能使用,请看自己的电脑是否vbs被禁用. 复制代码 代码如下: strURL = InputBox("请输入要读的网址", "朗读网页", "http://www.jb51.net/index.htm") If strURL = "" Then Wscript.quit End If Set ie = WScript.CreateObject("Interne

VBS 数字转英文代码_vbs

如何创建名为 SpellNumber 的示例函数 启动 Microsoft Excel. 按 Alt+F11 启动 Visual Basic 编辑器. 在"插入"菜单上,单击"模块". 在模块表中键入下面的代码. 复制代码 代码如下: Option Explicit 'Main Function Function SpellNumber(ByVal MyNumber) Dim Dollars, Cents, Temp Dim DecimalPlace, Count

将WMI中的DateTime类型转换成VBS时间的函数代码_vbs

有两种方法可以转换,一种是自己写个函数解析: 复制代码 代码如下: Function WMIDateStringToDate(DateTime) WMIDateStringToDate = _ CDate(Mid(DateTime, 5, 2) &_ "/" &_ Mid(DateTime, 7, 2) &_ "/" &_ Left(DateTime, 4) &_ " " &_ Mid (DateT

vbs base64 解密脚本代码_vbs

复制代码 代码如下: Function fDecode(sStringToDecode) 'This function will decode a Base64 encoded string and returns the decoded string. 'This becomes usefull when attempting to hide passwords from prying eyes. Const CharList = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcd