<p>用VB編寫異步多線程下載程序</p>
<p></p>
<p>為了高效率地下載某站點(diǎn)的網(wǎng)頁(yè),我們可利用VB的Internet Transfer 控件編寫自己的下載程序, Internet Transfer 控件支持超文本傳輸協(xié)議 (HTTP) 和文件傳輸協(xié)議 (FTP)，使用 Internet Transfer 控件可以通過(guò) OpenURL 或 Execute 方法連接到任何使用這兩個(gè)協(xié)議的站點(diǎn)并檢索文件。本程序使用多個(gè)Internet Transfer 控件，使其同時(shí)下載某站點(diǎn)。并可判斷文件是否已下載過(guò)或下載過(guò)的文件是否比服務(wù)器上當(dāng)前的文件陳舊，以決定是否重新下載。所有下載的文件中的鏈接都做了調(diào)整，以便于本地查閱。 </p>
<p>OpenURL 方法以同步方式傳輸數(shù)據(jù)。同步指的是傳輸操作未完成之前，不能執(zhí)行其它過(guò)程。這樣數(shù)據(jù)傳輸就必須在執(zhí)行其它代碼之前完成。 </p>
<p>而 Execute 方法以異步方式傳輸數(shù)據(jù)。在調(diào)用 Execute 方法時(shí)，傳輸操作與其它過(guò)程無(wú)關(guān)。這樣，在調(diào)用 Execute 方法后，在后臺(tái)接收數(shù)據(jù)的同時(shí)可執(zhí)行其它代碼。 </p>
<p>用 OpenURL 方法能夠直接得到可保存到磁盤的數(shù)據(jù)流，或者直接在 TextBox 控件中閱覽（如果數(shù)據(jù)是文本格式的）。而用 Execute 方法獲取數(shù)據(jù)，則必須用 StateChanged 事件監(jiān)視該控件的連接狀態(tài)。當(dāng)達(dá)到適當(dāng)?shù)臓顟B(tài)時(shí)，調(diào)用 GetChunk 方法從控件的緩沖區(qū)獲取數(shù)據(jù)。 </p>
<p>　  </p>
<p>首先，建立啟始的http檢索連接, </p>
<p>Public g As Variant </p>
<p>Public k As Variant </p>
<p>Public spath As String </p>
<p>Dim links() As String </p>
<p>g = 0 </p>
<p>spath = 本地保存下載文件的路徑 </p>
<p>links(0)=啟始URL </p>
<p>inet1.execute links(0), "GET" 注釋：使用GET方法。 </p>
<p>　  </p>
<p>事件監(jiān)控子程序（每個(gè)Internet Transfer 控件設(shè)置相對(duì)應(yīng)的事件監(jiān)控子程序）： </p>
<p>用StateChanged 事件監(jiān)視該控件的連接狀態(tài), 當(dāng)該請(qǐng)求已經(jīng)完成，并且所有數(shù)據(jù)均已接收到時(shí)，調(diào)用 GetChunk 方法從控件的緩沖區(qū)獲取數(shù)據(jù)。 </p>
<p>Private Sub Inet1_StateChanged(ByVal State As Integer) </p>
<p>注釋：State = 12 時(shí)，使用 GetChunk 方法檢索服務(wù)器的響應(yīng)。 </p>
<p>Select Case State </p>
<p>注釋：...沒(méi)有列舉其它情況。 </p>
<p>　  </p>
<p>Case icResponseCompleted 注釋：12 </p>
<p>注釋：獲取links(g)中的協(xié)議、主機(jī)和路徑名。 </p>
<p>addsuf = Left(links(g), InStrRev(links(g), "/")) </p>
<p>注釋：獲取links(g)中的文件名。 </p>
<p>fname = Right(links(g), Len(links(g)) - InStrRev(links(g), "/")) </p>
<p>注釋：判斷是否是超文本文件，是超文本文件則分析其中的鏈接，若不是則存為二進(jìn)制文件。 </p>
<p>If InStr(1, fname, "htm", vbTextCompare) = True Then </p>
<p>注釋：初始化用于保存文件的FileSystemObject對(duì)象。 </p>
<p>Set fs = CreateObject("Scripting.FileSystemObject") </p>
<p>Dim vtData As Variant 注釋：數(shù)據(jù)變量。 </p>
<p>Dim strData As String: strData = "" </p>
<p>Dim bDone As Boolean: bDone = False </p>
<p>　  </p>
<p>注釋：取得第一塊。 </p>
<p>vtData = inet1.GetChunk(1024, icString) </p>
<p>DoEvents </p>
<p>Do While Not bDone </p>
<p>strData = strData & vtData </p>
<p>DoEvents </p>
<p>注釋：取得下一塊。 </p>
<p>vtData = inet1.GetChunk(1024, icString) </p>
<p>If Len(vtData) = 0 Then </p>
<p>bDone = True </p>
<p>End If </p>
<p>Loop </p>
<p>　  </p>
<p>注釋：獲取文檔中的鏈接并置于數(shù)組中。 </p>
<p>Dim i As Variant </p>
<p>Dim po1 As Variant </p>
<p>Dim po2 As Variant </p>
<p>Dim oril As String </p>
<p>Dim newl As String </p>
<p>Dim lmtime, ctime </p>
<p>po1 = InStr(1, strData, "href=", vbTextCompare) + 5 </p>
<p>po2 = 1 </p>
<p>Dim newstr As String: newstr = "" </p>
<p>Dim whostr As String: whostr = "" </p>
<p>i = 0 </p>
<p>Do While po1 > 0 </p>
<p>newstr = Mid(strData, po2, po1) </p>
<p>whostr = whostr + newstr </p>
<p>po2 = InStr(po1, strData, ">", vbTextCompare) </p>
<p>注釋：將原鏈接改為新鏈接 </p>
<p>oril = Mid(strData, po1 + 1, po2 - po1 - 1) </p>
<p>注釋：如果有引號(hào)，去掉引號(hào) </p>
<p>ln = Replace(oril, """", "", vbTextCompare) </p>
<p>newl = Right(ln, Len(ln) - InStrRev(ln, "/")) </p>
<p>whostr = whostr & newl </p>
<p>If ln <> "" Then </p>
<p>注釋：判定文件是否下載過(guò)。 </p>
<p>If fileexists(spath & newl) = False Then </p>
<p>links(i) = addsuf & ln </p>
<p>i = i + 1 </p>
<p>Else </p>
<p>lmtime = inet1.getheader("Last-modified") </p>
<p>Set f = fs.getfile(spath & newl) </p>
<p>ctime = f.datecreated </p>
<p>注釋：判斷文件是否更新 </p>
<p>If DateDiff("s", lmtime, ctime) < 0 Then </p>
<p>i = i + 1 </p>
<p>End If </p>
<p>End If </p>
<p>End If </p>
<p>po1 = InStr(po2 + 1, strData, "href=", vbTextCompare) + 5 </p>
<p>Loop </p>
<p>newstr = Mid(strData, po2) </p>
<p>whostr = whostr + newstr </p>
<p>　  </p>
<p>Set a = fs.createtextfile(spath & fname, True) </p>
<p>a.Write whostr </p>
<p>a.Close </p>
<p>k = i </p>
<p>Else </p>
<p>Dim vtData As Variant </p>
<p>Dim b() As Byte </p>
<p>Dim bDone As Boolean: bDone = False </p>
<p>vtData = Inet2.GetChunk(1024, icByteArray) </p>
<p>Do While Not bDone </p>
<p>b() = b() & vtData </p>
<p>vtData = Inet2.GetChunk(1024, icByteArray) </p>
<p>If Len(vtData) = 0 Then </p>
<p>bDone = True </p>
<p>End If </p>
<p>Loop </p>
<p>Open spath & fname For Binary Access Write As #1 </p>
<p>Put #1, , b() </p>
<p>Close #1 </p>
<p>End If </p>
<p>Call devjob 注釋：調(diào)用線程調(diào)度子程序 </p>
<p>End Select </p>
<p>　  </p>
<p>End Sub </p>
<p>　  </p>
<p>Private Sub Inet2_StateChanged(ByVal State As Integer) </p>
<p>... </p>
<p>end sub </p>
<p>　  </p>
<p>... </p>
<p>　  </p>
<p>線程調(diào)度子程序,g和是k公用變量，k為最后一個(gè)鏈接的數(shù)組索引加一，g初值為零，每次加一，直到處理完最后一個(gè)鏈接。 </p>
<p>Private Sub devjob() </p>
<p>　  </p>
<p>If Not g + 1 < k Then GoTo reportline </p>
<p>If Inet1.StillExecuting = False Then </p>
<p>g = g + 1 </p>
<p>Inet1.Execute links(g), "GET" </p>
<p>End If </p>
<p>If Not g + 1 < k Then GoTo reportline </p>
<p>If Inet2.StillExecuting = False Then </p>
<p>g = g + 1 </p>
<p>Inet2.Execute links(g), "GET" </p>
<p>End If </p>
<p>　  </p>
<p>... </p>
<p>　  </p>
<p>reportline: </p>
<p>If Inet1.StillExecuting = False And Inet2.StillExecuting = False And ... Then </p>
<p>MsgBox ("下載結(jié)束。") </p>
<p>End If </p>
<p>End Sub </p>
<p> </p>