為了高效率地下載某站點的網頁,我們可利用vb的internet transfer 控件編寫自己的下載程序, internet transfer 控件支持超文本傳輸協議 (http) 和文件傳輸協議 (ftp),使用 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 sub inet1_statechanged(byval state as integer)
注釋:state = 12 時,使用 getchunk 方法檢索服務器的響應。
select 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
注釋:初始化用于保存文件的filesystemobject對象。
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
loop
注釋:獲取文檔中的鏈接并置于數組中。
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