code for QTP and ALM

 

'==========================================================================
' Name: connectALM
' Summary: connect to ALM
' Parameters:
' QCServer,QCUserName, QCPassword, QCDomain, QCProject: QC and user information
' Outputs:
' True or False
'==========================================================================
Function connectALM(QCServer,QCUserName, QCPassword, QCDomain, QCProject)

Set TDConnection = CreateObject("TDApiOle80.TDConnection")

With TDConnection
'Create a connection with the QC Server
.InitConnectionEx QCServer

'Login to QC
.Login QCUserName, QCPassword

'Connect to QC Project
.Connect QCDomain, QCProject

End With

If not isnull(TDConnection) Then

Reporter.ReportEvent micPass,"Connect to ALM", "Connected successfully."
connectALM = True
Else
Reporter.ReportEvent micFail,"Connect to ALM", "Connected failed."
connectALM = null
End If

End Function

'==========================================================================
' Name: disconnectALM
' Summary: disconnect ALM, release object
' Parameters:
' TDConnection:the object connecting ALM
' Outputs: none
'==========================================================================

Function disconnectALM(TDConnection)
TDConnection.DisconnectProject
TDConnection.ReleaseConnection

Set TDConnection = Nothing
End Function

 

'==========================================================================
' Name: checkTestSet
' Summary: check test set exist or not
' Parameters:
' TDConnection:the object connecting ALM
' QCTestSetPath, QCTestSetName: test set information
' Outputs:
' True or False
'==========================================================================
Function checkTestSet(TDConnection,QCTestSetPath, QCTestSetName)

Set TSTreeManager = TDConnection.TestSetTreeManager

'Return the test set tree node from the specified tree path
Set TSFolder = TSTreeManager.NodeByPath(QCTestSetPath)

'Returns the list of test sets contained in the folder that match the specified pattern.
Set TSList = TSFolder.FindTestSets(QCTestSetName)

If TSList.Count = 0 Then

Reporter.ReportEvent micFail,"Mark status in ALM", "No TestSet in the."& QCTestSetPath
checkTestSet = False
Else

isFound = False
For Each TestSet in TSList
If LCase(TestSet.Name) = LCase(QCTestSetName) Then
isFound = True
checkTestSet = True
Exit For
End If
Next

'if QCTestSetName was not found then exit.
If not isFound Then
Reporter.ReportEvent micFail,"Mark status in ALM", "TestSet "& QCTestSetName & " was not found."
checkTestSet = False
End If
End If

End Function

'==========================================================================
' Name: markCaseStatusonALM
' Summary: according to array of case name, mark corresponding status in the ALM
' Parameters:
' TDConnection:the object connecting ALM
' QCTestSetPath, QCTestSetName: test set information
' Outputs: none
'==========================================================================
Function markCaseStatusonALM(TDConnection,QCTestSetPath, QCTestSetName, arrCaseName, arrCaseStatus)

blnExist = checkTestSet(TDConnection,QCTestSetPath, QCTestSetName)

Set TSTreeManager = TDConnection.TestSetTreeManager

If blnExist Then
'This enables database to update immediately when the field value changes
TestSet.AutoPost = True
'TSTestFactory manages test instances (TSTest objects) in a test set
Set TSTestFactory = TestSet.TSTestFactory

'TSTestFactory.NewList("") creates a list of objects according to the specified filter
For Each qtTest in TSTestFactory.NewList("")
'Change test status to N/A
'We do this to ensure all tests have 'not run' before starting execution
'If the execution errors out, we can keep track of the tests that were not run

qtTest.Field("TC_STATUS") = "N/A"

qtTest.Post

Next

'mark status according to input array

intCaseNumber = Ubound(arrCaseName)

'Get each case from array and find the test name from ALM
For i = 0 To intCaseNumber
For Each qtTest in TSTestFactory.NewList("")
strNameinALM = trim(qtTest.name)

'Remove [x] from test name
strNameinALM = mid(strNameinALM,4)

If Lcase(trim(strNameinALM)) = Lcase(trim(arrCaseName(i))) Then
qtTest.Field("TC_STATUS") = arrCaseStatus(i)
qtTest.Post
Exit For
End If
Next
Next
End If

End Function

'==========================================================================
' Name: addAttachmentOnQC
' Summary: according to array of case name, mark corresponding status in the ALM
' Parameters:
' TDConnection:the object connecting ALM
' QCTestSetPath, QCTestSetName: test set information
' arrOutputXMLFilePath, arrInputXMLFilePath, arrCaseName: array stored case and requst/response xml file name
' Outputs: none
'==========================================================================
Function addAttachmentOnQC(TDConnection, QCTestSetPath, QCTestSetName, arrOutputXMLFilePath, arrInputXMLFilePath, arrCaseName)

blnExist = checkTestSet(TDConnection,QCTestSetPath, QCTestSetName)

Set TSTreeManager = TDConnection.TestSetTreeManager

If blnExist Then
'This enables database to update immediately when the field value changes
TestSet.AutoPost = True
'TSTestFactory manages test instances (TSTest objects) in a test set
Set TSTestFactory = TestSet.TSTestFactory

AddAttachmentOnQC = False

intCaseNumber = Ubound(arrCaseName)

Set fso = createobject("scripting.filesystemobject")

'Get each case from array and find the test name from ALM
For i = 0 To intCaseNumber
For Each qtTest in TSTestFactory.NewList("")
strNameinALM = trim(qtTest.name)

'Remove [x] from test name
strNameinALM = mid(strNameinALM,4)

If Lcase(trim(strNameinALM)) = Lcase(trim(arrCaseName(i))) Then
strOutputXMLFilePath = Environment("TestDir")&"\OutputXML\"&arrOutputXMLFilePath(i)
strInputXMLFilePath = Environment("TestDir")&"\InputXML\"&arrInputXMLFilePath(i)

Set AttachmentFactory = qtTest.Attachments
Set Attachment = AttachmentFactory.AddItem(Null)

If fso.FileExists(strOutputXMLFilePath) Then
Attachment.FileName = strOutputXMLFilePath
Attachment.Type = 1
Attachment.Post
End If

If fso.FileExists(strInputXMLFilePath) Then
Attachment.FileName = strInputXMLFilePath
Attachment.Type = 1
Attachment.Post
End If

Attachment.Refresh
Exit For
End If
Next
Next

End if

End Function

转载于:https://www.cnblogs.com/ellie-test/p/4353797.html