該函數(shù)實(shí)現(xiàn)用QTP腳本檢查任何一個網(wǎng)頁所有鏈接是否有效的功能。實(shí)際上，QTP自帶一個對WEB page里的鏈接進(jìn)行檢查的checkpoint，但是不能自定義擴(kuò)展和編輯；這里Sincky演示一個自定義的函數(shù)，模擬某個網(wǎng)頁的每個鏈接發(fā)送HTTP請求、再檢查HTTP響應(yīng)結(jié)果來實(shí)現(xiàn)對該網(wǎng)頁所有鏈接進(jìn)行正確性掃描的過程。代碼請見：

'==========================================================================

' Name: CheckAllLinkReachable

' Summary: CheckAllLinkReachable

' Parameters:

'         strBrowser: browser name

'         strPage: page name

'         strURLPattern: URL pattern you wan't to check. such as: ^http.*

' Return: None

'==========================================================================

Function CheckAllLinkReachable(strBrowser, strPage, strURLPattern)

        Dim blnReachable

         blnReachable = True

         Set objXML = CreateObject("Msxml2.XMLHTTP")

        ' Get all link on the page

         Set objDes = Description.Create

         objDes("micclass").Value = "Link"

         Set objLinkList = Browser(strBrowser).Page(strPage).ChildObjects(objDes)

         For i = 0 To objLinkList.Count() - 1

                   ' Create XML HTTP Object

                   strURL = objLinkList(i).GetROProperty("href")

                   If RegExpTest(strURLPattern, strURL) Then

                            objXML.Open "POST", strURL, false

                            objXML.Send

                   '         msgbox objXML.responseText

                            print (objLinkList(i).GetROProperty("href") & " Ready State:" & objXML.readyState & " Status: " & objXML.status)

                            If objXML.status <> "200" Then

                                     blnReachable = False

                            End If

                            objXML.abort()            

                   End If

         Next

         Set objXML = Nothing

         CheckAllLinkReachable = blnReachable

End Function