Automatic TestSet Execution via Script

 

User's Requirement

 

Need to execute a QTP TestSet without using Quality Center GUI

 

 

Proposal Solution

 

The solution is to have a script that accepts 2 input parameters that are:

  • Path TestLab
  • TestSet Name

 

Once the connection to QC has been done, through interaction with the user, selection of Domain and Project from combo, etc, it will be launch the execution of the TestSet on a Remote Machine.


 

 

_________________________________________________________________________

 

Script Implementation

 

Considerations:

this would be only an example, a case study, on how to work and manage with the TSScheduler OTA Object.

I think this type of implementation could have sense only in particular context, those whom who execs the testset doesn't know anything about Quality Center, how to move inside it and doesn't have any permission to access it (user and password could be retrieve from somewhere else instead of how has been developed here).

 

 

How this script works.

The script has been written starting from the example found in the OTA help for the TSScheduler object description and remanaged.

 

This script must be launched from DOS Command Prompt passing 2 parameters that rappresents the Path and the TestSet Name.

In the case the 2 parameters have some spaces those strings must be written between the char " .

For example: myScript.vbs "Root\Fld1\Sub Folder1_1\Other Folder" "My TestSet"

 

This is the code:

 

'This version consists on call the script passing 2 parameters that are:
'
' - Path TestLab (where the TestSet is located)
' - TestSet Name


'*******************************************************

'Constants to set where to run the entire TestSet or the single TSTest
'*******************************************************

Const RUN_LOCAL  = 0
Const RUN_REMOTE = 2
Const RUN_PLANNED_HOST = 8
Const REMOTE_MACHINE = "REMOTE.MACHINE.ON.SOME.DOMAIN"


'Constants for log file.
'*******************************************************

Const PathLogFile = "d:\LogSched\"   'The location of the file is out of scope
Const LogFile = "logSched.txt"          'for this task.
Const FOR_WRITING = 2

'*******************************************************

'Variables
'*******************************************************

Dim tdc, fso, fOut
Dim QC_ADDRESS
Dim DOMAIN
Dim PROJECT
Dim USER
Dim PASSWORD

Dim PathTestLab

Dim TestSetName
'*******************************************************

 

'*******************************************************

'*******************************************************
'            M  A  I  N

'*******************************************************

'*******************************************************

'Check the Arguments passed to the script

if wscript.arguments.count <> 2 then
 Msgbox "Arguments Number Error! I need 2 informations: " & vbNewLine & _
     "- TestSet Folder" & vbNewLine & _
     "- TestSet Name" & vbNewLine & vbNewLine & _
     "Thank you. End of Program", vbCritical + vbSystemModal, "Arguments Error!!!"
 wscript.quit   
end if

PathTestLab = wscript.Arguments(0)
TestSetName = wscript.Arguments(1)

 

'Log File
set fso = CreateObject("Scripting.FileSystemObject")
if Not(fso.FolderExists(PathLogFile)) then
 msgbox "Log Path " & PathLogFile & " Not Found! End of Program!!", vbSystemModal + vbCritical, "Log Path Error!"
 set fso = nothing
 wscript.quit
end if

set fOut = fso.OpenTextFile(PathLogFile & LogFile, FOR_WRITING, True)

fOut.WriteLine "Date/Hour: " & Now & " - Start TestSet Execution Procedure"  & vbNewLine & vbNewLine
 

'Create the TDConnection Object

set tdc = CreateObject("tdapiole80.tdconnection.1")


'    Ask user for QC Coordinates
QC_ADDRESS = ""
USER = ""
PASSWORD = ""
QC_ADDRESS = InputBox("Insert the QC Site in th form http://qcaddress/qcbin", "QC Address", "http://10.10.10.10/qcbin")
if QC_ADDRESS = "" then
 set tdc = Nothing
 fOut.Close
 set fOut = Nothing
 set fso = Nothing
 wscript.quit
end if

'   Retrieve User Credential
Dim strUC
strUC = getUserInfo     

'getUserInfo returns a string

'if it contains the sequence of chars "@||@" it means that user infos have been correctly retrieved.

