For an explanation of this example, see Understanding the Code Example.
| Example Title |
Copy Code
|
|---|---|
Private Sub RunSetupDemo_Click()
Dim TreeMgr As TreeManager
Dim oRoot As SubjectNode, folder As SubjectNode
'tdc is a TDConnection after logon to a project.
Set TreeMgr = tdc.TreeManager
Set oRoot = TreeMgr.TreeRoot("Subject")
Set folder = oRoot.AddNode("newFolder1")
Dim rFac As QCResourceFolderFactory
Set rFac = tdc.QCResourceFolderFactory
Dim rF As QCResourceFolder
Set rF = rFac.Root
ERIDemo folder, rF
End Sub
Sub ERIDemo(testFolder As SubjectNode, _
resourceFolder As QCResourceFolder)
Dim testFac As TestFactory
Set testFac = testFolder.TestFactory
' Create test QueryAvailability.
Dim QueryAvailability As Test
Set QueryAvailability = testFac.AddItem("QueryAvailability")
QueryAvailability.Type = "MYTYPE"
QueryAvailability.Post
' Create test IssueTicket.
Dim IssueTicket As Test
Set IssueTicket = testFac.AddItem("IssueTicket")
IssueTicket.Type = "MYTYPE"
IssueTicket.Post
' Create user assets representing the subunits
' (TestActions)of test IssueTicket.
Dim userAsset1 As userAsset
Dim userAsset2 As userAsset
Set userAsset1 = _
CreateUserAsset _
(IssueTicket, "Authenticate", "Subunit 1 of IssueTicket")
Set userAsset2 = _
CreateUserAsset _
(IssueTicket, "LaunchJob", "Subunit 2 of IssueTicket")
' Create asset repository items representing the subunits' files.
Dim ari1 As AssetRepositoryItem
Dim ari2 As AssetRepositoryItem
Set ari1 = CreateARI(userAsset1, "AuthenticateFiles", 1)
Set ari2 = CreateARI(userAsset2, "LaunchJobFiles", 1)
' Upload the files for the asset repository items to the
' project repository.
' Because the files are part of a test, we must use the
' test's ExtendedStorage object to perform the upload.
Dim extStorage As ExtendedStorage
Set extStorage = IssueTicket.ExtendedStorage
extStorage.ClientPath = "C:\temp"
extStorage.Save "AuthenticateFiles, LaunchJobFiles", True
' Link test QueryAvailability to subunit Authenticate of test IssueTicket.
' The relation has no condition because it is relevant for all
' types of download.
Dim relation1 As AssetRelation
Set relation1 = _
CreateAssetRelation(QueryAvailability, _
userAsset1.ID, _
"USER_ASSETS", 1, "")
' Create a resource to hold the run-time library.
Dim resourceFactory As QCResourceFactory
Dim resource As QCResource
Set resourceFactory = resourceFolder.QCResourceFactory
Set resource = _
resourceFactory.AddItem _
("Resource for running QueryAvailability")
resource.ResourceType = "MYTYPE test RTL"
resource.Post
' Upload the resource file.
Dim resourceStorage As IResourceStorage
resource.FileName = "rtl.dll"
resource.Post
Set resourceStorage = resource
resourceStorage.UploadResource "C:\temp", True
' Create the relation to the resource from QueryAvailability.
' The resource is needed only when running the test,
' and not when editing it, so
' we add a condition 'RUN' to the relation.
Dim relation2 As AssetRelation
Set relation2 = CreateAssetRelation _
(QueryAvailability, resource.ID, _
"RESOURCES", 2, "RUN")
End Sub
Function CreateAssetRelation _
(owner As IBaseField, _
relatedId As Integer, _
relatedType As String, _
iOrder As Integer, _
condition As String) As AssetRelation
' Creates an asset relation with a specified order and
' condition between two given entities.
Dim supportRelations As ISupportAssetRelations
Dim relationFactory As AssetRelationFactory
Dim relation As AssetRelation
Set supportRelations = owner
Set relationFactory = supportRelations.AssetRelationFactory
Set relation = relationFactory.AddItem(Null)
' The related ID and related type define uniquely the related entity.
' The related type should be the table name of one of the entities
' that supports relations.
relation.Field("ASR_RELATED_ID") = relatedId
relation.Field("ASR_RELATED_TYPE") = relatedType
relation.Field("ASR_ORDER") = iOrder
' The condition field is optional.
' If it is not defined, a relation is always used when downloading.
If condition <> "" Then relation.Field("ASR_CONDITION") = condition
relation.Post
Set CreateAssetRelation = relation
End Function
Function CreateARI _
(owner As IBaseField, sPath As String, iFilter As Integer) _
As AssetRepositoryItem
' Creates an asset repository item with a specified path
' and filter and owned by a given entity.
Dim supportAri As ISupportAssetRepositoryItems
Dim ariFactory As AssetRepositoryItemFactory
Dim ari As AssetRepositoryItem
Set supportAri = owner
Set ariFactory = supportAri.AssetRepositoryItemFactory
Set ari = ariFactory.AddItem(Null)
ari.Field("ARI_PATH") = sPath
ari.Field("ARI_FILTER") = iFilter
ari.Post
Set CreateARI = ari
End Function
Function CreateUserAsset _
(owner As IBaseField, _
name As String, _
Descript As String) As userAsset
' Creates a user asset with a specified name and
' description and owned by a given entity.
Dim supportAssets As ISupportAssets
Dim userAssetFactory As userAssetFactory
Dim userAsset As userAsset
Set supportAssets = owner
Set userAssetFactory = supportAssets.userAssetFactory
Set userAsset = userAssetFactory.AddItem(Null)
userAsset.Field("UAS_NAME") = name
userAsset.Field("UAS_DESC") = Descript
userAsset.Field("UAS_DISPLAY_TYPE") = "Test"
userAsset.Post
Set CreateUserAsset = userAsset
End Function
|
|