为了高效率地下载某站点的网页,我们可利用VB的Internet Transfer 控件编写自己的下载程序, Internet Transfer 控件支持超文本传输协议 (HTTP) 和文件传输协议 (FTP),使用 Internet Transfer 控件可以通过 OpenURL 或 Execute 方法连接到任何使用这两个协议的站点并检索文件。本程序使用多个Internet Transfer 控件,使其同时下载某站点。并可判断文件是否已下载过或下载过的文件是否比服务器上当前的文件陈旧,以决定是否重新下载。所有下载的文件中的链接都做了调整,以便于本地查阅。
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 ...
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
为了高效率地下载某站点的网页,我们可利用VB的Internet Transfer 控件编写自己的下载程序, Internet Transfer 控件支持超文本传输协议 (HTTP) 和文件传输协议 (FTP),使用 Internet Transfer 控件可以通过 OpenURL 或 Execute 方法连接到任何使用这两个协议的站点并检索文件。本程序使用多个Internet Transfer 控