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

2019-11-18 17:27:31

字體：大中小

供稿：網(wǎng)友

為了高效率地下載某站點(diǎn)的網(wǎng)頁,我們可利用VB的InternetTransfer控件編寫自己的下載程序,InternetTransfer控件支持超文本傳輸協(xié)議(HTTP)和文件傳輸協(xié)議(FTP)，使用InternetTransfer控件可以通過OpenURL或Execute方法連接到任何使用這兩個(gè)協(xié)議的站點(diǎn)并檢索文件。本程序使用多個(gè)InternetTransfer控件，使其同時(shí)下載某站點(diǎn)。并可判斷文件是否已下載過或下載過的文件是否比服務(wù)器上當(dāng)前的文件陳舊，以決定是否重新下載。所有下載的文件中的鏈接都做了調(diào)整，以便于本地查閱。
OpenURL方法以同步方式傳輸數(shù)據(jù)。同步指的是傳輸操作未完成之前，不能執(zhí)行其它過程。這樣數(shù)據(jù)傳輸就必須在執(zhí)行其它代碼之前完成。
而Execute方法以異步方式傳輸數(shù)據(jù)。在調(diào)用Execute方法時(shí)，傳輸操作與其它過程無關(guān)。這樣，在調(diào)用Execute方法后，在后臺(tái)接收數(shù)據(jù)的同時(shí)可執(zhí)行其它代碼。
用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ù)。

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

事件監(jiān)控子程序（每個(gè)InternetTransfer控件設(shè)置相對(duì)應(yīng)的事件監(jiān)控子程序）：
用StateChanged事件監(jiān)視該控件的連接狀態(tài),當(dāng)該請(qǐng)求已經(jīng)完成，并且所有數(shù)據(jù)均已接收到時(shí)，調(diào)用GetChunk方法從控件的緩沖區(qū)獲取數(shù)據(jù)。
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)
'如果有引號(hào)，去掉引號(hào)
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'調(diào)用線程調(diào)度子程序
EndSelect

EndSub

PrivateSubInet2_StateChanged(ByValStateAsInteger)
...
endsub

...

線程調(diào)度子程序,g和是k公用變量，k為最后一個(gè)鏈接的數(shù)組索引加一，g初值為零，每次加一，直到處理完最后一個(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("下載結(jié)束。")
EndIf
EndSub->

上一篇：VB中遠(yuǎn)程共享顯示及聲音的實(shí)現(xiàn)

下一篇：用VB編寫標(biāo)準(zhǔn)CGI程序（上）