if instr(strUC,"@||@") = 0 then
 set tdc = Nothing
 fOut.Close
 set fOut = Nothing
 set fso = Nothing
 wscript.quit
end if

USER = split(strUC,"@||@")(0)

'next if because many times no password is set.
if right(strUC,4) <> "@||@" then
 PASSWORD = split(strUC,"@||@")(1)
end if

'Try to estabilished the Connection to QC Project. If it's ok, do the RunTestSet!
if QCConnect(QC_ADDRESS, USER, PASSWORD) then

 'Call the Sub to Run the TestSet on Remote Machine
 RunTestSet PathTestLab, TestSetName, REMOTE_MACHINE, RUN_REMOTE
 
 else
 
    fOut.WriteLine "Date/Hour: " & Now & " - QC Connection Error"
   
end if

if tdc.Connected then
 tdc.Disconnect
end if


fOut.WriteLine "Date/Hour: " & Now & " - END of PROGRAM"
fOut.close

set tdc = nothing
set fOut = nothing
set fso = nothing

MSGBOX "END OF PROGRAM", vbSystemModal + vbInformation, "End Program"
wscript.quit

'*******************************************************

'*******************************************************
'       E  N  D     M  A  I  N

'*******************************************************

'*******************************************************

 

 

'*******************************************************   
'            F U N C T I O N S

'*******************************************************

'Function to Retrieve UserInfo
Public Function getUserInfo()
'   Creation of the form to insert user and password
' Create an IE object

Dim res
res = ""

Set objIE = CreateObject( "InternetExplorer.Application" )
' specify some of the IE window's settings
objIE.Navigate "about:blank"
objIE.Document.title = "User and Password" & String( 80, "=" )
objIE.ToolBar        = False
objIE.Resizable      = False
objIE.StatusBar      = False
objIE.Width          = 400
objIE.Height         = 240
' Center the dialog window on the screen
With objIE.Document.parentWindow.screen
     objIE.Left = (.availWidth  - objIE.Width ) \ 2
     objIE.Top  = (.availHeight - objIE.Height) \ 2
End With
' Wait till IE is ready
Do While objIE.Busy
    WScript.Sleep 200
Loop
' Insert the HTML code to prompt for user input
objIE.Document.body.innerHTML = "<div align=""center""><table cellspacing=""5"">" _
                                  & "<tr nowrap><th colspan=""2"">Insert User and Password " _
                                  & ":</th></tr><tr nowrap><td>User :" _
                                  & "</td><td><input type=""text"" size=""20"" id=" _
                                  & """User""></td></tr><tr nowrap><td>Password :" _
                                  & "</td><td><input type=""password"" size=""20"" id=" _
                                  & """Password""></td></tr></table>" _
                                  & "<p><input type=""hidden"" id=""OK"" name=""OK"" " _
                                  & "value=""0""><input type=""submit"" value="" OK "" " _
                                  & "onclick=""VBScript:OK.value=1""></p></div>"
' Hide the scrollbars
objIE.Document.body.style.overflow = "auto"
' Make the window visible
objIE.Visible = True
' Set focus on User input field
objIE.Document.all.User.focus
 
' Wait till the OK button has been clicked
On Error Resume Next
Do While objIE.Document.all.OK.value = 0
    WScript.Sleep 200
 
    If Err Then    'user clicked red X (or alt-F4) to close IE window     
    exit do
    End if
 
Loop

 
' Read the user input from the dialog window
if not(Err) then
 res = objIE.Document.all.User.value & "@||@" & objIE.Document.all.Password.value
end if
 
'Close and release the object
objIE.Quit
Set objIE = Nothing
 

getUserInfo = res

On Error Goto 0

End Function

 

'Boolean Function that Check the Connection to the Project.
Public Function QCConnect(addr, usr, pwd)
Dim Res, dom, prj
Res = True

On Error Resume Next
tdc.InitConnectionEx addr
if err.number <> 0 then
 Res = False
 msgbox "QC Error in method InitConnectionEx", vbSystemModal + vbCritical, "InitConnectionEx ERROR!!!!"
end if

