该函数实现用脚本检查任何一个网页所有链接是否有效的功能。实际上,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 linkon 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 EndIf objXML.abort() EndIf Next Set objXML =Nothing CheckAllLinkReachable = blnReachable EndFunction