qtp-descriptive-programming.vbs

RegisterUserFunc "Page","getChildObjects", "getChildObjects"
RegisterUserFunc "WebElement","getChildObjects", "getChildObjects"
RegisterUserFunc "WebTable","getChildObjects", "getChildObjects"

Public Function getChildObjects(ByRef PageObject, ByVal strDescString)
	Set oChildren = New cls_DPObjects
	Set getChildObjects = oChildren.getChildObjects(PageObject, strDescString)
	Set oChildren = Nothing
End Function


Class cls_DPObjects
	
	Dim oChildObjects
	Dim iDelayEachSetBy
	
	Private Sub Class_Initialize() 
		iDelayEachSetBy = 0
		Set oChildObjects = CreateObject("Scripting.Dictionary")
	End Sub
	
	Private Sub Class_Terminate()
		Set oChildObjects = Nothing
	End Sub
	
	Public Function getItems()
		Set getItems = oChildObjects
	End Function
	
	Public Default Function getCount()
		getCount = oChildObjects.Count
	End Function
	
	Public Function DelayEachSetBy(ByVal iTimeOut)
		iDelayEachSetBy = iTimeOut
		Set DelayEachSetBy = Me
	End Function
	
'get Child Objects from a page matching a Descriptive string
	Public Function getChildObjects(ByRef PageObject, ByVal strDescString)
		If InStr(1, strDescString, ":=") > 0  Then
			Set oDesc = Description.Create
			arrPropValueCollection = Split(strDescString, ",")
			For i = 0 To UBound(arrPropValueCollection)
				If Instr(1, arrPropValueCollection(i),":=") > 0 Then
					arrPropValue = Split(arrPropValueCollection(i),":=")
					oDesc(arrPropValue(0)).Value = arrPropValue(1)
				End If
			Next
			Set ObjCollection = PageObject.ChildObjects(oDesc)
			For i = 0 To ObjCollection.Count -1
				AddObject ObjCollection.Item(i)
			Next
		End If
		Set getChildObjects = Me
	End Function
	
'get only the Visible objects from the collection
	Public Function VisibleChildObjects
		If isObject(oChildObjects) Then
			For Each strKey In oChildObjects
				If CInt(oChildObjects.Item(strKey).Object.offsetHeight) = 0 AND CInt(oChildObjects.Item(strKey).Object.offsetWidth) = 0 Then
					oChildObjects.Remove strKey
				End If
			Next
		End If
		Set VisibleChildObjects = Me
	End Function
	
'get only the objects matching a property from the collection
	Public Function WithProperty(ByVal strPropValue)
		If isObject(oChildObjects) Then
			If  strPropValue <> "" AND InStr(1,strPropValue,":=") > 0 Then
				arrPropValue = Split(strPropValue,":=")
				strProp   = arrPropValue(0)
				strValue  = arrPropValue(1)
				For Each strKey In oChildObjects
					If UCase(oChildObjects.Item(strKey).GetRoProperty(strProp)) <> UCase(strValue) Then
						oChildObjects.Remove strKey
					End If
				Next
			End If
		End If
		Set WithProperty = Me
	End Function
	
'get only the objects matching reg exp property from the collection
	Public Function WithRegExpProperty(ByVal strPropValue)
		If isObject(oChildObjects) Then
			If  strPropValue <> "" AND InStr(1,strPropValue,":=") > 0 Then
				arrPropValue = Split(strPropValue,":=")
				strProp   = arrPropValue(0)
				strValue  = arrPropValue(1)
				For Each strKey In oChildObjects
					If Not(RegExpTest(strValue, oChildObjects.Item(strKey).GetRoProperty(strProp))) Then
						oChildObjects.Remove strKey
					End If
				Next
			End If
		End If
		Set WithRegExpProperty = Me
	End Function
		
	Public Function Index(ByVal intIndex)
		Set tempObj = Nothing
		If isObject(oChildObjects) Then
			If oChildObjects.Count < (intIndex + 1) Then
				intIndex = oChildObjects.Count - 1
			End If
			Set tempObj = oChildObjects.Items()(intIndex)
		End If
		Set Index = tempObj
		Set oChildObjects = Nothing
	End Function		
	
' Set particular value for all the objects in the collection
	Public Sub SetValue(ByVal strValue)
		If isObject(oChildObjects) Then
			For Each strKey In oChildObjects
				Select Case UCase(oChildObjects.Item(strKey).GetRoProperty("micclass"))
				Case "WEBEDIT", "WEBCHECKBOX"
					If oChildObjects.Item(strKey).GetRoProperty("disabled") = "0" Then
						oChildObjects.Item(strKey).Set strValue
					End If
				Case "WEBLIST"
					oChildObjects.Item(strKey).Select strValue
				Case Else
'
				End Select
				Wait iDelayEachSetBy
			Next
		End If
	End Sub
	
'Private - add objects into the collection
	Private Sub AddObject(ByRef TestObject)
		oChildObjects.Add TestObject, TestObject
	End Sub
	
'Check if the text is matching a pattern
	Private Function RegExpTest(ByVal strPattern, ByVal strText)
		Set oRegExp = New RegExp
		oRegExp.Global = True
		oRegExp.Ignorecase = True
		oRegExp.Pattern = strPattern
		RegExpTest = oRegExp.Test(strText)
		Set oRegExp = Nothing
	End Function
	
End Class