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

 

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 = 0To 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 bjXML = Nothing
  CheckAllLinkReachable = blnReachable
EndFunction

posted on 2014-05-15 11:08  Mushishi_xu  阅读(344)  评论(0编辑  收藏  举报

导航