用VB編寫非同步多執行緒下載程式 (轉)

用VB編寫非同步多執行緒下載程式 (轉)[@more@]

用VB編寫非同步多執行緒

大慶油田有限公司勘探開發研究院室 滿孝

---

為了高地下載某站點的網頁,我們可利用VB的Inte Traner 編寫自己的下載程式, Internet Transfer 控制元件支援超文字傳輸 (HTTP) 和傳輸協議 ()，使用 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 Sub1_StateChanged(ByVal State As Integer) 'State = 12 時，使用 GetChunk 方法檢索伺服器的響應。 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 '初始化用於儲存檔案的FileSystem。 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 L 　 '獲取文件中的連結並置於陣列中。 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