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

原创 2001年06月28日 17:25:00

作者:大庆油田有限公司勘探开发研究院网络室 满孝
为了高效率地下载某站点的网页,我们可利用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

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

用VB编写异步多线程下载程序  为了高效率地下载某站点的网页,我们可利用VB的Internet Transfer 控件编写自己的下载程序, Internet Transfer 控件支持超文本传输协议(...
  • skydg
  • skydg
  • 2001年08月23日 19:29
  • 647

你在用VB做计算器吗?错误怎么处理

我在高中时用VB语言完成过一个计算器程序,它叫Runner. 如果简单计算器只有在特殊情况下会出现错误: 显示错误. 除0; 运算的数字过大,过小. 显示错误由于VB的文本框全权由自己管理,你要...
  • dalerkd
  • dalerkd
  • 2015年04月22日 10:55
  • 903

关于用VB做记事本的程序

 内容:讨论如何在用VB编写的记事中实现自动将日志添加到文档尾部、判断保存还是另存为、确认文件是否需要保存等功能。Windows自带的记事本即Notepad有一些功能还是颇具吸引力的,比如自动在特定的...
  • nanzhiwen666
  • nanzhiwen666
  • 2007年11月21日 23:47
  • 2355

我的记事本(vb编写的)

源代码:http://download1.csdn.net/down3/20070606/06124205473.rar成品: http://download1.csdn.net/down3/2007...
  • foamflower
  • foamflower
  • 2007年06月06日 12:47
  • 965

用VB制作屏幕保护程序

用VB制作屏幕保护程序利用Visual Basic 制作屏幕保护程序非常容易。本文将详细给大家介绍制作屏幕保护程序的方法。 ---- 一. 基本编程思路 ---- 大家都知道屏幕保护程序就是利用变换的...
  • firetoucher
  • firetoucher
  • 2001年09月10日 18:53
  • 1345

用VB编写抽奖程序

  • zgqtxwd
  • zgqtxwd
  • 2008年05月01日 05:17
  • 261

5、HttpClient、多线程下载、HttpUtils

HttpClient发送get请求 创建一个客户端对象HttpClient client = new DefaultHttpClient(); 创建一个get请求对象HttpGet hg = new ...
  • guanhang89
  • guanhang89
  • 2016年05月08日 17:56
  • 1196

VB:绘图示例—屏保软件设计1

a
  • nxhujiee
  • nxhujiee
  • 2010年10月21日 00:09
  • 926

利用bat,vb实现根据日期自动备份文件

假如D:/backup/a为备份源文件夹,备份路径为D:/backup/,文件夹名为当天的日期,如D:/backup/2006-04-17/a,每周5备份一次,3周一个循环,即备份第4周时,第1周的备...
  • oyoung
  • oyoung
  • 2006年04月17日 17:20
  • 5649

VB编写病毒

Private n盘 Private n路径1$ Private n路径2$ Private Sub Command1_Click() End End Sub Private Sub Form_Loa...
  • kzh4435
  • kzh4435
  • 2007年09月30日 13:35
  • 537
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:用VB编写异步多线程下载程序
举报原因:
原因补充:

(最多只允许输入30个字)