VBS驱动框架核心代码

lyscser · 发表于 2009-3-23 22:45:33

作用：脱离VBA和QTP的编译环境进行QC的OPEN API调用，直接驱动测试集运行并发发送测试报告（须配置邮件服务器）
优点：简短易懂，可扩展与第三方平台，如web、loadrunner或者其他的应用，支持持续集成；可以简单操作QC服务，支持高频度自动化回归测试

其余特点不再赘述，各人有各人的用法和想法，我加班加熬夜写了10来个小时，test就尝试了十几次，累死了，嘿嘿

'*************************************************************************************************************************************************************************
'设计说明：调用QC测试集运行并且发送测试结果，必须配置好邮件服务器，否则邮件无法发送，其余无需修改
'程序输入：参见函数参数定义注解
'程序输出：邮件结果报告和分析报表
'设计人员：刘毅（LIUYI）
'设计时间：2009-03-20
'调用举例：Call RunTestSet("http://qc/qcbin","核心项目","某某系统","LIUYI",psWord,"自动化测试\回归测试\","试验","remoterun","10.31.10.1","LIUYI@AAA.COM,HUYANG@AAAA.COM")
'*************************************************************************************************************************************************************************

Public Sub RunTestSet(qcServer,qcDomain,qcProject,qcUser,qcPassword,tsFolderName,tSetName,runMode,runHostName,resultGetter)
'Dim qcServer 定义QC服务器地址
'Dim qcDomain 定义QC域的名称
'Dim qcProject 定义QC项目名称
'Dim qcUser 定义QC用户名称，必须保证这些用户有特定的执行权限
'Dim qcPassword 定义QC用户的密码
'Dim tsFolderName 定义测试集所在的路径（不包含"Root\"）
'Dim tSetName 定义测试集的名称
'Dim runMode 定义运行模式：本地运行或代理运行
'Dim runHostName 定义代理运行的主机名称或IP地址，如果是本地运行则此参数自动失效
'Dim resultGetter 定义邮件接受人（列表），多人则以英文半角的逗号”,“分隔

'全局对象声明

'On Error Resume Next

Set Wshshell = CreateObject("Wscript.Shell")
Set TDC = CreateObject("TDApiOle80.TDConnection.1")

'判断制定用户和指定的域和项目是否连接成功，如果已经连接则首先断开之后重新登陆，这样可以确保连接的项目正确，如果没有连接则直接连接登陆

If TDC.Connected Then
TDC.intConnectionEx qcServer
TDC.Login qcUser,qcPassword
TDC.Connect qcDomain,qcProject
Else
TDC.Disconnect
TDC.Logout
TDC.ReleaseConnection
TDC.intConnectionEx qcServer
TDC.Login qcUser,qcPassword
TDC.Connect qcDomain,qcProject
End If

'声明测试集树、路径、测试实验室、测试集名等对象

