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
延伸閱讀
文章來源于領測軟件測試網 http://www.kjueaiud.com/
