用VB編寫異步多線程下載程序

2019-11-18 17:27:31

字體：大中小

來源：轉載

供稿：網友

為了高效率地下載某站點的網頁,我們可利用VB的InternetTransfer控件編寫自己的下載程序,InternetTransfer控件支持超文本傳輸協議(HTTP)和文件傳輸協議(FTP)，使用InternetTransfer控件可以通過OpenURL或Execute方法連接到任何使用這兩個協議的站點并檢索文件。本程序使用多個InternetTransfer控件，使其同時下載某站點。并可判斷文件是否已下載過或下載過的文件是否比服務器上當前的文件陳舊，以決定是否重新下載。所有下載的文件中的鏈接都做了調整，以便于本地查閱。
OpenURL方法以同步方式傳輸數據。同步指的是傳輸操作未完成之前，不能執行其它過程。這樣數據傳輸就必須在執行其它代碼之前完成。
而Execute方法以異步方式傳輸數據。在調用Execute方法時，傳輸操作與其它過程無關。這樣，在調用Execute方法后，在后臺接收數據的同時可執行其它代碼。
用OpenURL方法能夠直接得到可保存到磁盤的數據流，或者直接在TextBox控件中閱覽（如果數據是文本格式的）。而用Execute方法獲取數據，則必須用StateChanged事件監視該控件的連接狀態。當達到適當的狀態時，調用GetChunk方法從控件的緩沖區獲取數據。

首先，建立啟始的http檢索連接,
PublicgAsVariant
PublickAsVariant
PublicspathAsString
Dimlinks()AsString
g=0
spath=本地保存下載文件的路徑
links(0)=啟始URL
inet1.executelinks(0),"GET"'使用GET方法。

事件監控子程序（每個InternetTransfer控件設置相對應的事件監控子程序）：
用StateChanged事件監視該控件的連接狀態,當該請求已經完成，并且所有數據均已接收到時，調用GetChunk方法從控件的緩沖區獲取數據。
po2=1
DimnewstrAsString:newstr=""
DimwhostrAsString:whostr=""
i=0
DoWhilepo1>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
Ifln<>""Then
'判定文件是否下載過。
Iffileexists(spath&newl)=FalseThen
links(i)=addsuf&ln
i=i 1
Else
lmtime=inet1.getheader("Last-modified")
Setf=fs.getfile(spath&newl)
ctime=f.datecreated
'判斷文件是否更新
IfDateDiff("s",lmtime,ctime)<0Then
i=i 1
EndIf
EndIf
EndIf
po1=InStr(po2 1,strData,"href=",vbTextCompare) 5
Loop
newstr=Mid(strData,po2)
whostr=whostr newstr

Seta=fs.createtextfile(spath&fname,True)
a.Writewhostr
a.Close
k=i
Else
DimvtDataAsVariant
Dimb()AsByte
DimbDoneAsBoolean:bDone=False
vtData=Inet2.GetChunk(1024,icByteArray)
DoWhileNotbDone
b()=b()&vtData
vtData=Inet2.GetChunk(1024,icByteArray)
IfLen(vtData)=0Then
bDone=True
EndIf
Loop
Openspath&fnameForBinary accessWriteAs#1
Put#1,,b()
Close#1
EndIf
Calldevjob'調用線程調度子程序
EndSelect

EndSub

PrivateSubInet2_StateChanged(ByValStateAsInteger)
...
endsub

...

線程調度子程序,g和是k公用變量，k為最后一個鏈接的數組索引加一，g初值為零，每次加一，直到處理完最后一個鏈接。
PrivateSubdevjob()

IfNotg 1<kThenGoToreportline
IfInet1.StillExecuting=FalseThen
g=g 1
Inet1.Executelinks(g),"GET"
EndIf
IfNotg 1<kThenGoToreportline
IfInet2.StillExecuting=FalseThen
g=g 1
Inet2.Executelinks(g),"GET"
EndIf

...

reportline:
IfInet1.StillExecuting=FalseAndInet2.StillExecuting=FalseAnd...Then
MsgBox("下載結束。")
EndIf
EndSub->

上一篇：VB中遠程共享顯示及聲音的實現

下一篇：用VB編寫標準CGI程序（上）