0

QCで約800の奇妙なテストを行っています。スクリプトを実行すると、テスト ラボのすべてのテスト ケースを実行して合格としてマークする vbscript があります。唯一の懸念は、スクリプトが常に最初のテストから指定した最後のテストまで実行を開始することです (たとえば、最初のテストから 700 番目のテストまで、または 1 番目のテストから 140 番目のテストまで)。500回目のテストから600回目、430回目のテストから450回目のテストなど、途中からスクリプトを実行できるようにコードを変更したいと考えています。コード内のすべての可能な値を編集しようとしましたが、役に立ちませんでした。誰かがそれをクラックするのを手伝ってくれますか?

投稿コード

Option Explicit

Dim j
Dim qcServer
Dim tdc
Dim testset
Dim TSetFact
Dim tsTreeMgr
Dim npath
Dim tsFolder
Dim tsList
Dim tSetName


qcServer = "http://testdirector.mot.com/qcbin"
'nPath = "Root\Execution\Build_1.0"
nPath = "Root\Execution\Build_1.0"
tSetName  = "Test Folder"


WScript.Echo qcserver

Set tdc = CreateObject("tdapiole80.tdconnection")

tdc.InitConnectionEx qcServer

tdc.Login "username", "password"

tdc.Connect "DEFAULT", "TEAMMate"

If tdc.ProjectConnected = True Then
WScript.Echo "Connected to the Project Columbus"
End If

WScript.Echo "Logged in ??"
WScript.Echo tdc.LoggedIn 
WScript.Echo "Connected ??"
WScript.Echo tdc.Connected 
WScript.Echo "Server name"
WScript.Echo tdc.ServerName 
WScript.Echo "Domain name"
WScript.Echo tdc.DomainName
WScript.Echo "Project name"
WScript.Echo tdc.ProjectName 
WScript.Echo "username"
WScript.Echo tdc.UserName 


Set TSetFact =  tdc.TestSetFactory
Set tsTreeMgr = tdc.TestSetTreeManager
Set tsFolder = tsTreeMgr.NodeByPath(nPath)

If tsFolder Is Nothing Then
WScript.Echo "Testset folder not found"
End If
WScript.Echo "Test set folder exists"

Set tsList = tsFolder.FindTestSets(tSetName)

If tsList Is Nothing Then
WScript.Echo "Testset not found"
End If

If tsList.Count > 1 Then
WScript.Echo "Multiple Testsets found with same name"
End If
If tsList.Count < 1 Then
WScript.Echo "Testset not found"
End If

WScript.Echo "Testset exists"
Set testset = tsList.Item(1)
WScript.Echo testSet.Name

Dim TSTestFact
Dim TestSetTestsList
Dim thetest



    Set TSTestFact = testSet.TSTestFactory
    Set TestSetTestsList = TSTestFact.NewList("")
    j = 0

    Dim sID
    Dim sName

    For Each thetest In TestSetTestsList
    j = j + 1 
    If j > 737 Then    **j > 737 indicates run up to 737th test in the test lab) **
    Exit For
    End If 
    'sID = thetest.ID
    sName = thetest.Name
    'WScript.Echo sID
    If j > 0 Then 
    WScript.Echo "testcase found for execution"
    Dim runName
    Dim RunF
    Dim theRun
    Dim runStepF
    Dim lst
    Dim Item
    Dim runtitle

    'Set runtitle = "Run"

    runName = thetest.ID
    Set RunF = thetest.RunFactory
    Set theRun = RunF.AddItem(runName)
    theRun.Status = "Passed"
    theRun.Post   

    theRun.CopyDesignSteps
    theRun.Post 

    Set runStepF = theRun.StepFactory
    Set lst = runStepF.NewList("")
    For Each Item In lst
     Item.Status = "Passed"
     Item.Post
    Next    
    End If     
    WScript.Echo sName
    Next

'Set ObjRun = QCUtil.CurrentRun
'Dim sf1 as StepFactory
'Dim s1 as step

'Set sf1 = ObjRun.StepFactory
'Set s1 = sf1.NewList("")

'For i = 1 To s1.count
's1.Item(i).Field("ST_EXPECTED") = "Your Expected"
's1.Item(i).Field("ST_ACTUAL") = "Your Actual"

'Next

's1.Post

'Disconnect
If tdc.Connected Then
tdc.Disconnect
WScript.Echo "Disconnected QC session successfully"
End If

'Log off the server
If tdc.LoggedIn Then
tdc.Logout
WScript.Echo "Logged off from the Server successfully"
End If

'Release the TDConnection object.
tdc.ReleaseConnection
WScript.Echo "Released the connection"
'Check status
Set tdc = Nothing
4

1 に答える 1

1

このコードは、テスト ケース番号 737 以上で機能するはずです。また、役立つ可能性のある OTA リファレンスについては、Quality Center のヘルプを確認してください。Mercury Quality Centerオープン テスト アーキテクチャ API リファレンス(OTA_API_Reference.chm) とサイト管理 API リファレンス (Site_Admin_API_Reference.chm) の両方のファイルを、http://technologicaguru.blogspot.com.au/2008/03/quality-center から ダウンロードできます。 -open-test-architecture.html

自分で試したことがなくても、一見すると、コードの一部を次のように置き換えて、クエリするテスト ケース番号の下限と上限を指定することができます。 

Dim sID
Dim sName
Dim testCaseStart
Dim testCaseEnd
'Change testCaseStart and testCaseEnd to required test case range 
testStartVal = 500
testEndVal = 600

For Each thetest In TestSetTestsList
  If j >= testCaseStart And j <= testCaseEnd then 
    'sID = thetest.ID
    sName = thetest.Name
    'WScript.Echo sID
    If j > 0 Then 
      WScript.Echo "testcase found for execution"
      Dim runName
      Dim RunF
      Dim theRun
      Dim runStepF
      Dim lst
      Dim Item
      Dim runtitle

      'Set runtitle = "Run"

      runName = thetest.ID
      Set RunF = thetest.RunFactory
      Set theRun = RunF.AddItem(runName)
      theRun.Status = "Passed"
      theRun.Post   

      theRun.CopyDesignSteps
      theRun.Post 

      Set runStepF = theRun.StepFactory
      Set lst = runStepF.NewList("")
      For Each Item In lst
        Item.Status = "Passed"
        Item.Post
      Next    
    End If     
    WScript.Echo sName
  End If
  j = j + 1
Next
于 2012-09-24T07:51:32.367 に答える