Set tsTreeMgr = TDC.TestSetTreeManager
Set tsFolder = tsTreeMgr.NodeByPath("Root\"&Trim(tsFolderName))
Set tsList = tsFolder.FindTestSets(tSetName)

'对测试集路径进行正确性判断，发生异常情况清空所有对象退出运行

If tsFolder Is Nothing Then
Wshshell.Popup "找不到指定路径【"&nPath&"】",1,"运行时错误：",0
Set tsList = Nothing
Set tsFolder = Nothing
Set tsTreeMgr = Nothing
Set TDC = Nothing
Set Wshshell = Nothing
Exit Sub
End If

'对同一目录下的同名测试集做异常判断，对没有找到指定测试集进行异常判断，异常情况清空所有对象退出运行

If tsList.Count > 1 Then
Wshshell.Popup "同名测试集多于一个，请先删除多于测试集！【"&nPath&tSetName&"】",1,"运行时错误：",0
Set tsList = Nothing
Set tsFolder = Nothing
Set tsTreeMgr = Nothing
Set TDC = Nothing
Set Wshshell = Nothing
Exit Sub
ElseIf tsList.Count < 1 Then
Wshshell.Popup "找不到测试集！【"&nPath&tSetName&"】",1,"运行时错误：",0
Set tsList = Nothing
Set tsFolder = Nothing
Set tsTreeMgr = Nothing
Set TDC = Nothing
Set Wshshell = Nothing
Exit Sub
End If

'报告当前运行测试集的测试集信息

Set theTestSet = tsList.Item(1)

Wshshell.Popup "当前运行测试集ID为："&theTestSet.ID&"测试集名称为："&tSetName&"】",1,"当前运行测试集为：",0

'判断运行模式：本机执行、代理执行，并且选择代理运行的执行机

If Trim(runMode) = "localrun" Then
Set Scheduler = theTestSet.StartExecution(LocalHost)
Scheduler.RunAllLocally = True
Scheduler.Run
ElseIf Trim(runMode) = "remoterun" Then
Set Scheduler = theTestSet.StartExecution(LocalHost)
Scheduler.TdHostName = runHostName
Scheduler.Run
Else
Wshshell.Popup "调用接口错误，无此运行选项：【"&runMode&"】",1,"运行时错误：",0
Set tsList = Nothing
Set tsFolder = Nothing
Set tsTreeMgr = Nothing
Set TDC = Nothing
Set Wshshell = Nothing Exit Sub
End If

'判断运行是否结束，没有结束则继续循环知道结束，否则进行后续处理

Set execStatus = Scheduler.ExecutionStatus

mailMessage = "<HTML><HEAD><STYLE> TYPE=""TEXT/CSS"">ATS{COLOR:NAVY;FONT-SIZE:12PX;}Atest{BACKGROUND:GRAY;}</STYLE></HEAD>"&_
"<BODY>"&_
"<ATS>测试集"&tSetName&" 执行时间："&Now&" 结果报告</ATS><BR>"&_
"<TABLE>"&_
"<TR BGCOLOR=""NAVY""><B>测试名称</B></FONT></TD>"&_
"<TR BGCOLOR=""NAVY""><B>执行状态</B></FONT></TD>"&_
"<TR BGCOLOR=""NAVY""><B>执行主机</B></FONT></TD>"&_
"</TR>"

While (RunFinished = False) Then
execStatus.RefreshExecStatusInfo "all",True
RunFinished = execStatus.Finished
Set EventList = execStatus.EventList
Wscript.sleep 5000
Wend

Set theTestSet = tcList.Item(1)
Set TSTestFact = theTestSet.TSTestFactory
Set TestSetTestsList = TSTestFact.NewList("")

For i = 1 To execStatus.Count
Set TestExecStatusObj = execStatus.Item(i)

testName = TestSetTestsList.Item(i).Name
resState = TestExecStatusObj.Message

mailMessage = mailMessage&"<TR ALIGN=""MIDDLE""><TD>"&i&"</TD><TD>"&testName&"</TD><TD>"&resState&"</TD><TD>"&runHostName&"</TD></TR>"
Next

mailMessage = mailMessage&"</TABLE></BODY></HTML>"

Wshshell.Popup "执行全部完成于【"&CStr(Now)&"】",1,"执行结果通知：",0

'此处向EXCEL或数据库回写测试结果，计算该测试集案例个数、运行个数、成功个数，生成报表，发送邮件，进行下一个测试集的运行

TDC.SendMail resultGetter,"","自动化测试集【Root\"&tsFolderName&tSetName&"】于【"&Now&"】完成的运行结果报告",mailMessage,"","HTML"

TDC.Disconnect()
TDC.Logout()
TDC.ReleaseConnection()

'结束之后清空所有对象退出运行

Set TestSetTestsList = Nothing
Set TSTestFact = Nothing
Set theTestSet = Nothing
Set tsList = Nothing
Set tsFolder = Nothing
Set tsTreeMgr = Nothing
Set Wshshell = Nothing
Set TDC = Nothing

End Sub

'过程调用，做循环处理：从WEB页面传入测试集信息，保存之后开始运行
'实现思路：每次清空页面上次写入的记录之后重新写入测试集信息，如果建表，则【测试集路径】和【测试集名称】字段做联合主键

Call RunTestSet("http://qc/qcbin","核心运营","某某系统","LIUYI",psWord,"自动化测试\回归测试\","试验","remoterun","10.31.10.1","LIUYI@AAA.COM,HUYANG@AAAA.COM")

[ 本帖最后由 lyscser 于 2009-3-23 22:54 编辑 ]

vikesgao · 发表于 2010-10-11 12:03:23

好帖，要收藏，多谢楼主

lbx111111 · 发表于 2010-9-28 23:32:18

好帖，要收藏，多谢楼主

51mobile · 发表于 2010-9-21 13:22:51

这么好的帖子，要收藏下

lyscser · 发表于 2010-9-20 00:32:27

补充一点，如果测试集里即包含手工测试也有QTP测试用例，加上如下代码可只运行QTP测试用例。实现过滤功能
...
andyzlp232 发表于 2009-9-8 18:08

额，是比我想的周全一些，呵呵，多谢

I_CAN_FLY_Y · 发表于 2010-4-27 08:51:12

你好，想问你个问题，我用浏览器已经打开了TD的某个项目，即连接到了TD的某个项目上，现在我想在外面（比如WORD的宏里面）判断本机上是否有连接到TD的项目，并想知道是哪个项目。有没有可行的方法？还请指教。

I_CAN_FLY_Y · 发表于 2010-4-27 08:43:04

强贴。。。逛顶。。

andyzlp232 · 发表于 2009-9-8 18:08:01

补充一点，如果测试集里即包含手工测试也有QTP测试用例，加上如下代码可只运行QTP测试用例。实现过滤功能
Set theTestSet = tsList.Item(1)
Wshshell.Popup "当前运行测试集ID为："&theTestSet.ID&"测试集名称为："&tSetName&"】",1,"当前运行测试集为：",0里改成如下：
Set theTestSet = tsList.Item(1)
'过滤其他手工用例，只运行QTP用例
Set TSTestFact = theTestSet.TSTestFactory
Set tsFilter = TSTestFact.Filter
tsFilter.Filter("TS_TYPE") = "QUICKTEST_TEST"
Set TestSetTestsList = TSTestFact.NewList(tsFilter.Text)

Wshshell.Popup "当前运行测试集ID为："&theTestSet.ID&"测试集名称为："&tSetName&"】",1,"当前运行测试集为：",0
然后原代码里的
Scheduler.Run
改成：
Scheduler.Run(TestSetTestsList)

zitong · 发表于 2009-4-1 17:56:32

Set execStatus = Scheduler.ExecutionStatus

      mailMessage = "<HTML><HEAD><STYLE> TYPE=""TEXT/CSS"">ATS{COLOR:NAVY;FONT-SIZE:12PX;}Atest{BACKGROUND:GRAY;}</STYLE></HEAD>"&_
      "<BODY>"&_
            "<ATS>测试集"&tSetName&" 执行时间："&Now&" 结果报告</ATS><BR>"&_
                     "<TABLE>"&_
                              "<TR BGCOLOR=""NAVY""><B>测试名称</B></FONT></TD>"&_
                              "<TR BGCOLOR=""NAVY""><B>执行状态</B></FONT></TD>"&_
                              "<TR BGCOLOR=""NAVY""><B>执行主机</B></FONT></TD>"&_
                              "</TR>"

      While (RunFinished = False) Then  ' 这句有语法错误也，这个RunFinished 好像前面没赋值，这里怎么就开判断了？

            execStatus.RefreshExecStatusInfo "all",True
            RunFinished = execStatus.Finished
            Set EventList = execStatus.EventList
            Wscript.sleep 5000

zitong · 发表于 2009-3-31 14:11:38

感觉很不错，下来试一试！感谢楼主分享.

david208 · 发表于 2009-3-26 17:39:43

太牛了没仔细看但是一定好

heqingbluesky · 发表于 2009-3-26 10:16:54

写的不错，可惜我们公司不用QC，用TestLink。

lyscser · 发表于 2009-3-25 21:22:18

笔误，呵呵，谢谢
If       TDC.Connected =False Then
            TDC.intConnectionEx qcServer
            TDC.Login qcUser,qcPassword
            TDC.Connect qcDomain,qcProject
      Else
            TDC.Disconnect
            TDC.Logout
            TDC.ReleaseConnection
            TDC.intConnectionEx qcServer
            TDC.Login qcUser,qcPassword
            TDC.Connect qcDomain,qcProject
      End If

andyzlp232 · 发表于 2009-3-25 16:40:16

大哥，有几个地方你写错了，不知道是不是你故意考验我们的！！

Set theTestSet = tcList.Item(1)  应为 Set theTestSet = tsList.Item(1)
TDC.intConnectionEx qcServer 应为  TDC.IintConnectionEx qcServer
还有
      If       TDC.Connected Then
            TDC.intConnectionEx qcServer
            TDC.Login qcUser,qcPassword
            TDC.Connect qcDomain,qcProject
      Else
            TDC.Disconnect
            TDC.Logout
            TDC.ReleaseConnection
            TDC.intConnectionEx qcServer
            TDC.Login qcUser,qcPassword
            TDC.Connect qcDomain,qcProject
      End If
这里你写反了吧，应是判断有连接，才关闭吧，应是

      If       TDC.Connected Then
            TDC.Disconnect
            TDC.Logout
            TDC.ReleaseConnection
            TDC.IintConnectionEx qcServer
            TDC.Login qcUser,qcPassword
            TDC.Connect qcDomain,qcProject
      Else
            TDC.IintConnectionEx qcServer
            TDC.Login qcUser,qcPassword
            TDC.Connect qcDomain,qcProject
      End If

lyscser · 发表于 2009-3-24 22:36:03

呵呵，看得懂，用的好的人恐怕比例不是非常大的

peterz · 发表于 2009-3-24 12:33:40

原帖由 dreamever 于 2009-3-24 09:15 发表
很好，很强大

跟我的口头禅一样啊。呵呵

mklodoss · 发表于 2009-3-24 10:57:45

顶，谢谢lz.

假装不在 · 发表于 2009-3-24 10:30:19

so good ,so strong...

dreamever · 发表于 2009-3-24 09:15:02

很好，很强大

B.O · 发表于 2009-3-24 00:27:44

正需要，谢谢啦。。。

		自动登录	找回密码
密码			(注-册)加入51Testing

[原创] VBS驱动框架核心代码

本帖子中包含更多资源

相关帖子

回复 2# 的帖子

实现过滤测试集中的手工测试用例

站长推荐 /1