创建一个程序，检查你的网页中所有链接是否有效。

• 下载源代码 - 11.2 Kb
• 下载演示 - 9.13 Kb

引言

在本文中，我将向你展示如何创建一个程序，检查你的 Web 应用程序中的链接是否有效。 我们将使用 Internet Transfer Control 来完成此任务。 这是一个真实的示例，你将看到 Internet Transfer Control 的真正用途。

关于应用程序

Internet Transfer Control 是一个非常方便的控件。 该程序将检查网页中的每个链接，以查看它是否正常工作。 假设我在我的网页上添加了不同人的网页地址。 现在，网页通常会移动到不同的位置，或者人们只是将他们的网站从 Internet 上撤下，然后我的所有链接突然失效了。 如果我的页面上有 100 多个链接，那么手动检查所有这些页面将是一项繁重的任务，并且我们无法定期检查 URL。 因此，我们需要自动化这个过程。 一种简单的方法是在 Access 或 Excel 中保存一个链接数据库，然后检查数据库中的所有链接是否正常工作。 你可以使用数据库中的实时链接来填充你的网页。

这个程序做什么？

我们将要创建的程序将执行以下任务

1. 该程序将打开一个工作表。
2. 它将使用 OLE 自动化来读取第一个 URL，并查看它是否正常工作。
3. 将数据写回工作表，指示 URL 的结果。
4. 对列表中的所有 URL 重复上述步骤。
5. 保存并关闭工作表。

什么是 OLE？

OLE 代表对象链接和嵌入。 它是一种在应用程序之间传输和共享信息的技术。 不同的应用程序公开与其应用程序处理的数据类型相关的对象。 自动化客户端是公开属于另一个应用程序的对象的应用程序。 在我们的例子中，我们的 VB 程序将充当自动化客户端。 自动化服务器是向其他应用程序公开可编程对象的应用程序。 在我们的例子中，Excel 将充当自动化服务器。 Excel 公开自动化对象。 这些对象具有属性和方法作为其外部接口。 属性是自动化对象的命名属性。 方法是在自动化对象上运行的函数。

更多关于应用程序的信息

让我们讨论一下 Excel 工作表的布局，数据将存储在该工作表中。 程序完成任务后，Excel 工作表中的每个记录将包含一个条目，指定 URL 的当前状态。 该应用程序将在后台最小化运行，而你的其他应用程序可以正常工作。 已检查的链接数显示在程序的标题栏中，因此在程序最小化时也会显示在任务栏图标上。 这使用户可以跟踪进度。 检查完 URL 后，程序将关闭工作表并显示摘要报告。

URL 将保存在 C 列（从左侧开始的第三个单元格）中，而有关链接是否正常的信息保存在 E 列中。数据从第 4 行开始。

我在代码中包含了详细的注释，以便你可以了解它的工作原理。 你需要在运行代码之前编辑代码。 更改代码中 Excel 文件的路径。

'Save the filename in a variable

Const FILE = "C:\hrd_links.xls" 
'(This variable should contain the exact path of the file)

这是应用程序的完整代码

'Create the Excel object

Set objExcel = CreateObject("Excel.Application")

'Open the worksheet
objExcel.Workbooks.Open MYFILE

'Set the Transfer Protocol
Inet1.Protocol = icHTTP

'This is the main function!!
Public Sub Check_Links()

'This function will be called to check all the links in the
'worksheet.

'Declare variables
Dim var_row As Integer
Dim var_URL As String
Dim var_buffer As String
Dim var_msg As String
Dim var_file_not_found As Integer
Dim var_server_not_found As Integer
Dim var_timeout As Integer
Dim var_OK As Integer

'Catch the time-out errors

On Error Resume Next

'Set the row variable to the cell where the data starts
var_row = STARTROW

'Initialize the variables

var_timeout = 0
var_file_not_found = 0
var_OK = 0
var_server_not_found = 0


'Minimize the form
frmmain.WindowState = 1


'Loop through all the URLs
Do
    'Get the URL
    var_URL = objExcel.Cells(var_row, URL_COL)

    'Check whether the first cell is empty
    If var_URL = "" Then Exit Do

    'Open the URL
    Text1.Text = Inet1.OpenURL(var_URL)

    'Avoid tying up the system
    DoEvents

    'Errors messages are found in the  first 50 characters
    'returned by the openurl method

    If Len(Text1.Text) > 50 Then

        var_buffer = Left(Text1.Text, 50)

    Else

        var_buffer = Text1.Text

    End If

    'Catch a time-out error

    If Err = 35761 Then
         var_msg = "Timed Out"
         var_timeout = var_timeout + 1
    Err.Clear

    'If nothing is returned, it means that the server was
        'not found

    ElseIf Text1.Text = "" Then

        var_msg = "Server not found"
        var_server_not_found = var_server_not_found + 1

        'If error 404 is returned from the URL, it means the
       'server was found but he file was not found

    ElseIf InStr(1, var_buffer, "404") Then

        var_msg = "File not found"
       var_file_not_found = var_file_not_found + 1

    'else, the link is OK

    Else

        var_msg = "OK"
        var_OK = var_OK + 1

    End If

    'Save the result back to the worksheet

    objExcel.Cells(var_row, STATUS) = var_msg

    'Move to the next row

    var_row = var_row + 1

    'Display the current status.

    frmmain.Caption = var_OK + var_file_not_found + _ 
                            var_server_not_found + var_timeout

    'Display the results on the form

    Label1.Caption = "OK: " & var_OK
    Label2.Caption = "File not found: " & var_file_not_found
    Label3.Caption = "Server not found: " & var_server_not_found
    Label4.Caption = "Timed out: " & var_timeout

Loop While True

'If all the links have been checked, restore the form

frmmain.WindowState = 0

'Close the Worksheet

objExcel.Workbooks.Close

'Remove the object from the memory
Set objExcel = Nothing

'Display the results

var_buffer = "OK: " & var_OK & vbCrLf
var_buffer = var_buffer & "Server not found: " & _ 
                       var_server_not_found & vbCrLf
var_buffer = var_buffer & "File not found: " & _ 
                       var_file_not_found & vbCrLf
var_buffer = var_buffer & "Timed out: " & var_timeout

MsgBox var_buffer

打开 Excel 工作簿并添加你希望程序检查的链接。 关闭工作簿并运行该程序。 确保你已连接到 Internet。 就是这样。