自动检查页面链接是否有效

 

Function CheckAllLinkReachable(strBrowser, strPage, strURLPattern)
　　Dim blnReachable
　　blnReachable = True
　　Set bjXML = CreateObject("Msxml2.XMLHTTP")
　　' Get all link on the page
　　Set bjDes = Description.Create
　　objDes("micclass").Value = "Link"
　　Set bjLinkList = 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 bjXML = Nothing
　　CheckAllLinkReachable = blnReachable
End Function