為了高效率地下載某站點的網頁,我們可利用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方法從控件的緩沖區獲取數據。
PrivateSubInet1_StateChanged(ByValStateAsInteger)
'State=12時，使用GetChunk方法檢索服務器的響應。
SelectCaseState
'...沒有列舉其它情況。
CaseicResponseCompleted'12
'獲取links(g)中的協議、主機和路徑名。
addsuf=Left(links(g),InStrRev(links(g),"/"))
'獲取links(g)中的文件名。
fname=Right(links(g),Len(links(g))-InStrRev(links(g),"/"))
'判斷是否是超文本文件，是超文本文件則分析其中的鏈接，若不是則存為二進制文件。
IfInStr(1,fname,"htm",vbTextCompare)=TrueThen
'初始化用於保存文件的FileSystemObject對象。
Setfs=CreateObject("Scripting.FileSystemObject")
DimvtDataAsVariant'數據變量。
DimstrDataAsString:strData=""
DimbDoneAsBoolean:bDone=False
'取得第一塊。
vtData=inet1.GetChunk(1024,icString)
DoEvents
DoWhileNotbDone
strData=strData&vtData
DoEvents
'取得下一塊。
vtData=inet1.GetChunk(1024,icString)
IfLen(vtData)=0Then
bDone=True
EndIf
Loop
'獲取文檔中的鏈接並置於數組中。
DimiAsVariant
Dimpo1AsVariant
Dimpo2AsVariant
DimorilAsString
DimnewlAsString
Dimlmtime,ctime
po1=InStr(1,strData,"href=",vbTextCompare) 5
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&fnameForBinaryAccessWriteAs#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->
