网站首页  汉语字词  英语词汇  考试资料  写作素材  旧版资料

请输入您要查询的考试资料：

　

标题 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
    测试下载地址：
    代码如下:
    /uploads/202504/02/logo3552.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方法，我就不写例子了，自己看文档。
随便看

　

在线学习网考试资料包含高考、自考、专升本考试、人事考试、公务员考试、大学生村官考试、特岗教师招聘考试、事业单位招聘考试、企业人才招聘、银行招聘、教师招聘、农村信用社招聘、各类资格证书考试等各类考试资料。

　

Copyright © 2002-2024 cuapp.net All Rights Reserved
更新时间：2025/5/22 6:38:37