if Res then
 err.clear
 tdc.login usr, pwd
 if err.number <> 0 then
  Res = False
  msgbox "QC Error in method Login", vbSystemModal + vbCritical, "Login ERROR!!!!"
 end if
end if

strDomAndPrj = getDomPrjInfo   'call the function to retrieve Domain and Project Selections

if instr(strDomAndPrj, "@||@") > 0 then
 dom = split(strDomAndPrj,"@||@")(0)
 prj = split(strDomAndPrj,"@||@")(1)
 
 if Res then
  err.clear
  tdc.Connect dom, prj
  if err.number <> 0 then
   Res = False
   msgbox "QC Error in method Connect, check the Domain, Project and if user " & usr & " is allowed to the Project", vbSystemModal + vbCritical, "Connect ERROR!!!!"
  end if
 end if
 else
    Res = False
end if

QCConnect = Res
On error Goto 0

End Function


'Function that retrieve the Domain and Project Selection 
Public Function getDomPrjInfo
Dim Res
Res = ""

set DomLst = tdc.VisibleDomains
optDomStr = ""
if DomLst.Count > 0 then
  for each dm in DomLst
 optDomStr = optDomStr & " <option value=" & chr(34) & dm & chr(34) & ">" & dm & "</option> " & vbNewLine
  next
end if
set DomLst = Nothing

optPrjStr = ""

' Form to select Domain and Project
' Create an IE object
Set objIE = CreateObject( "InternetExplorer.Application" )
' specify some of the IE window's settings
objIE.Navigate "about:blank"
objIE.Document.title = "Domain and Project" & String( 80, "=" )
objIE.ToolBar        = False
objIE.Resizable      = False
objIE.StatusBar      = False
objIE.Width          = 400
objIE.Height         = 240
' Center the dialog window on the screen
With objIE.Document.parentWindow.screen
     objIE.Left = (.availWidth  - objIE.Width ) \ 2
     objIE.Top  = (.availHeight - objIE.Height) \ 2
End With
' Wait till IE is ready
Do While objIE.Busy
    WScript.Sleep 200
Loop
' Insert the HTML code to prompt for user input
objIE.Document.body.innerHTML = "<div align=""center""><table cellspacing=""5"">" _
                                  & "<tr nowrap><th colspan=""2"">Select Domain and Project " _
                                  & ":</th></tr>" _        
          & "<label>Domain:<br>" _
          & "<select name=""Domain""> " _
          & optDomStr _
          & "</select> " _         
          & "</label></br>" _                   
          & "</table>" _        
                                  & "<p><input type=""hidden"" id=""OK"" name=""OK"" " _
                                  & "value=""0""><input type=""submit"" value="" OK "" " _
                                  & "onclick=""VBScript:OK.value=1""></p></div>"
' Hide the scrollbars
objIE.Document.body.style.overflow = "auto"
' Make the window visible
objIE.Visible = True
' Set focus on Domain input field
objIE.Document.all.Domain.focus
 
' Wait till the OK button has been clicked
Do While objIE.Document.all.OK.value = 0
    WScript.Sleep 200
 If Err Then    'user clicked red X (or alt-F4) to close IE window     
    exit do
    End if
Loop
 
if Not(Err) then
 ' Read the user input from the dialog window
 Res = objIE.Document.all.Domain.Value
 set PrjLst = tdc.VisibleProjects(Res)
 optPrjStr = ""
 for each pj in PrjLst
  optPrjStr = optPrjStr & " <option value=" & chr(34) & pj & chr(34) & ">" & pj & "</option> " & vbNewLine
 next

 ' Insert the HTML code to prompt for user input
 objIE.Document.body.innerHTML = "<div align=""center""><table cellspacing=""5"">" _
           & "<tr nowrap><th colspan=""2"">Select Domain and Project " _
           & ":</th></tr>" _        
           & "<label>Domain: " & Res & " <br>" _              
           & "</label></br>" _                   
           & "<label>Project:<br>" _
           & "<select name=""Project"" > " _
           & optPrjStr _
           & "</select> " _         
           & "</label></br>" _
           & "</table>" _        
           & "<p><input type=""hidden"" id=""OK"" name=""OK"" " _
           & "value=""0""><input type=""submit"" value="" OK "" " _
           & "onclick=""VBScript:OK.value=1""></p></div>"


 ' Hide the scrollbars
 objIE.Document.body.style.overflow = "auto"
 ' Make the window visible
 objIE.Visible = True
 ' Set focus on Project input field
 objIE.Document.all.Project.focus

 ' Wait till the OK button has been clicked
 Do While objIE.Document.all.OK.value = 0
  WScript.Sleep 200
  If Err Then    'user clicked red X (or alt-F4) to close IE window     
   exit do
  End if
 Loop
  
 ' Read the user input from the dialog window
 if Not(Err) then
  Res = Res & "@||@" & objIE.Document.all.Project.Value
 end if
