'==========================================================================
' 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
|