我前两天也刚好碰到这个。
据danis appleman说,VB不能创建多线程,我创建的结果也一样--失败。但你可以在ActiveX EXE中另开一进程,在该进程中执行所需代码。

解决方案 »

  1.   

    vb可以调用api函数实现多线程,但搞不好就容易"死掉",用delphi 或vc做组件来调用好些
      

  2.   

    注册这些控件的任意一个,看看源码就知道了:http://www.csdn.net/cnshare/soft/8/8268.htmlhttp://www.csdn.net/cnshare/soft/8/8269.htmlhttp://www.csdn.net/cnshare/soft/5/5704.html   
      

  3.   

    天下没有肯定的事,请下载http://www.vbaccelerator.com/codelib/thread/inprogbr.htm
    是一个Netscape风格的多线程进度条,好好啃啃吧
      

  4.   

    我有例子程序,告诉我你的邮件地址,给你发过去。我的"伊妹儿"是:[email protected]
      

  5.   

    to xbx:拜托也给我一份:[email protected],谢谢。
      

  6.   

    我也 有一个,非常简单,才20多行,你们要的话给我写信:[email protected]
      

  7.   

    to xbx:没有呀,附件中没有任何信息
      

  8.   

    用VB编写异步多线程下载程序
    为了高效率地下载某站点的网页,我们可利用VB的Internet Transfer 控件编写自己的下载程序, Internet Transfer 控件支持超文本传输协议 (HTTP) 和文件传输协议 (FTP),使用 Internet Transfer 控件可以通过 OpenURL 或 Execute 方法连接到任何使用这两个协议的站点并检索文件。本程序使用多个Internet Transfer 控件,使其同时下载某站点。并可判断文件是否已下载过或下载过的文件是否比服务器上当前的文件陈旧,以决定是否重新下载。所有下载的文件中的链接都做了调整,以便于本地查阅。 
    OpenURL 方法以同步方式传输数据。同步指的是传输操作未完成之前,不能执行其它过程。这样数据传输就必须在执行其它代码之前完成。 
    而 Execute 方法以异步方式传输数据。在调用 Execute 方法时,传输操作与其它过程无关。这样,在调用 Execute 方法后,在后台接收数据的同时可执行其它代码。 
    用 OpenURL 方法能够直接得到可保存到磁盘的数据流,或者直接在 TextBox 控件中阅览(如果数据是文本格式的)。而用 Execute 方法获取数据,则必须用 StateChanged 事件监视该控件的连接状态。当达到适当的状态时,调用 GetChunk 方法从控件的缓冲区获取数据。 
       
    首先,建立启始的http检索连接, 
    Public g As Variant 
    Public k As Variant 
    Public spath As String 
    Dim links() As String 
    g = 0 
    spath = 本地保存下载文件的路径 
    links(0)=启始URL 
    inet1.execute links(0), "GET" '使用GET方法。 
       
    事件监控子程序(每个Internet Transfer 控件设置相对应的事件监控子程序): 
    用StateChanged 事件监视该控件的连接状态, 当该请求已经完成,并且所有数据均已接收到时,调用 GetChunk 方法从控件的缓冲区获取数据。 
    Private Sub Inet1_StateChanged(ByVal State As Integer) 
    'State = 12 时,使用 GetChunk 方法检索服务器的响应。 
    Select Case State 
    '...没有列举其它情况。 
       
    Case icResponseCompleted '12 
    '获取links(g)中的协议、主机和路径名。 
    addsuf = Left(links(g), InStrRev(links(g), "/")) 
    '获取links(g)中的文件名。 
    fname = Right(links(g), Len(links(g)) - InStrRev(links(g), "/")) 
    '判断是否是超文本文件,是超文本文件则分析其中的链接,若不是则存为二进制文件。 
    If InStr(1, fname, "htm", vbTextCompare) = True Then 
    '初始化用于保存文件的FileSystemObject对象。 
    Set fs = CreateObject("Scripting.FileSystemObject") 
    Dim vtData As Variant '数据变量。 
    Dim strData As String: strData = "" 
    Dim bDone As Boolean: bDone = False 
       
    '取得第一块。 
    vtData = inet1.GetChunk(1024, icString) 
    DoEvents 
    Do While Not bDone 
    strData = strData & vtData 
    DoEvents 
    '取得下一块。 
    vtData = inet1.GetChunk(1024, icString) 
    If Len(vtData) = 0 Then 
    bDone = True 
    End If 
    Loop 
       
    '获取文档中的链接并置于数组中。 
    Dim i As Variant 
    Dim po1 As Variant 
    Dim po2 As Variant 
    Dim oril As String 
    Dim newl As String 
    Dim lmtime, ctime 
    po1 = InStr(1, strData, "href=", vbTextCompare) + 5 
    po2 = 1 
    Dim newstr As String: newstr = "" 
    Dim whostr As String: whostr = "" 
    i = 0 
    Do While po1 > 0 
    newstr = Mid(strData, po2, po1) 
    whostr = whostr + newstr 
    po2 = InStr(po1, strData, ">", vbTextCompare) 
    '将原链接改为新链接 
    oril = Mid(strData, po1 + 1, po2 - po1 - 1) 
    '如果有引号,去掉引号 
    ln = Replace(oril, """", "", vbTextCompare) 
    newl = Right(ln, Len(ln) - InStrRev(ln, "/")) 
    whostr = whostr & newl 
    If ln <> "" Then 
    '判定文件是否下载过。 
    If fileexists(spath & newl) = False Then 
    links(i) = addsuf & ln 
    i = i + 1 
    Else 
    lmtime = inet1.getheader("Last-modified") 
    Set f = fs.getfile(spath & newl) 
    ctime = f.datecreated 
    '判断文件是否更新 
    If DateDiff("s", lmtime, ctime) < 0 Then 
    i = i + 1 
    End If 
    End If 
    End If 
    po1 = InStr(po2 + 1, strData, "href=", vbTextCompare) + 5 
    Loop 
    newstr = Mid(strData, po2) 
    whostr = whostr + newstr 
       
    Set a = fs.createtextfile(spath & fname, True) 
    a.Write whostr 
    a.Close 
    k = i 
    Else 
    Dim vtData As Variant 
    Dim b() As Byte 
    Dim bDone As Boolean: bDone = False 
    vtData = Inet2.GetChunk(1024, icByteArray) 
    Do While Not bDone 
    b() = b() & vtData 
    vtData = Inet2.GetChunk(1024, icByteArray) 
    If Len(vtData) = 0 Then 
    bDone = True 
    End If 
    Loop 
    Open spath & fname For Binary Access Write As #1 
    Put #1, , b() 
    Close #1 
    End If 
    Call devjob '调用线程调度子程序 
    End Select 
       
    End Sub 
       
    Private Sub Inet2_StateChanged(ByVal State As Integer) 
    ... 
    end sub 
       
    ... 
       
    线程调度子程序,g和是k公用变量,k为最后一个链接的数组索引加一,g初值为零,每次加一,直到处理完最后一个链接。 
    Private Sub devjob() 
       
    If Not g + 1 < k Then GoTo reportline 
    If Inet1.StillExecuting = False Then 
    g = g + 1 
    Inet1.Execute links(g), "GET" 
    End If 
    If Not g + 1 < k Then GoTo reportline 
    If Inet2.StillExecuting = False Then 
    g = g + 1 
    Inet2.Execute links(g), "GET" 
    End If 
       
    ... 
       
    reportline: 
    If Inet1.StillExecuting = False And Inet2.StillExecuting = False And ... Then 
    MsgBox ("下载结束。") 
    End If 
    End Sub