end if

'Close and release the object
objIE.Quit
Set objIE = Nothing

getDomPrjInfo = Res

End Function

 

'This Sub is take from the example on OTA API TSScheduler Object description 
Public Sub RunTestSet(tsFolderName, tSetName, _
           HostName, runWhere)

' This example show how to run a test set in three different ways:
' * Run all tests on the local machine (where this code runs).
' * Run the tests on a specified remote machine.
' * Run the tests on the hosts as planned in the test set.
    Dim TSetFact 'As TestSetFactory
 Dim tsList 'As List
    Dim theTestSet 'As TestSet
    Dim tsTreeMgr 'As TestSetTreeManager
    Dim tsFolder 'As TestSetFolder
    Dim Scheduler 'As TSScheduler
    Dim execStatus 'As ExecutionStatus

 
 On Error Resume Next    'my code
 
    'On Error GoTo RunTestSetErr
    'errmsg = "RunTestSet"
 
 ' Get the test set tree manager from the test set factory.
    'tdc is the global TDConnection object.
    Set TSetFact = tdc.TestSetFactory
    Set tsTreeMgr = tdc.TestSetTreeManager
 
 ' Get the test set folder passed as an argument to the example code.  
 'Dim nPath$
    'nPath = "Root\" & Trim(tsFolderName)
 '===> In this script the path has been passed as the 1st argument so nPath will be set directly to tsFolderName
 Dim nPath
 nPath = tsFolderName
 
  
 err.clear   'my add
    Set tsFolder = tsTreeMgr.NodeByPath(nPath)
 
 'my code
 if err.number <> 0 then
  msgbox "Error during the creation of the SysTreeNode for the path " & nPath, vbSystemModal + vbCritical, "QC Critical Error - Cannot Continue!!!"
  exit sub
 end if
  
 'If tsFolder Is Nothing Then
    '    err.Raise vbObjectError + 1, "RunTestSet", "Could not find folder " & nPath
    '    GoTo RunTestSetErr
    'End If
    'On Error GoTo RunTestSetErr
 
 ' Search for the test set passed as second argument to the example code.
    Set tsList = tsFolder.FindTestSets(tSetName)
 
 'I prefer the "Select case" statement instead of innested if
 Select case tsList.Count
   case 0: fOut.WriteLine "Date/Hour: " & Now & " -  TestSet " & tSetName & " not found under " & nPath & " !!!"
     exit Sub
   case 1: set theTestSet = tsList.Item(1)
   case else: fOut.WriteLine "Date/Hour: " & Now & " - Found more than one TestSet with the name & " & tSetName & " under " & nPath & " !!!"
        exit Sub
 End Select
    'If tsList.Count > 1 Then
    '    MsgBox "FindTestSets found more than one test set: refine search"
    'ElseIf tsList.Count < 1 Then
    '    MsgBox "FindTestSets: test set not found"
    'End If
    'Set theTestSet = tsList.Item(1)
    'Debug.Print theTestSet.ID

 

  '*******************************************************
  '      Start the scheduler on the local machine.

  '*******************************************************
    Set Scheduler = theTestSet.StartExecution("")

 'Set up for the run depending on where the test instances
 'are to execute.

    Select Case runWhere

        Case RUN_LOCAL
   ' Run all tests on the local machine.
            Scheduler.RunAllLocally = True
        Case RUN_REMOTE
   ' Run tests on a specified remote machine.
   ' ===> This set the HostName for the Scheduler Object <===
            Scheduler.TdHostName = HostName
            ' RunAllLocally must not be set for
            ' remote invocation of tests.
            ' Do not do this:
            ' Scheduler.RunAllLocally = False
        Case RUN_PLANNED_HOST
   ' Run on the hosts as planned in the test set.
            Dim TSTestFact 'As TSTestFactory
   Dim testList 'As List
            Dim tsFilter 'As TDFilter
            Dim TSTst 'As TSTest
   ' Get the test instances from the test set.
            Set TSTestFact = theTestSet.TSTestFactory
            Set tsFilter = TSTestFact.Filter
            tsFilter.Filter("TC_CYCLE_ID") = theTestSet.ID
            Set testList = TSTestFact.NewList(tsFilter.Text)
            'Debug.Print "Test instances and planned hosts:"
   ' For each test instance, set the host to run depending
   ' on the planning in the test set.
   ' It retrieves the HostName indicating into the TestInstance
            For Each TSTst In testList
                'Debug.Print "Name: " & TSTst.Name & " ID: " & TSTst.ID & " Planned Host: " & TSTst.HostName
                Scheduler.RunOnHost(TSTst.ID) = TSTst.HostName
            Next

            Scheduler.RunAllLocally = False
  
    End Select

 ' Run the tests.
 ' This is the same as RunTestSet
    Scheduler.Run

  '*******************************************************

  '     Get the execution status object.

  '*******************************************************
     Set execStatus = Scheduler.ExecutionStatus
 
 ' Track the events and statuses.
    Dim RunFinished 'As Boolean,
 Dim iter 'As Integer,   'I think this is not necessary
 Dim i 'As Integer
    Dim ExecEventInfoObj 'As ExecEventInfo,
 Dim EventsList 'As List
    Dim TestExecStatusObj 'As TestExecStatus
 
    'While ((RunFinished = False) And (iter < 100))
 Do While Not(RunFinished) '===> Change in a Do While statement
        'iter = iter + 1
        execStatus.RefreshExecStatusInfo "all", True   '===> Force the Refresh of all the test status!
        RunFinished = execStatus.Finished      '===> Checks if execution is finished or still in progress
        Set EventsList = execStatus.EventsList     '===> Retrieve the List of Execution Events that are ExecEventInfo Objects

        For Each ExecEventInfoObj In EventsList
            fOut.WriteLine "Event: " & ExecEventInfoObj.EventDate & " " & ExecEventInfoObj.EventTime & " " & vbNewLine & _
                    "Event Type: " & ExecEventInfoObj.EventType & vbNewLine & _
     "[Event types: 1-fail, 2-finished, 3-env fail, 4-timeout, 5-manual]"
        Next

        'Debug.Print Tab; execStatus.Count & " exec status"
        For i = 1 To execStatus.Count
            Set TestExecStatusObj = execStatus.Item(i)
            fOut.WriteLine "Date/Hour: " & Now & " - Status: " & vbNewLine & _
                        "Test ID (the ID of the Test in TestPlan):   " & TestExecStatusObj.TestID & vbNewLine & _
      "Test instance (the ID of the TestInstance): " & TestExecStatusObj.TSTestID & " " & vbNewLine & _
                        "Order:                                      " & TestExecStatusObj.TestInstance & vbNewLine & _                      
                        "Message:                                    " & TestExecStatusObj.Message & vbNewLine & _
      "Status:                                     " & TestExecStatusObj.Status & vbNewLine & _
      "=====================================================" & vbNewLine
        Next 'i
 
  'This part is for visualbasic code
        'Sleep() has to be declared before it can be used.
        'This is the module level declaration of Sleep():
        'Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
        'Sleep (5000)
 
  Wscript.Sleep (60000)  'wait 1 minute before next iteration.
   
 Loop
 'Wend 'Loop While execStatus.Finished = False

    'Debug.Print "Scheduler finished around " & CStr(Now)
    'Debug.Print

 On error Goto 0
 
'RunTestSetErr:
'    ErrHandler err, err.Description, errmsg, NON_FATAL_ERROR
End Sub
'*******************************************************

 

_______________________________________________________________________

 

Pag: <<    <