发点有质量的贴——QTP自定义检查点

xixihahahu

发点有质量的贴——QTP自定义检查点


强烈呼吁大家发点有质量对大家有用的贴，又不是宝贝，在下先拍个砖引个玉
'********************************************************************************
'Function Name: Check_ComboBox_ItemValue
'Description:检查ComboBox的Item值是否一直
'Input ： objVbComboBox :VbComboBox的对象实例, strItemValue: itemvalue的期望值, intItemValueLength: 截取ItemValue的值，传递给Left函数
'对于汉字的长度，一般一个汉字为2位
'Output：输出到Report, Pass Or Fail

'Developed by : xixihahahu
'Create Date:2008-08-26
'********************************************************************************
Function Check_ComboBox_ItemValue(objVbComboBox,strItemValue,intItemValueLength)
   Dim i
   Dim Cnt
   Cnt = objVbComboBox.GetItemsCount
   For i = 0 to Cnt -1
           If  Trim(Left(objVbComboBox.getItem(i),intItemValueLength))= strItemValue Then
                   Reporter.ReportEvent micPass,"检查ComboBox下拉项目","下拉项目包含“" & strItemValue & "”,测试通过"
                   Exit Function
           End If
   Next
   Reporter.ReportEvent micFail,"检查ComboBox下拉项目","下拉项目不包含“" & strItemValue & "”,测试失败"
End Function

'********************************************************************************
'Function Name: Check_Objects_ItemValue
'Description:检查obj的Item值是否和期望值相同
'Input ： obj :控件对象实例, arrItemValue: 数组类型，存放待检查的包含项的期望值, arrItemValueLength: 截取ItemValue的值，传递给Left函数
'Output：输出到Report, Pass Or Fail

'Developed by : xixihahahu
'Create Date:2008-08-26
'********************************************************************************
Function Check_Objects_ItemValue(obj,arrItemValue,arrItemValueLength)
   Dim i
   Dim Cnt
   Cnt = UBound(arrItemValue)
   strReport = obj.ToString()&"包含下列项："
   For i = 0 to Cnt
           If Trim(Left(obj.getItem(i),arrItemValueLength(i))) = arrItemValue(i) Then
                   strReport = strReport & vbNewLine & arrItemValue(i)
                   Else
                                Reporter.ReportEvent micFail,"检查控件包含项符合性","包含项不完全符合，"&arrItemValue(i)&"为第一个不符合项"
                                Exit Function
           End If
   Next
   Reporter.ReportEvent micPass,"检查控件包含项符合性",strReport
End Function

'********************************************************************************
'Function Name: Check_Objects_Text
'Description:检查控件如Dialog的字符串是否如期望值，适用于dialog类的对话框
'Input ： obj :对象实例, strText:待验证的字符串期望值,
'Output：输出到Report, Pass Or Fail

'Developed by : xixihahahu
'Create Date:2008-08-27
'********************************************************************************
Function Check_Objects_Text(obj,strText)
   Dim i
   Dim Cnt
        txtArray = Split(obj.GetVisibleText(),vbCrLf,-1,1)
    Cnt = UBound(txtArray)  '取数组上限
        For i = 0 to Cnt
                If   Trim(txtArray(i)) = Trim(strText) Then
                        Reporter.ReportEvent micPass,"检查字符串是否一致","界面中包含字符串："&strText
                        Exit Function           
                End If
        Next
                        Reporter.ReportEvent micFail,"检查字符串是否一致","界面中不包含字符串："&strText
End Function

'********************************************************************************
'Function Name: Check_Object_SelectedText
'Description:检查控件如Dialog的字符串是否如期望值，适用于dialog类的对话框,是Check_Objects_Text改进
'Input ： obj :对象实例, strText:待验证的字符串期望值,  intTextLength：价差字符串的长度
'Output：输出到Report, Pass Or Fail

