用VB编写异步多线程下载程序
- 发布于:2023-12-04
- 共 129 人围观
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)