QC对VBScript的使用.doc

通过OTA调度执行QC的TestSet参考：Executing QC TestSet via OTA API (QCRunTestSet)/executing-qc-testset-via-ota-api-qcruntestset/VBS代码实现如下：VBScript DocumentOption ExplicitQC ParamtersDim Server, UserName, Password, QCDomain, QCProject, QCTestSetPath, QCTestSetNameServer = http:/:8080/qcbin/UserName = john.smithPassword = passwordQCDomain = DEFAULTQCProject = theProjectQCTestSetPath = RootTestSetFolderQCTestSetName = Daily Regression Loads an instance of QCRunTestSet and initiates the scheduling controller QC Server Domain name Project name Path to the TestSet (RootFolderNameSubFolderName) Name of the test set Public Sub RunTestSet(Server, UserName, Password, QCDomain, QCProject, QCTestSetPath, QCTestSetName)Dim QCTestSetExec, sErr, arrArgs, ix, argsErr = Unable to execute RunTestSet. Please provide the arrArgs = Array(Server, UserName, Password, QCDomain, QCProject, QCTestSetPath, QCTestSetName)For ix = LBound(arrArgs) To UBound(arrArgs)Execute arg = & arrArgs(ix)If arg = ThenMsgBox sErr & arrArgs(ix) & ., vbOkOnly, Error!End IfNextSet QCTestSetExec = New QCRunTestSetWith QCTestSetExec.Server = Server.UserName = UserName.Password = Password.QCDomain = QCDomain.QCProject = QCProject.QCTestSetPath = QCTestSetPath.QCTestSetName = QCTestSetName.RunEnd WithSet QCTestSetExec = NothingEnd Sub Class QCRunTestSetPublic Variables QC Server URL (string) Public Server UserName (string) Public UserName Password (string) Public Password Quality Center Domain (string) Public QCDomain QC Project (string) Public QCProject QC TestSet Folder Path (string) RootTestSetFolderTestSetSubFolderPublic QCTestSetPath Target TestSet Name (string) Public QCTestSetName Recipient list from QCs Automation tab Public EMailTo TSTestFactory manages test instances (TSTest objects) in a test set Public TSTestFactory Number of blocked tests after completion of scheduler (integer) Public iBlocked Number of failed tests after completion of scheduler (integer) Public iFailed Number of N/A tests after completion of scheduler (integer) Public iNA Number of NoRun tests after completion of scheduler (integer) Public iNoRun Number of NotCompleted tests after completion of scheduler (integer) Public iNotCompleted Number of Passed tests after completion of scheduler (integer) Public iPassed DateTime stamp at the start of the Scheduling session (DateTime) Public dtStartTimePrivate Variables QuickTest.Application object Private qtApp TDApiOle object Private TDConnection TSScheduler object returned by the StartExecution method Private TSScheduler TestSet Folder object Private TSFolder Executes the scheduler Public Default Sub Run()Dim bStatus, dtStartTimesee isQCConnected()bStatus = isQCConnectedsee isQTPInstalled()If bStatus Then bStatus = isQTPInstalledIf Not bStatus Then Exit SubDim TSTreeManager, QCTestSetPath, TSList, QCTestSetName, TestSet, qtTest, sEnvironment, TSReport, EMailTo, ExecutionStatusTestSetTreeManager manages the test set tree and its related test set foldersSet TSTreeManager = TDConnection.TestSetTreeManagerQCTestSetPath = Me.QCTestSetPathReturn the test set tree node from the specified tree pathSet TSFolder = TSTreeManager.NodeByPath(QCTestSetPath)QCTestSetName = Me.QCTestSetNameReturns the list of test sets contained in the folder that match the specified pattern. Set TSList = TSFolder.FindTestSets(QCTestSetName)If TSList.Count = 0 ThenMsgBox The TestSet & QCTestSetName & was not found., vbOkOnly, TSFolder.FindTestSets Exception!Exit SubEnd IfFor Each TestSet in TSListIf LCase(TestSet.Name) = LCase(QCTestSetName) ThenExit ForEnd IfNextThis enables database to update immediately when the field value changesTestSet.AutoPost = TrueTSTestFactory manages test instances (TSTest objects) in a test setSet TSTestFactory = TestSet.TSTestFactorySet Me.TSTestFactory = TSTestFactoryTSTestFactory.NewList() creates a list of objects according to the specified filterFor Each qtTest in TSTestFactory.NewList()Change test status to N/AWe do this to ensure all tests have not run before starting executionIf the execution errors out, we can keep track of the tests that were not runqtTest.Field(TC_STATUS) = N/AqtTest.PostNextRefresh TS and TSFolderTestSet.Refresh : TSFolder.RefreshTSReport represents the execution report settings for the current test setSet TSReport = TestSet.ExecutionReportSettingsTSReport.Enabled = TrueThis retrieves the EMail list from the recipients list from QCEMailTo = TSReport.EMailTo : Me.EMailTo = EMailToOn Error Resume NextTestSet.StartExecution returns the TSScheduler object and starts the Execution controllerSet TSScheduler = TestSet.StartExecution()If Err.Number 0 ThenMsgBox Err.Description & vbNewLine & vbNewLine & Unable to create the TSScheduler & _object. Please ensure the ALM Client Registration is complete before & _executing RunTestSet., vbOkOnly, RunTestSet.Run-TSScheduler Exception!On Error Goto 0Exit SubEnd IfOn Error Goto 0Run all tests on localhostTSScheduler.RunAllLocally = TrueLogging enabledTSScheduler.LogEnabled = TruedtStartTime = Now : Me.dtStartTime = dtStartTimeStart testSet runTSScheduler.RunExecutionStatus represents the execution status of the schedulerSet ExecutionStatus = TSScheduler.ExecutionStatusWait until all tests are complete runningWaitWhileTestRunning ExecutionStatusSet ExecutionStatus = NothingEnd SubPrivate Methods Loops and retrieves Schedulers Finished property until all tests have completed running Private Sub WaitWhileTestRunning(ByVal ExecutionStatus)Dim RunFinished: RunFinished = FalseWhile RunFinished = FalseExecutionStatus.RefreshExecStatusInfo all, TrueRunFinished = ExecutionStatus.FinishedWScript.Sleep(60000)WendEnd Sub Returns true if QC Connection was successful with the supplied input Private Function isQCConnected()isQCConnected = FalseDim UserName, PasswordUserName = Me.UserNamePassword = Me.PasswordOn Error Resume NextSet TDConnection = CreateObject(TDApiOle80.TDConnection)If Err.Number 0 ThenMsgBox Unable to create an instance of the TestDirector API & _OLE (TestDirector Connection) Object., vbOkOnly, TDConnection Exception!Err.Clear : Exit FunctionEnd IfWith TDConnectionCreate a connection with the QC Server.InitConnectionEx ServerIf Err.Number 0 ThenMsgBox Err.Description, vbOkOnly, TDConnection.InitConnectionEx Exception!Exit FunctionEnd IfLogin to QC.Login UserName, PasswordIf Err.Number 0 ThenMsgBox Err.Description, vbOkOnly, TDConnection.Login Exception!Exit FunctionElseIf Not .LoggedIn ThenMsgBox Unable to login to Quality Center. Please verify your login & _credentials., vbOkOnly, TDConnection.Login Exception!Exit FunctionEnd IfConnect to QC Project.Connect QCDomain, QCProjectIf Err.Number 0 ThenMsgBox Err.Description, vbOkOnly, TDConnection.Connect Exception!Exit FunctionElseIf Not .ProjectConnected ThenMsgBox Unable to connect to & QCDomain & / & QCProject & ., vbOkOnly, _TDConnection.Connect Exception! Exit FunctionEnd IfisQCConnected = TrueEnd WithOn Error Goto 0End Function Returns true if QTP is installed on the target machine Private Function isQTPInstalled()isQTPInstalled = FalseOn Error Resume NextSet qtApp = GetObject(, QuickTest.Application)If Err.Number 0 ThenMsgBox Err.Description, vbOkOnly, QuickTest.Application Exception!Exit FunctionElseqtApp.Launch()qtApp.Visible = TrueisQTPInstalled = TrueEnd IfOn Error Goto 0End Function Returns a HTML log of all tests from the executed TestSet This HTML is exactly the HTML that is used by Quality Center * please change it as per your needs Private Function get_TSExecutionLog()Dim color, style, TSTestFactory, TSList, ix, html, sTest, sStatus, sTester, sActualTester, dtDate, dtExecTimecolor = green;redcolor = 46D44B;D41743default html stylestyle = font-size: 11px; padding-right: 5px; padding-left: 5px; height: 20px; border-bottom: 1px solid #eee;Set TSTestFactory = Me.TSTestFactorySet TSList = TSTestFactory.NewList()Loop through all tests in the TestSet list and retrieve their statusFor ix = 1 To TSList.Counthtml = html & Test Namehtml = html & & TSList.item(ix).field(TSC_NAME) & StatussStatus = TSList.item(ix).field(TS_EXEC_STATUS)Select Case sStatusCase Passed: html = html & & sStatus & Case Failed: html = html & & sStatus & Case Else: html = html & & sStatus & End SelectTesterhtml = html & & TSList.item(ix).field(TC_TESTER_NAME) & Actual Testerhtml = html & & TSList.item(ix).field(TC_ACTUAL_TESTER) & DateTime stamphtml = html & & Date & Execution Timehtml = html & & TSList.item(ix).field(TC_EXEC_TIME) & html = html & /trNextget_TSExecutionLog = htmlEnd Function Returns the number of tests passed, failed and not completed Private Sub load_ExecutionRunStatus() Dim TSTestFactory, TSList, ix, iBlocked, iFailed, iNA, iNoRun, iNotCompleted, iPassedSet TSTestFactory = Me.TSTestFactory Set TSList = TSTestFactory.NewList()Loop through all tests in the testSet list and retrieve status For ix = 1 To TSList.Count Select Case LCase(TSList.item(ix).Field(TS_EXEC_STATUS) Case blocked : iBlocked = iBlocked + 1 Case failed : iFailed = iFailed + 1 Case n/a : iNA = iNA + 1 Case no run : iNoRun = iNoRun + 1 Case not completed : iNotCompleted = iNotCompleted + 1 Case passed : iPassed = iPassed + 1 End Select Next If iBlocked = Then iBlocked = 0 If iFailed = Then iFailed = 0 If iNA = Then iNA = 0 If iNoRun = Then iNoRun = 0 If iNotCompleted = Then iNotCompleted = 0 If iPassed = Then iPassed = 0 Me.iBlocked = iBlocked Me.iFailed = iFailed Me.iNA = iNA Me.iNoRun = iNoRun Me.iNotCompleted = iNotCompleted Me.iPassed = iPassedEnd Sub Sends an email to the distribution list Private Sub TDSendMail()Dim EMailTo : EMailTo = Me.EMailToDim QCTestSetName : QCTestSetName = Me.QCTestSetNameIf EMailTo = Then Exit Subload_ExecutionRunStatus()TDConnection.SendMail EMailTo, , Test Execution: & QCTestSetName, sHTMLEnd SubPrivate Properties This HTML is exactly the same HTML as used by Quality Center! Please modify it according to your needs Private Property Get sHTML()Dim Server : Server = Me.ServerDim QCTestSetName: QCTestSetName = Me.QCTestSetNameDim QCDomain: QCDomain = Me.QCDomainDim QCProject: QCProject = Me.QCProjectDim dtStartTime: dtStartTime = Me.dtStartTimeDim iBlocked: iBlocked = Me.iBlocked Dim iFailed: iFailed = Me.iFailed Dim iNA: iNA = Me.iNA Dim iNoRun: iNoRun = Me.iNoRun Dim iNotCompleted: iNotCompleted = Me.iNotCompleted Dim iPassed: iPassed = Me.iPassedsHTML = & _ & _ & _QC TestSet Execution - Custom Report & _ & _.textfont font-weight: normal; font-size: 12px; color: #000000; font-family: verdana, arial, helvetica, sans-serif & _.owner width:100%; border-right: #6d7683 1px solid; border-top: #6d7683 1px solid; border-left: #6d7683 1px solid; border-bottom: #6d7683 1px solid; background-color: #a3a9b1; padding-top: 3px; padding-left: 3px; padding-right: 3px; padding-bottom: 10px; & _.product color: white; font-size: 22px; font-family: Calibri, Arial, Helvetica, Geneva, Swiss, SunSans-Regular; background-color: #54658c; padding: 5px 10px; border-top: 5px solid #a9b2c5; border-right: 5px solid #a9b2c5; border-bottom: #293f6f; border-left: 5px solid #a9b2c5; & _.rest color: white; font-size: 24px; font-family: Calibri, Arial, Helvetica, Geneva, Swiss, SunSans-Regular; background-color: white; padding: 10px; border-right: 5px solid #a9b2c5; border-bottom: 5px solid #a9b2c5; border-