'Developed by : qcc
'Create Date:2008-08-27
'********************************************************************************
Function Check_Object_SelectedText(obj,strText,intTextLength)
     Dim i
   Dim Cnt
        txtArray = Split(obj.GetVisibleText(),vbCrLf,-1,1)
    Cnt = UBound(txtArray)  '取数组上限
        For i = 0 to Cnt
                If   Left(Trim(txtArray(i)),intRequiredLength) = Left(Trim(strText),intRequiredLength) Then
                        Reporter.ReportEvent micPass,"检查字符串是否一致","界面中包含字符串："&strText
                        Check_Object_SelectedText = True
                        Exit Function           
                End If
        Next
                        Reporter.ReportEvent micFail,"检查字符串是否一致","界面中不包含字符串："&strText
                        Check_Object_SelectedText = False
End Function

'********************************************************************************
'Function Name: Check_List_Selection
'Description:检查list的Selection值是否一致
'Input ： objVbList :VbList的对象实例, Exist：选择检查包含哪些项还是不包含任何项,如为True则表示检查包含哪些项，如为false，表示检查不包含任何项
'strSltValue:表示List中被选择项的期望值，intSltLength: 截取所选择项的值，传递给Left函数
'Output：输出到Report, Pass Or Fail

'Developed by : xixihahahu
'Create Date:2008-08-26
'********************************************************************************
Function Check_List_Selection(objVbList,Exist,strSltValue,intSltLength)
   Dim i
   Dim Cnt
   If Exist  Then
                   sltArray = Split(objVbList.GetRoProperty("Selection"),vblf,-1,1)
                    Cnt = UBound(sltArray)  '取数组上限
                For i = 0 to Cnt  
                        If Trim(Left(sltArray(i),intSltLength) = strSltValue) Then
                                        Reporter.ReportEvent micPass,"检查list选中项","选中项包含“" & strSltValue & "”,测试通过"
                                        Exit Function
                        End If
                Next
   Reporter.ReportEvent micFail,"检查list选中项","选中项不包含“" & strSltValue & "”,测试失败"
   End If
   If Not Exist Then
        If objVbList.GetRoProperty("Selection") = "" Then
                        Reporter.ReportEvent micPass,"检查list选中项","不包含任何选中项，测试通过"
                        Exit Function
                Else
                        Reporter.ReportEvent micFail,"检查list选中项","包含某些选中项，测试失败"
        End If
        End If
End Function

ls_721521

好贴！

欧阳

  先顶下

angek

顶一下，支持楼主，感谢楼主分享

fei.ge

【发点有质量的贴】
<<<支持

onlonely

别光看呀,也来点自己的,,
我感觉楼主的检查点有些过于繁复,下面就来个我目前用的,希望有更简洁高效的出现
论坛中看可能层叠效果不好,最好放到编译器中有层次的时候看.

'*******************************************************************
'函数说明:自定义的检查点函数,基于对象库使用
'参数1:Check_Object:检查的对象,是在对象库中的对象
'参数2:CheckPoint_Name:检查点名称
'参数3:Check_PropertiesName:检查的什么属性
'参数4:PropertiesValue:预期的值,可以是正则表达式
'返回值:通过放回true,不通过返回false
'*******************************************************************
Function CheckPoint(Check_Object,CheckPoint_Name,Check_PropertiesName,PropertiesValue)
For checknumber=1 To 10 '设置等待次数
  If Check_Object.exist Then
   Check_Object.FireEvent "onfocus"'设置检查对象为当前焦点,否则有时候会有莫名的错误
   CheckPoint_TMPString=Check_Object.GetROProperty(Check_PropertiesName)'获得实际对象检查字段的值
   ObjectType_String=Check_Object.ToString'把检查对象输出成一串字符串,详情查看帮助
   CheckPoint_Tmp_Array=Split(ObjectType_String," ")'切割检查对象生成的字符串,目的是这样最终可以获取检查对象的类型
   ObjectType=CheckPoint_Tmp_Array(Ubound(CheckPoint_Tmp_Array))'获得检查对象的类型
   CheckPoint_TMP=Exist_Reg(CheckPoint_TMPString,PropertiesValue)'调用检查函数(其实就是单独写的一个正则表达式函数的TEST方法)检查是否一致
   'print CheckPoint_Name&"实际值:"&CheckPoint_TMPString'调试用语句

   If ObjectType="image" Then
    CheckPoint_NameString="实际("&CheckPoint_Name&")的图片"  '图片类的对象输出实际图片,用来参考,但是注意使用多次这个检查点的话,各个检查点别重复    Check_Object.CaptureBitmap CheckPoint_NameString&".png"
    If CheckPoint_TMP Then
     reporter.ReportEvent micPass,CheckPoint_Name&"检查点通过","实际值:"&CheckPoint_TMPString,CheckPoint_NameString&".png"
    Else
     reporter.ReportEvent micFail,CheckPoint_Name&"检查点不通过","实际值:"&CheckPoint_TMPString,CheckPoint_NameString&".png"
    End If
   Else
    If CheckPoint_TMP Then
     reporter.ReportEvent micPass,CheckPoint_Name&"检查点通过",CheckPoint_Name&"(实际值):"&CheckPoint_TMPString
    Else
     reporter.ReportEvent micFail,CheckPoint_Name&"检查点不通过",CheckPoint_Name&"(实际值):"&CheckPoint_TMPString
    End If
   End If
   CheckPoint=CheckPoint_TMP
   Exit For
  End If
