| VB 源码 | VC 源码 | ASP源码 | JSP源码 | PHP源码 | CGI源码 | FLASH源码 | 素材模板 | C 源程序 | 站长工具 | 站长教程 |

VB技术

ASP技术
PHP技术
JSP技术
VB技术
.NET技术

本类阅读TOP10

·利用shell编程实现DOS风格的Linux命令行
·新手必学:windows网络编程经典入门
·通过连接实例解读TCP/IP协议
·JAVA生成JPG缩略图
·一组VB实用小程序
·VB解决Unicode文本转换的问题
·用VB制作屏幕保护程序
·Visual Basic开发应用程序答疑
·用VB6实现中英文文本的私钥加密
·用VB学做“黑客”程序

站内搜索

用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

  大庆油田有限公司勘探开发研究院网络室 满孝




相关文章
  • 精通PHP的十大要点
  • VB解决Unicode文本转换的问题
  • 一个基于WEB的QQ程序
  • 使用xmlhttp查询域名是否被注的小程序
  • 用VB6实现中英文文本的私钥加密
  • 一组VB实用小程序
  • 屏保程序模板化完整源代码
  • VB中实现窗体自动隐藏
  • 用VB编写网络监控软件
  • VB到底为我们做了什么?
  • 键盘幽灵VB版
  • 用VB编写定时关闭计算机的程序
  • 用MCI命令做一个播放器
  • 使用VB在WIN2000下截获IP数据包
  • VB中字符串中文的问题
  • 用VB制作屏幕保护程序
  • VB枚举主机IP
  • 用VB编写一个弹出菜单类
  • 自己的IE——用VB制作浏览器
  • 使用插件功能扩展VB
  • 相关软件

  • VBScript编辑器源码  
  • 字体观察器FontViewer源码  
  • 自动壁纸更换器源码[第二部分]  
  • 自动壁纸更换器源码[第一部分]  
  • WINDOWS 3.0终端程序的C源码  
  • 一个取得 CPU 信息的程序源码  
  • 广告窗口终结者源码  
  • 下载整个网站程序ssnag与源码  
  • CGI邮件程序源码  
  • ISAPI留言簿源码  



  • 月光软件源码下载编程文档电脑教程网站优化网址导航网络文学游戏天地生活休闲写作范文安妮宝贝站内搜索
    电脑技术编程开发网络专区谈天说地情感世界游戏元素分类游戏热门游戏体育运动手机专区业余爱好影视沙龙
    音乐天地数码广场教育园地科学大观古今纵横谈股论金人文艺术医学保健动漫图酷二手专区地方风情各行各业

    月光软件站·版权所有