51Testing软件测试论坛

 找回密码
 (注-册)加入51Testing

QQ登录

只需一步,快速开始

微信登录,快人一步

手机号码,快捷登录

查看: 7085|回复: 20
打印 上一主题 下一主题

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

[复制链接]

该用户从未签到

跳转到指定楼层
1#
发表于 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 编辑 ]

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?(注-册)加入51Testing

x
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏
回复

使用道具 举报

该用户从未签到

2#
 楼主| 发表于 2009-3-23 22:51:21 | 只看该作者
标注一下:另存为VBS就可以直接运行了
前提是修改参数,参见注释即可,无邮件服务的注释掉那段邮件代码即可
回复 支持 反对

使用道具 举报

该用户从未签到

3#
发表于 2009-3-24 00:27:44 | 只看该作者
正需要,谢谢啦。。。
回复 支持 反对

使用道具 举报

该用户从未签到

4#
发表于 2009-3-24 09:15:02 | 只看该作者
很好,很强大
回复 支持 反对

使用道具 举报

该用户从未签到

5#
发表于 2009-3-24 10:30:19 | 只看该作者
so good ,so strong...
回复 支持 反对

使用道具 举报

该用户从未签到

6#
发表于 2009-3-24 10:57:45 | 只看该作者
顶,谢谢lz.
回复 支持 反对

使用道具 举报

  • TA的每日心情
    开心
    2017-7-4 15:34
  • 签到天数: 1 天

    连续签到: 1 天

    [LV.1]测试小兵

    7#
    发表于 2009-3-24 12:33:40 | 只看该作者
    原帖由 dreamever 于 2009-3-24 09:15 发表
    很好,很强大

    跟我的口头禅一样啊。呵呵
    回复 支持 反对

    使用道具 举报

    该用户从未签到

    8#
     楼主| 发表于 2009-3-24 22:36:03 | 只看该作者
    呵呵,看得懂,用的好的人恐怕比例不是非常大的
    回复 支持 反对

    使用道具 举报

    该用户从未签到

    9#
    发表于 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
    回复 支持 反对

    使用道具 举报

    该用户从未签到

    10#
     楼主| 发表于 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
    回复 支持 反对

    使用道具 举报

    该用户从未签到

    11#
    发表于 2009-3-26 10:16:54 | 只看该作者
    写的不错,可惜我们公司不用QC,用TestLink。
    回复 支持 反对

    使用道具 举报

    该用户从未签到

    12#
    发表于 2009-3-26 17:39:43 | 只看该作者
    太牛了 没仔细看 但是一定好
    回复 支持 反对

    使用道具 举报

    该用户从未签到

    13#
    发表于 2009-3-31 14:11:38 | 只看该作者
    感觉很不错,下来试一试!感谢楼主分享.
    回复 支持 反对

    使用道具 举报

    该用户从未签到

    14#
    发表于 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
    回复 支持 反对

    使用道具 举报

    该用户从未签到

    15#
    发表于 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)
    回复 支持 反对

    使用道具 举报

    该用户从未签到

    16#
    发表于 2010-4-27 08:43:04 | 只看该作者
    强贴。。。逛顶。。
    回复 支持 反对

    使用道具 举报

    该用户从未签到

    17#
    发表于 2010-4-27 08:51:12 | 只看该作者

    回复 2# 的帖子

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

    使用道具 举报

    该用户从未签到

    18#
     楼主| 发表于 2010-9-20 00:32:27 | 只看该作者
    补充一点,如果测试集里即包含手工测试也有QTP测试用例,加上如下代码可只运行QTP测试用例。实现过滤功能
    ...
    andyzlp232 发表于 2009-9-8 18:08



    额,是比我想的周全一些,呵呵,多谢
    回复 支持 反对

    使用道具 举报

    该用户从未签到

    19#
    发表于 2010-9-21 13:22:51 | 只看该作者
    这么好的帖子,要收藏下
    回复 支持 反对

    使用道具 举报

    该用户从未签到

    20#
    发表于 2010-9-28 23:32:18 | 只看该作者
    好帖,要收藏,多谢楼主
    回复 支持 反对

    使用道具 举报

    本版积分规则

    关闭

    站长推荐上一条 /1 下一条

    小黑屋|手机版|Archiver|51Testing软件测试网 ( 沪ICP备05003035号 关于我们

    GMT+8, 2024-11-8 17:11 , Processed in 0.091049 second(s), 28 queries .

    Powered by Discuz! X3.2

    © 2001-2024 Comsenz Inc.

    快速回复 返回顶部 返回列表