Next
End Function
'*******************************************************************
'函数说明:正则表达式判断某字符串是否匹配
'参数1,Exist_String:需要判断的字符串
'参数2,Reg_Pattern:正则表达式字符串
'返回值:匹配正则表达式字符串则返回"true",否则返回false
'*******************************************************************
Function Exist_Reg(Exist_String,Reg_Pattern)
Dim re
Set re = New RegExp
re.Pattern = Reg_Pattern  
Exist_Reg=re.test(Exist_String)
end Function

[ 本帖最后由 onlonely 于 2009-6-9 22:51 编辑 ]

aliceella

谢谢楼主，楼主是否可以考虑一下把测试的软件发上来，让大家可以自己录制，然后再根据自己的脚本来编辑运行！效果会更好点！

chipucca

楼主你好，我想请问一下，在你代码里面的obj是怎么定义的呢？我测试了一下你的代码总是出错，我的是obj = Window("Flight Reservation").Dialog("Flight Reservations").Static("The information has changed.").GetROProperty("text")     谢谢！在线等

lantianwei

obj = Window("Flight Reservation").Dialog("Flight Reservations").Static("The information has changed.").GetROProperty("text") 返回的是字符串而非对象
正确的如下：
obj = Window("Flight Reservation").Dialog("Flight Reservations").Static("The information has changed.")

chipucca

非常感谢您的回复，但我这里还有有问题，其实我的目的就是设置一个TextCheckpoint,strText是期望结果，obj是被测对象。代码如下:

Dim a
Dim b

Function Check_Objects_Text(obj,strText)
   Dim i
   Dim Cnt
        strText = "The information has changed.Save changes?"
        obj = Window("Flight Reservation").Dialog("Flight Reservations").Static("The information has changed.")
                txtArray = Split(obj.GetVisibleText(),vbCrLf,-1,1)
    Cnt = UBound(txtArray)  '取数组上限
        For i = 0 to Cnt
                If   Trim(txtArray(i)) = Trim(strText) Then
                        'Reporter.ReportEvent micPass,"检查字符串是否一致","界面中包含字符串："&strText
                                                Msgbox("Pass")
                        Exit Function           
                End If
        Next
                        'Reporter.ReportEvent micFail,"检查字符串是否一致","界面中不包含字符串："&strText
                                                Msgbox("Fail")
End Function

a = obj                   'Window("Flight Reservation").Dialog("Flight Reservations").static("The information has changed. Save changes?").GetROProperty("text")
b = strText               '"The information has changed. Save changes?"   

Check_Objects_Text a,b

报的错是：Object doesn't support this property or method

lantianwei

a = obj  没有被定义
strText = "The information has changed.Save changes?"
obj = Window("Flight Reservation").Dialog("Flight Reservations").Static("The information has changed.")
a = obj
b = strText  
Check_Objects_Text a,b

hanjj

好贴.实用

chipucca

