该函数实现用QTP脚本检查任何一个网页所有链接是否有效的功能。实际上，QTP自带一个对 WEB page里的链接进行检查的checkpoint，但是不能自定义扩展和编辑；这里Sincky演示一个自定义的函数，模拟某个网页的每个链接发送 HTTP请求、再检查HTTP响应结果来实现对该网页所有链接进行正确性扫描的过程。代码请见：
| '========================================================================== ' 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 |
