科技行者

行者学院 转型私董会 科技行者专题报道 网红大战科技行者

知识库

知识库 安全导航

至顶网软件频道基础软件用VB编写异步多线程下载程序

用VB编写异步多线程下载程序

  • 扫一扫
    分享文章到微信

  • 扫一扫
    关注官方公众号
    至顶头条

Internet Transfer 控件支持超文本传输协议 (HTTP) 和文件传输协议 (FTP)

作者:xiaozaoqiu 来源:天极BLOG 2007年10月14日

关键字: 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

查看本文来源

    • 评论
    • 分享微博
    • 分享邮件
    邮件订阅

    如果您非常迫切的想了解IT领域最新产品与技术信息,那么订阅至顶网技术邮件将是您的最佳途径之一。

    重磅专题
    往期文章
    最新文章