谢谢lantianwei 的积极回复。后来我没有用Split函数来通过比较每个字母是否相同来判断两个字符串是否相同，而是用strComp函数来直接比较两个字符串。现将我的代码复制如下，测的是QTP自带的小飞机程序，供大家指点：
Dim a,b
a = Window("Flight Reservation").Dialog("Flight Reservations").Static("The information has changed. Save changes?").GetROProperty("text")
b = "The information has changed. Save changes?"   
Check_Objects_Text a, b
Window("Flight Reservation").Dialog("Flight Reservations").WinButton("No").Click

Function Check_Objects_Text(realText,strText)
   Dim Mycomp
   strText = "The information has changed. Save changes?"
   Mycomp = StrComp(realText, strText, 1)
   msgbox strText
   msgbox realText
  If Mycomp = 0 Then
        Reporter.ReportEvent micPass,"检查字符串是否一致","界面中包含字符串："&strText
  else
    Reporter.ReportEvent micFail,"检查字符串是否一致","界面中不包含字符串："&strText
   End If
End Function

vikesgao

十分感谢楼主，辛苦了，多谢

metoto

好东西，mark

zz45509

写好的函数~~~~~~~~~~~~不是我写的~~~~~~~~~~~~~


'----------------------------------------------------------------------------------------------------------------------------
'Name:WriteReport(Private)
'
'Purpose:向测试报告中写一个新的测试节点，并写入测试报告
'
'Parameters:
'ExpectedValue:预期结果
'ActualValue:实际结果
'ResultValue:结果状态
'nodename:结点名称
'
'Author:Muse
'
'Date:2012-5-16
'-----------------------------------------------------------------------------------------------------------------------------
Private Function WriteReport(ExpectedValue,ActualValue,ResultStatus,nodename)
   Dim oEventDesc,newEventContext
        Set oEventDesc=CreateObject("Scripting.Dictionary")
        oEventDesc("Status")=micFail '添加状态
        oEventDesc("EnabledFilter")=False '添加是否过滤
        oEventDesc("Nodename")=nodename '添加结点名称
        oEventDesc("StepHtmlInfo")= "<TABLE border='1'>"&_
                "<TR><TD>预期结果</TD><TD>"+ExpectedValue+"</TD></TR>"&_
                "<TR><TD>实际结果</TD><TD>"+ActualValue+"</TD></TR>"&_
                "<TR><TD>结果</TD><TD style='background-color:red'><b>Failed</b></TD></TR>"&_
                "</TABLE>"
        If ResultStatus Then '判断状态
                oEventDesc("Status")=micPass
                oEventDesc("StepHtmlInfo")=Replace(oEventDesc("StepHtmlInfo"),_
                "<TD style='background-color:red'><b>Failed</b></TD>",_
                "<TD style='background-color:green'><b>Passed<b></TD>")
        End If
        newEventContext=Reporter.LogEvent("Replay",oEventDesc,Reporter.GetContext) '生成报告
        Set oEventDesc=nothing '释放资源
End Function
'-----------------------------------------------------------------------------------------------------------------------------------
'Name:CheckProperty(Function)
'
'Purpose:判断预期结果是否与实际结果一致
'
'Parameters:
'Object:对象名称
'PropertyName:属性
'ExpectedValue:预期结果
'
'Author:Muse
'
'Date:2012-5-16
'--------------------------------------------------------------------------------------------------------------------------------------
Function CheckProperty(Object,PropertyName,ExpectedValue)
        If Object.GetROProperty(PropertyName)=ExpectedValue Then
                   WriteReport ExpectedValue,Object.GetROProperty(PropertyName),True,_
                   "check"+Object.GetTOProperty("testObjName")+"<"+PropertyName+">属性"
                   CheckProperty=True
                   Exit Function
        Else
                   WriteReport ExpectedValue,Object.GetROProperty(PropertyName),False,_
                   "check"+Object.GetTOProperty("testObjName")+"<"+PropertyName+">属性"               
                        CheckProperty=False
                        Exit Function
        End If
End Function

Dim oWinButton
Set oWinButton=Window("一二三").WinButton("录像视频")
CheckProperty oWinButton,"text","录像视频"