从老外网站上Down下来的检查网站链接有效性的QTP代码

Function CheckLinks2 (BrowserObject,BrowserPage)
 CheckLinks2=TRUE
 Dim orgURL,orgCreationTime
 Dim i_Link, l_hWnd
 Dim b_newBrowser
 Dim s_LinkOuterText,s_LinkInnerText,s_Linkhref

 s_URL=BrowserPage.GetROProperty("url")
 l_hWnd=BrowserObject.GetROProperty("hwnd")
 
 i_CreationTime=1
 
 i_LinkCount=BrowserPage.object.links.length - 1
 
 For i_Link=0 to i_LinkCount

   If Trim(BrowserPage.object.links(i_Link).target)="" and Instr(BrowserPage.object.links(i_Link).href,"javascrīpt:")=0 Then
    b_newBrowser=False
   else
    b_newBrowser=TRUE
     End If
 
   s_LinkOuterText=BrowserPage.object.links(i_Link).outerText
   s_LinkInnerText=BrowserPage.object.links(i_Link).innerText
   s_Linkhref=BrowserPage.object.links(i_Link).href

   BrowserPage.object.links(i_Link).click

   'Doing Browser.Exist with CreationTime:=1 when the browser does not exist will give TRUE so i though of work around to compare the windows
   ' handle for the old browser and the new browser with CreationTime:=1. If they are same that mean no other window was opened.
   If b_newBrowser Then
    l_newhWnd=Clng(Browser("CreationTime:=" & i_CreationTime).GetROProperty("hwnd"))
    If  clng(l_hWnd) =l_newhWnd Then
     b_newBrowser=False
    end if
   end if
   
   On error resume next
   If b_NewBrowser Then
    Browser("CreationTime:=" & i_CreationTime).sync
    Browser("CreationTime:=" & i_CreationTime).Page("micClass:=Page").sync
   Else
    BrowserObject.sync
    BrowserPage.sync
   End if
   On error goto 0
   
   Dim s_LinkDetails
 
   If b_NewBrowser Then
    IHTML = Browser("CreationTime:=" & i_CreationTime).Page("micClass:=Page").object.Body.innerHTML
   else
    IHTML = BrowserPage.object.Body.innerHTML
   End If

   'Check if page was not able to be displayed you can update this code any time
   If (InStr(IHTML,"HTTP 404") <> 0) Or (InStr(IHTML,"cannot be displayed") <> 0)  Then
    s_LinkDetails="Link Broken" + vbcrlf + "Link Details:" +vbcrlf
    s_LinkDetails=s_LinkDetails+"OuterText: "+ s_LinkOuterText + vbcrlf
    s_LinkDetails=s_LinkDetails+"InnerText: "+  s_LinkInnerText + vbcrlf
    s_LinkDetails=s_LinkDetails+ "href: " + s_Linkhref+ vbcrlf
    s_LinkDetails=s_LinkDetails+ "Links Open in New Browse: " & bNewBrowser & vbcrlf
    Reporter.ReportEvent micWarning,"Check Link(" & i_Link & ") -> " & s_LinkOuterText  ,s_LinkDetails
    CheckLinks2=FALSE
   Else
    s_LinkDetails="Link Working" + vbcrlf + "Link Details:" +vbcrlf
    s_LinkDetails=s_LinkDetails+"OuterText: "+ s_LinkOuterText + vbcrlf
    s_LinkDetails=s_LinkDetails+"InnerText: "+  s_LinkInnerText+ vbcrlf
    s_LinkDetails=s_LinkDetails+ "href: " + s_Linkhref+ vbcrlf
    s_LinkDetails=s_LinkDetails+ "Links Open in New Browse: " & bNewBrowser & vbcrlf
    Reporter.ReportEvent micPass,"Check Link(" & i_Link & ") -> " & s_LinkOuterText  ,s_LinkDetails
   End If
 
   If b_NewBrowser Then
    while Clng(Browser("CreationTime:=" & i_CreationTime).GetROProperty("hwnd"))<>l_hwnd
     On error resume next
     Browser("CreationTime:=" & i_CreationTime).Sync
     Browser("CreationTime:=" & i_CreationTime).Page("micClass:=Page").Close
     On error goto 0
     Browser("CreationTime:=" & i_CreationTime).Close
     'Tackle links that open a new browser and also opens a popup using that
     'i_CreationTime=i_CreationTime + 1
    Wend
    
    i_CreationTime=1
    
   else
    On error resume next
    BrowserObject.Navigate s_URL
    BrowserObject.Sync
    BrowserObject.Page.Sync
    On error goto 0
   end if
 Next
End Function

'*********************  In QTP **************8
 Set BrowserObject = Browser("micClass:=Browser","CreationTime:=0")
 Set BrowserPage = BrowserObject.Page("micClass:=Page")
 CheckLinks2 BrowserObject,BrowserPage
'*********************************************8