Set qtp=New QTPHelper
testActionXmlPath="E:\excelHelp\testActionXmlPath.xml"
logPath="D:\AutoCDSProject\AutoCDSProject\log\autotest.log"
Set xmlHelp = CreateXMLHelper(testActionXmlPath)
Call Main() 'QTP執行函式入口
'*******************************************************************************************************************************
'設計說明： 獲取測試用例xml中相關節點內容（測試數據、疊代次數）調用QTPHelper中函式啟動QTP,並執行用例。
'程式輸入： 獲取測試用例xml中相關節點內容（測試數據、疊代次數、日誌地址）
'程式輸出： 啟動QTP、載入用例、執行用例、輸出測試結果
'設計人員： 熊友亮（maQ）
'設計時間： 2011-10-22
'調用舉例： Call Main()
'*******************************************************************************************************************************
Sub Main()
qtp.Libpath=GetLibraries()
qtp.LoadLibraries()
Set rootNode=xmlHelp.GetXmlRootNode()
msgbox rootNode.ChildNodes.length-1
For i=0 to rootNode.ChildNodes.length-1
Set actionsNode=rootNode.ChildNodes(i).ChildNodes.item(1)
For j=0 to actionsNode.ChildNodes.length-1
strActionName =xmlHelp.GetNodeAttr(actionsNode.ChildNodes(j),"name")
strTestDate =xmlHelp.GetNodeAttr(actionsNode.ChildNodes(j).ChildNodes(0),"value")
strTestType =xmlHelp.GetNodeAttr(actionsNode.ChildNodes(j).ChildNodes(1),"value")
strDataTableIterations=xmlHelp.GetNodeAttr(actionsNode.ChildNodes(j).ChildNodes(2),"value")
Dim StartIteration,EndIteration
if strDataTableIterations<>"" Then
Dim Arrlitter:Arrlitter=split(strDataTableIterations,"|")
StartIteration=Arrlitter(0)
EndIteration=Arrlitter(1)
Else
StartIteration=1
EndIteration=1
End If
If strTestType="Reusable" Then
Dim strActionContent
strActionContent= "'Set actionObj= New " &strActionName & vbCrLf & "'actionObj.TestDate="&strTestDate& vbCrLf & "'actionObj.StartIteration="&StartIteration& vbCrLf &"'actionObj.EndIteration="&EndIteration& vbCrLf &"'actionObj.RunAction()"& vbCrLf &"'msgbox "& i&"-"&j
'MsgBox strActionContent
qtp.RunAction strActionContent
PrintLog("QTP is running Action"&strActionName&"---"&Date&" "&Time)
Else
PrintLog ("QTP did not run this Action,because Action-"&strActionName&"'s Type is "&strTestType&"---"&Date&" "&Time)
End If
PrintLog("QTP is run Action"&strActionName&"---"&Date&" "&Time)
Next
Next
PrintLog("All Action had run finished"&"---"&Date&" "&Time)
End Sub
Rem 獲取配置檔案中所有外部函式，存入數組中，並將數組返回。
Public Function GetLibraries()
Dim librarieArry()
Set rootNode=xmlHelp.GetXmlRootNode()
Set librariesNode=rootNode.ChildNodes(0).ChildNodes(0)
Dim librarieLength
librarieLength=CInt(librariesNode.ChildNodes.length)
Redim preserve librarieArry(librarieLength)
For i=0 To librarieLength-1
librarieArry(i)=xmlHelp.GetNodeAttr(librariesNode.ChildNodes(i),"value")
'MsgBox librarieArry(i)
Next
GetLibraries=librarieArry
End Function
Rem 功能：列印運行日誌
Public Sub PrintLog(Logstr)
Const ForReading = 1, ForWriting = 2,ForAppending = 8
Dim fso, f
Set fso = CreateObject("scripting.FileSystemObject")
Set f = fso.OpenTextFile(logPath, ForAppending, True)
f.WriteLine Logstr
End Sub
'*******************************************************************************************************************************
'設計說明： 使用 Class 語句創建的QTP對象。提供了對QTP 的各種事件的訪問。
'程式輸入： QTPHelper類中各種函式集 所需參數。
'程式輸出： 參見各函式輸出
'設計人員： 熊友亮（maQ）
'設計時間： 2011-10-18
'調用舉例： Set qtpHelper=new QTPHelper
'公開函式： RunAction(ByVal temp_ActionContent,ByVal temp_Libpath) 傳入Action內容及需載入的外部函式 新建並運行Action
' WriteToFile(Logstr) QTP運行日誌
'*******************************************************************************************************************************
Class QTPHelper
Private qtpApp
Private qtpTest
Private qtpLibraries
Private qtpResultsOpt
Private q_Libpath
Private q_ResultPath
'Private q_LogPath
Private q_ActionContent
Rem 構造函式
Private Sub Class_Initialize()
Set qtpApp = CreateObject("QuickTest.Application")
qtpApp.Launch
qtpApp.WindowState="Maximized"
qtpApp.Visible = True
End Sub
Rem 析構函式
Private Sub Class_Terminate()
'qtpApp.Quit
If Isobject(qtpResultsOpt) Then Set qtpLibraries = Nothing
If Isobject(qtpLibraries) Then Set qtpLibraries = Nothing
If Isobject(qtpTest) Then Set qtpTest = Nothing
End Sub
Public Property Let Libpath(ByVal Val)
If IsArray(Val) Then
q_Libpath=Val
Else
InErr("傳入外部函式必須為一維數組")
End If
End Property
Public Property Get Libpath()
Libpath = q_Libpath
End Property
Public Property Let ResultPath(ByVal Val)
If Instr(Val, ":\")<>0 Then
q_ResultPath = Trim(Val)
else
InErr("傳入外部函式路徑錯誤")
end if
End Property
Public Property Get ResultPath()
ResultPath = q_ResultPath
End Property
'Public Property Let LogPath(ByVal Val)
' If Instr(Val, ":\")<>0 Then
' q_LogPath = Trim(Val)
' else
' InErr("傳入日誌路徑錯誤")
'end if
'End Property
'Public Property Get LogPath()
' LogPath = q_LogPath
'End Property
Public Property Let ActionContent(ByVal Val)
q_ActionContent = Trim(Val)
End Property
Public Property Get ActionContent()
ActionContent = q_ActionContent
End Property
Rem 功能載入外部函式
Public Sub LoadLibraries()
Set qtpLibraries = qtpApp.Test.Settings.Resources.Libraries ' 獲得libraries collection 對象
' 引入外部vbs函式 ,
For ii =0 To Ubound(q_Libpath)
'MsgBox "for test"
If qtpLibraries.Find(q_Libpath(ii)) = -1 Then
qtpLibraries.Add q_Libpath(ii), 1
End If
Next
'將外部函式設定為默認
qtpLibraries.SetAsDefault
End Sub
Rem 功能：給Action內容重新賦值，並調用doQtpTest()函式，運行傳入內容
Private Sub doQtpTest()
qtpApp.New
Set Action1=qtpApp.Test.Actions.Item(1) 'get the acction name
scriptError = Action1.ValidateScript(ActionContent)
If Len(scriptError) = 0 Then
Action1.SetScript ActionContent
Action1.Description = "Check the calculator application and run next Action"
Action1.Type = "Reusable"
Set aParamDefs = Action1.ActionParameterDefinitions
aParamDefs.Add "InParam", "An input action parameter definition", 0, 0, "Input Value"
aParamDefs.Add "ResParam", "An output action parameter definition", 0, 1, "Output Value"
Set resParamDef = aParamDefs.Item ("ResParam")
resParamDef.Type = 1
resParamDef.DefaultValue = false
resParamDef.Description = "Result parameter"
Else
Err.Raise E_SCRIPT_NOT_VALID, "Validate Script Error", scriptError
End If
qtpApp.Options.Run.ImageCaptureForTestResults = "OnError"
qtpApp.Options.Run.RunMode = "Fast"
qtpApp.Options.Run.ViewResults = False
'設定run settings
Set qtpTest = qtpApp.Test
qtpTest.Settings.Run.IterationMode = "oneIteration"
qtpTest.Settings.Run.OnError = "NextStep" ' 當遇到錯誤跑下一步
Set qtpResultsOpt = CreateObject("QuickTest.RunResultsOptions") ' 創建結果對象
qtpResultsOpt.ResultsLocation = ezResultPath
qtpTest.Run qtpResultsOpt
End Sub
Rem 功能：給Action內容重新賦值，並調用doQtpTest()函式，運行傳入內容
Public Sub RunAction(ByVal temp_ActionContent)
If not IsNull(temp_ActionContent) Then
q_ActionContent = temp_ActionContent
else
InErr("設定Action內容不能為空")
end If
Call doQtpTest()
End Sub
Private Sub InErr(ErrInfo)
Err.Raise vbObjectError + 1,, ErrInfo
End Sub
End Class
Rem XML幫助類
Class XMLHelper
public m_xdoc
Private m_fileName
Private m_isLoad
Public Property Get FileName()
FileName = m_fileName
End Property
Public Property Let FileName(ByVal vfileName)
m_fileName = vfileName
End Property
Private Property Get IsLoad()
IsLoad = m_isLoad
End Property
Private Property Let IsLoad(ByVal vIsLoad)
m_isLoad = vIsLoad
End Property
Sub Class_Initialize '構造函式
Set m_xdoc = CreateObject("Microsoft.XMLDOM")
m_xdoc.Async = False
End Sub
Sub Class_Terminate '析構函式
Set m_xdoc = Nothing
End Sub
'---------------------------------------------------------------------
'--作用：初始化XMLHelper
'--參數：無
'--返回：無
'----------------------------------------------------------------------
Sub Init
IsLoad = m_xdoc.Load(FileName)
End Sub
'---------------------------------------------------------------------
'--作用：讀取XML檔案節點的屬性值
'--參數：參數1：當前節點，參數2：屬性名
'--返回：當前節點的屬性
'----------------------------------------------------------------------
Public Function GetNodeAttr(xmlNode,attrName)
If xmlNode.Attributes.length > 0 Then
If attrName<>"" Then
GetNodeAttr = xmlNode.Attributes.getNamedItem(attrName).nodeValue
else
GetNodeAttr = xmlNode.Attributes.Item(0).nodeValue
End If
Else
GetNodeAttr = ""
End If
End Function
'----------------------------------------------------------------------
'--作用：讀取XML檔案唯一的節點
'--參數：參數1：節點名
'--返回：節點
'----------------------------------------------------------------------
Public Function GetXmlSingleNode(nodeName)
Dim node
If isLoad Then
'裝載XML檔案
Set objXmlDoc = m_xdoc.documentelement
Set node = objXmlDoc.selectSingleNode(nodeName) '先獲得節點對象
End If
Set GetXmlSingleNode=node
End Function
'----------------------------------------------------------------------
'--作用：讀取XML檔案根節點
'--參數：參數1：節點名
'--返回：節點
'----------------------------------------------------------------------
Public Function GetXmlRootNode()
Dim node
If isLoad Then
'裝載XML檔案
Set objXmlDoc = m_xdoc.documentelement
Set node = objXmlDoc '先獲得節點對象
End If
Set GetXmlRootNode=node
End Function
'----------------------------------------------------------------------
'--作用：讀取XML檔案的節點
'--參數：參數1：節點名
'--返回：節點LIst
'----------------------------------------------------------------------
Public Function GetXmlNodeList(nodeName)
Dim nodeList
If isLoad Then
'裝載XML檔案
Set objXmlDoc = m_xdoc.documentelement
Set objNodeList = objXmlDoc.getElementsByTagName(nodeName) '先獲得節點對象
End If
Set GetXmlNodeList=nodeList
End Function
'----------------------------------------------------------------------
'--作用：根據節點的屬性，獲得節點
'--參數：參數1：節點名，參數2：屬性名，參數3：屬性值
'--返回：返回節點
'----------------------------------------------------------------------
Public Function GetXmlNodeByAttr(nodeName,attrName,attrValue)
Dim node
If isLoad Then
'裝載XML檔案
Set objXmlDoc = m_xdoc.documentelement
Set objNodeList = objXmlDoc.getElementsByTagName(nodeName) '先獲得節點對象
MsgBox objNodeList.length
For I = 0 To objNodeList.length - 1 Step 1
If GetNodeAttr(objNodeList(I),attrName)=attrValue Then
Set node = objNodeList(I)
End If
Next
End If
Set GetXmlNodeByAttr=node
End Function
End Class
'----------------------------------------------------------------------
'--作用：創建XMLHelper
'--參數：參數1：xml檔案名稱
'--返回：XMLHelper對象
'----------------------------------------------------------------------
Function CreateXMLHelper(ByVal fileName)
Set CreateXMLHelper = New XMLHelper
CreateXMLHelper.FileName = fileName
CreateXMLHelper.Init
End Function
