How to : Descriptive Programming In QTP Using VBScript
How To Call One Action From Another
' :
This example starts QuickTest, opens a new test, and adds a new action, which calls a second action.
'Then it edits the first action's script to move the call to the second action to a new position in the script,
'validates the syntax of the new script, defines some action parameters, and uploads the
'modified action script.
'****************************************************
' Dim qtApp, ActionContent, ActionName, ActionDescr, NewAction, SecondAction, script
Set qtApp = CreateObject("QuickTest.Application") ' Create the application object
qtApp.Launch
qtApp.Visible = True
qtApp.New
ActionContent = "Window(""Calculator"").WinButton(""1"").Click" & vbCrLf & "Window(""Calculator"").WinButton(""+"").Click" & vbCrLf & "Window(""Calculator"").WinButton(""+"").Click" & vbCrLf & "Window(""Calculator"").WinButton(""="").Click"
ActionDescr = "A new sample action for the test."
ActionName = "Action" + CStr(qtApp.Test.Actions.Count + 1)
'Add a new action at the begining of the test
Set NewAction = qtApp.Test.AddNewAction(ActionName, ActionDescr, ActionContent, False, qtAtBegining)
'Add another action and call it from the begining of the action that was just added above.
ActionContent = "Function f1(str)" & vbCrLf & vbTab & "msgbox str" & vbCrLf & "End Function"
ActionName = "Action" + CStr(qtApp.Test.Actions.Count + 1)
Set SecondAction = NewAction.AddNewAction(ActionName, ActionDescr, ActionContent, True, qtAtBegining)
'Use the Load Script function to store the content of the first new action into the script array
script = Load_Script(NewAction.GetScript())
'Move Call to the action to another script line
script = Move_CallAction(script, SecondAction.Name, UBound(script))
'Convert script array to the text
ActionContent = Save_Script(script)
'Set new script source to the action
scriptError = NewAction.ValidateScript(ActionContent)
If Len(scriptError) = 0 Then
NewAction.SetScript ActionContent
NewAction.Description = "Check the calculator application and run next Action"
NewAction.Type = "Reusable" 'Put non-reusable type to the new action
Set aParamDefs = NewAction.ActionParameterDefinitions
aParamDefs.Add "InParam", "An input action parameter definition", 0, 0, "Input Value" 'Add an input string parameter to the newly created action
aParamDefs.Add "ResParam", "An output action parameter definition", 0, 1, "Output Value" 'Add an output string parameter to the newly created action
Set resParamDef = aParamDefs.Item ("ResParam")
resParamDef.Type = 1 'Put the boolean parameter type
resParamDef.DefaultValue = false
resParamDef.Description = "Result parameter"
Else
Err.Raise E_SCRIPT_NOT_VALID, "Validate Script Error", scriptError
End If
Const E_SCRIPT_TABLE = 1
Const E_EMPTY_SCRIPT = 2
Const E_SCRIPT_NOT_VALID = 3
Public Function Load_Script(src)
If Len(src) = 0 Then
Err.Raise E_SCRIPT_TABLE, "Load_Script", "Script is empty"
End If
Load_Script = Split(Trim(src), vbCrLf)
End Function
Public Function Save_Script(script)
If Not IsArray(script) Then
Err.Raise E_SCRIPT_TABLE, "Save_Script", "Script should be string array"
End If
If UBound(script) - LBound(script) = 0 Then
Err.Raise E_SCRIPT_TABLE, "Save_Script", "Script is empty"
End If
Save_Script = Join(script, vbCrLf)
End Function
Public Function Find_Line(script, criteria)
Dim rExp, I
'********************************************************************
'Verify that the first argument contains a string array
If Not IsArray(script) Then
Err.Raise E_SCRIPT_TABLE, "Find_Line", "The script should be a string array"
End If
Set rExp = New RegExp
ptrn = ""
If IsArray(criteria) Then
ptrn = Join(criteria, " * ")
Else
ptrn = criteria
End If
rExp.Pattern = ptrn 'Set pattern string
rExp.IgnoreCase = True ' Set case insensitivity.
rExp.Global = True ' Set global applicability.
I = 0
For Each scrItem In script
If rExp.Execute(scrItem).Count > 0 Then
Find_Line = I
Exit Function
End If
I = I + 1
Next
Find_Line = -1
End Function
Public Function Move_Line(script, curPos, newPos)
'********************************************************************
'Verify that the first argument contains a string array
If Not IsArray(script) Then
Err.Raise E_SCRIPT_TABLE, "Move_Line", "Script should be string array"
End If
scrLen = UBound(script) - LBound(script)
If curPos = newPos Or curPos < 0 Or newPos < 0 Or scrLen < curPos Or scrLen < newPos Then
Move_Line = script
Exit Function
End If
tmpLine = script(curPos)
If newPos > curPos Then
For curPos = curPos + 1 To scrLen
script(curPos - 1) = script(curPos)
If curPos = newPos Then
script(curPos) = tmpLine
Exit For
End If
Next
Else
For curPos = curPos - 1 To 0 Step -1
script(curPos + 1) = script(curPos)
If curPos = newPos Then
script(curPos) = tmpLine
Exit For
End If
Next
End If
Move_Line = script
End Function
Function Insert_Line(script, lineSrc, linePos)
'********************************************************************
'Verify that the first argument contains a string array
If Not IsArray(script) Then
Err.Raise E_SCRIPT_TABLE, "Insert_Line", "Script should be string array"
End If
scrLen = UBound(script) - LBound(script)
If (scrLen = 0 And linePos <> 0) Or (linePos > scrLen + 1) Then
Insert_Line = script
Exit Function
End If
newScript = Split(String(scrLen + 1, " "), " ")
shiftIndex = 0
For I = 0 To scrLen + 1
If linePos = I Then
newScript(I) = lineSrc
shiftIndex = 1
Else
newScript(I) = script(I + shiftIndex)
End If
Next
Insert_Line = newScript
End Function
Function Delete_Line(script, linePos)
'********************************************************************
'Verify that the first argument contains a string array
If Not IsArray(script) Then
Err.Raise E_SCRIPT_TABLE, "Delete_Line", "Script should be string array"
End If
scrLen = UBound(script) - LBound(script)
If (scrLen = 0) Or (linePos > scrLen) Then
Insert_Line = script
Exit Function
End If
If scrLen = 1 Then
Delete_Line = Array()
Exit Function
End If
newScript = Split(String(scrLen - 1, " "), " ")
shiftIndex = 0
For I = 0 To scrLen
If linePos = I Then
shiftIndex = 1
Else
newScript(I - shiftIndex) = script(I)
End If
Next
Delete_Line = newScript
End Function
Public Function Move_CallAction(script, actName, newPos)
curPos = Find_Line(script, Array("RunAction", """" & actName & """"))
Move_CallAction = Move_Line(script, curPos, newPos)
End Function
How To Call One Action From Another
' :
This example starts QuickTest, opens a new test, and adds a new action, which calls a second action.
'Then it edits the first action's script to move the call to the second action to a new position in the script,
'validates the syntax of the new script, defines some action parameters, and uploads the
'modified action script.
'****************************************************
' Dim qtApp, ActionContent, ActionName, ActionDescr, NewAction, SecondAction, script
Set qtApp = CreateObject("QuickTest.Application") ' Create the application object
qtApp.Launch
qtApp.Visible = True
qtApp.New
ActionContent = "Window(""Calculator"").WinButton(""1"").Click" & vbCrLf & "Window(""Calculator"").WinButton(""+"").Click" & vbCrLf & "Window(""Calculator"").WinButton(""+"").Click" & vbCrLf & "Window(""Calculator"").WinButton(""="").Click"
ActionDescr = "A new sample action for the test."
ActionName = "Action" + CStr(qtApp.Test.Actions.Count + 1)
'Add a new action at the begining of the test
Set NewAction = qtApp.Test.AddNewAction(ActionName, ActionDescr, ActionContent, False, qtAtBegining)
'Add another action and call it from the begining of the action that was just added above.
ActionContent = "Function f1(str)" & vbCrLf & vbTab & "msgbox str" & vbCrLf & "End Function"
ActionName = "Action" + CStr(qtApp.Test.Actions.Count + 1)
Set SecondAction = NewAction.AddNewAction(ActionName, ActionDescr, ActionContent, True, qtAtBegining)
'Use the Load Script function to store the content of the first new action into the script array
script = Load_Script(NewAction.GetScript())
'Move Call to the action to another script line
script = Move_CallAction(script, SecondAction.Name, UBound(script))
'Convert script array to the text
ActionContent = Save_Script(script)
'Set new script source to the action
scriptError = NewAction.ValidateScript(ActionContent)
If Len(scriptError) = 0 Then
NewAction.SetScript ActionContent
NewAction.Description = "Check the calculator application and run next Action"
NewAction.Type = "Reusable" 'Put non-reusable type to the new action
Set aParamDefs = NewAction.ActionParameterDefinitions
aParamDefs.Add "InParam", "An input action parameter definition", 0, 0, "Input Value" 'Add an input string parameter to the newly created action
aParamDefs.Add "ResParam", "An output action parameter definition", 0, 1, "Output Value" 'Add an output string parameter to the newly created action
Set resParamDef = aParamDefs.Item ("ResParam")
resParamDef.Type = 1 'Put the boolean parameter type
resParamDef.DefaultValue = false
resParamDef.Description = "Result parameter"
Else
Err.Raise E_SCRIPT_NOT_VALID, "Validate Script Error", scriptError
End If
Const E_SCRIPT_TABLE = 1
Const E_EMPTY_SCRIPT = 2
Const E_SCRIPT_NOT_VALID = 3
Public Function Load_Script(src)
If Len(src) = 0 Then
Err.Raise E_SCRIPT_TABLE, "Load_Script", "Script is empty"
End If
Load_Script = Split(Trim(src), vbCrLf)
End Function
Public Function Save_Script(script)
If Not IsArray(script) Then
Err.Raise E_SCRIPT_TABLE, "Save_Script", "Script should be string array"
End If
If UBound(script) - LBound(script) = 0 Then
Err.Raise E_SCRIPT_TABLE, "Save_Script", "Script is empty"
End If
Save_Script = Join(script, vbCrLf)
End Function
Public Function Find_Line(script, criteria)
Dim rExp, I
'********************************************************************
'Verify that the first argument contains a string array
If Not IsArray(script) Then
Err.Raise E_SCRIPT_TABLE, "Find_Line", "The script should be a string array"
End If
Set rExp = New RegExp
ptrn = ""
If IsArray(criteria) Then
ptrn = Join(criteria, " * ")
Else
ptrn = criteria
End If
rExp.Pattern = ptrn 'Set pattern string
rExp.IgnoreCase = True ' Set case insensitivity.
rExp.Global = True ' Set global applicability.
I = 0
For Each scrItem In script
If rExp.Execute(scrItem).Count > 0 Then
Find_Line = I
Exit Function
End If
I = I + 1
Next
Find_Line = -1
End Function
Public Function Move_Line(script, curPos, newPos)
'********************************************************************
'Verify that the first argument contains a string array
If Not IsArray(script) Then
Err.Raise E_SCRIPT_TABLE, "Move_Line", "Script should be string array"
End If
scrLen = UBound(script) - LBound(script)
If curPos = newPos Or curPos < 0 Or newPos < 0 Or scrLen < curPos Or scrLen < newPos Then
Move_Line = script
Exit Function
End If
tmpLine = script(curPos)
If newPos > curPos Then
For curPos = curPos + 1 To scrLen
script(curPos - 1) = script(curPos)
If curPos = newPos Then
script(curPos) = tmpLine
Exit For
End If
Next
Else
For curPos = curPos - 1 To 0 Step -1
script(curPos + 1) = script(curPos)
If curPos = newPos Then
script(curPos) = tmpLine
Exit For
End If
Next
End If
Move_Line = script
End Function
Function Insert_Line(script, lineSrc, linePos)
'********************************************************************
'Verify that the first argument contains a string array
If Not IsArray(script) Then
Err.Raise E_SCRIPT_TABLE, "Insert_Line", "Script should be string array"
End If
scrLen = UBound(script) - LBound(script)
If (scrLen = 0 And linePos <> 0) Or (linePos > scrLen + 1) Then
Insert_Line = script
Exit Function
End If
newScript = Split(String(scrLen + 1, " "), " ")
shiftIndex = 0
For I = 0 To scrLen + 1
If linePos = I Then
newScript(I) = lineSrc
shiftIndex = 1
Else
newScript(I) = script(I + shiftIndex)
End If
Next
Insert_Line = newScript
End Function
Function Delete_Line(script, linePos)
'********************************************************************
'Verify that the first argument contains a string array
If Not IsArray(script) Then
Err.Raise E_SCRIPT_TABLE, "Delete_Line", "Script should be string array"
End If
scrLen = UBound(script) - LBound(script)
If (scrLen = 0) Or (linePos > scrLen) Then
Insert_Line = script
Exit Function
End If
If scrLen = 1 Then
Delete_Line = Array()
Exit Function
End If
newScript = Split(String(scrLen - 1, " "), " ")
shiftIndex = 0
For I = 0 To scrLen
If linePos = I Then
shiftIndex = 1
Else
newScript(I - shiftIndex) = script(I)
End If
Next
Delete_Line = newScript
End Function
Public Function Move_CallAction(script, actName, newPos)
curPos = Find_Line(script, Array("RunAction", """" & actName & """"))
Move_CallAction = Move_Line(script, curPos, newPos)
End Function
إرسال تعليق