检查链接的有效性(参考自:风过无息)

上一篇 / 下一篇  2007-07-10 16:41:11 / 个人分类:QTP录制脚本


set a= Browser("土豆网 - 视频 - 播客 - 每个人都是生活的导演")
set b= Browser("土豆网 - 视频 - 播客 - 每个人都是生活的导演").Page("土豆网 - 视频 - 播客 - 每个人都是生活的导演")
call CheckLinks(a,b)
Function CheckLinks (BrowserObject,BrowserPage)
CheckLinks=TRUE
Dim s_URL,i_CreationTime
Dim s_LinkOuterText,s_LinkInnerText,s_Linkhref
s_URL=BrowserPage.GetROProperty("url")
i_CreationTime=1
i_LinkCount=BrowserPage.object.links.length - 1


Dim i_Link

For i_Link=0 to i_LinkCount
If Trim(BrowserPage.object.links(i_Link).target)="" Then
BrowserPage.object.links(i_Link).target="_blank" ' Set the link to open i a new window so that we dont have any change in current window
End If

'msgbox i_Link
'msgbox BrowserPage.Link("index:=" & i_Link).GetROProperty("index")
BrowserPage.object.links(i_Link).click
On error resume next
Browser("CreationTime:=" & i_CreationTime).sync
Browser("CreationTime:=" & i_CreationTime).Page("micClass:=Page").sync
On error goto 0
Dim s_LinkDetails

IHTML = Browser("CreationTime:=" & i_CreationTime).Page("micClass:=Page").object.Body.innerHTML
'Check if page was not able to be displayed
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
CheckLinks=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

Browser("CreationTime:=" & i_CreationTime).Sync
Browser("CreationTime:=" & i_CreationTime).close ' Close the link open.
If i_Link = 6 Then
 
Browser("制作相册 - 土豆网 - 播客 个人多媒体").Dialog("Microsoft Internet Explorer").Activate
Browser("制作相册 - 土豆网 - 播客 个人多媒体").Dialog("Microsoft Internet Explorer").WinButton("确定").Click
End If


Next
End Function


相关阅读:

TAG: QTP QTP录制脚本

 

评分:0

我来说两句

日历

« 2024-04-26  
 123456
78910111213
14151617181920
21222324252627
282930    

数据统计

  • 访问量: 26062
  • 日志数: 17
  • 图片数: 2
  • 建立时间: 2007-01-16
  • 更新时间: 2007-11-27

RSS订阅

Open Toolbar