自己2011年做保险系统中理赔流程自动化时，开发的一个小框架。当时还没有selenium，不过基于UFT的一些功能还是比较实用的，可用于参考。
框架源码： （提取码：2165）
一、已实现的功能列表
框架已经实现的功能如下：
1、脚本数据分离
2、异常截图并关联截图
3、无界面启动UFT
4、定时启动UFT
5、步骤日志跟踪
6、数据库检查点验证
7、测试结果发送
8、测试报告生成
9、场景恢复
10、脚本执行速度控制
11、系统资源监控，如Cpu峰值监控（基于UFT）
12、执行过程录制回放（基于UFT）
二、框架部分关键代码
1、必须导入的驱动脚本，用户全局环境控制
Call driver()Function driver() '初始化环境，包括获得project所在的本地目录。 projectPath = getProjectPath() sourceDataFile = projectPath&"\TEST.xls" sourceDataSheet = "Sheet1" Dim qtApp 'As QuickTest.Application ' Declare the Application object variable Dim qtTest 'As QuickTest.Test ' Declare a Test object variable Dim qtResultsOpt 'As QuickTest.RunResultsOptions ' Declare a Run Results Options object variable Set qtApp = CreateObject("QuickTest.Application") ' Create the Application object qtApp.Launch ' Start QuickTest qtApp.Visible = True ' Make the QuickTest application visible ' Set QuickTest run options qtApp.Options.Run.CaptureForTestResults = "OnError" 'qtApp.Options.Run.RunMode = "Fast" qtApp.Options.Run.ViewResults = False ' 打开入口的测试脚本，并且加载testCase的脚本 qtApp.Open projectPath&"\理赔系统流程", False, False ' 打开入口的测试脚本,可写，不保存 Set qtTest = qtApp.Test ' set run settings for the test Set qtResultsOpt = CreateObject("QuickTest.RunResultsOptions") qtResultsOpt.ResultsLocation = projectPath&"\result" '运行结果保存到临时文件夹中 qtTest.Run qtResultsOpt, True qtTest.Close Set qtResultsOpt = Nothing ' Release the Run Results Options object Set qtTest = Nothing ' Release the Test object qtApp.quit Set qtApp = Nothing ' Release the Application object End FunctionFunction getProjectPath() Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFile = objFSO.GetFile(wscript.scriptfullname) getProjectPath = objFSO.GetParentFolderName(objFile) Set objFSO = Nothing Set objFile = NothingEnd Function 2、驱动的工具集
包括：路径查找，生成指定规则的随机数，数据库操作，浏览器操作，日志操作，日期工具等。
'################################''---------------通用方法--------------------------''################################'Function pathFind( searchingFolder,searchingFileName,fileType)'根据传入的根目录，查找该目录下的指定名称,以及指定文件类型的文件，并返回其绝对路径。 tempArray = Split(searchingFileName,".") fileName = tempArray(0)&"."&fileType Set fso=CreateObject( "Scripting.FileSystemObject" ) Set objFolder = fso.GetFolder( searchingFolder ) Set objFileCollection = objFolder.Files for each objFile in objFileCollection If objFile.Name = fileName Then i=i+1 searchedFilePath = objFile.Path Exit for End If Next If i=0 then '遍历子文件夹 Set objSubFoldersCollection = objFolder.SubFolders For each objInputSubFolder in objSubFoldersCollection searchedFilePath= pathFind(objInputSubFolder,searchingFileName,fileType) If searchedFilePath<>"" Then Exit For End if Next End If pathFind = searchedFilePathEnd FunctionFunction getParentFolderPath(curPath) '输入一个路径的字符串，获得其上级目录的字符串，主要目的是根据QTP脚本所在文件夹，找到工程所在的文件夹 tempArray = split(curPath,"\") tempStr ="" For i=LBound(tempArray) to UBound(tempArray)-1 tempStr = tempStr&tempArray(i)&"\" Next getParentFolderPath = tempStrEnd FunctionFunction generateFilterExp(Sheet_Name,filterExp) ''解析条件语句，只支持 >= ,<= , <>, >, <, = 这6种表达式 '对表达式作了处理，支持中文的分号，不区分英文的大小写。 If filterExp<>"" Then If InStr(filterExp,"；")>0 Then filterExp = Replace(filterExp,"；",";") End If expressArray = Split(LCase(filterExp),";") For i=LBound(expressArray) To UBound(expressArray) If InStr(expressArray(i),">=") Then tempArray = Split(expressArray(i),">=") If i=LBound(expressArray) Then expressStr = "DataTable("&Chr(34)&tempArray(0)&Chr(34)&","&Chr(34)&Sheet_Name&Chr(34)&")"&">="&chr(34)&tempArray(1)&chr(34) else expressStr = expressStr&" and "&"DataTable("&Chr(34)&tempArray(0)&Chr(34)&","&Chr(34)&Sheet_Name&Chr(34)&")"&">="&chr(34)&tempArray(1)&chr(34) End If ElseIf InStr(expressArray(i),"<=") Then tempArray = Split(expressArray(i),"<=") If i=LBound(expressArray) Then expressStr = "DataTable("&Chr(34)&tempArray(0)&Chr(34)&","&Chr(34)&Sheet_Name&Chr(34)&")"&"<="&chr(34)&tempArray(1)&chr(34) else expressStr = expressStr&" and "&"DataTable("&Chr(34)&tempArray(0)&Chr(34)&","&Chr(34)&Sheet_Name&Chr(34)&")"&"<="&chr(34)&tempArray(1)&chr(34) End If ElseIf InStr(expressArray(i),"<>") Then tempArray = Split(expressArray(i),"<>") If i=LBound(expressArray) Then expressStr = "DataTable("&Chr(34)&tempArray(0)&Chr(34)&","&Chr(34)&Sheet_Name&Chr(34)&")"&"<>"&chr(34)&tempArray(1)&chr(34) else expressStr = expressStr&" and "&"DataTable("&Chr(34)&tempArray(0)&Chr(34)&","&Chr(34)&Sheet_Name&Chr(34)&")"&"<>"&chr(34)&tempArray(1)&chr(34) End If ElseIf InStr(expressArray(i),"<") Then tempArray = Split(expressArray(i),"<") If i=LBound(expressArray) Then expressStr = "DataTable("&Chr(34)&tempArray(0)&Chr(34)&","&Chr(34)&Sheet_Name&Chr(34)&")"&"<"&chr(34)&tempArray(1)&chr(34) else expressStr = expressStr&" and "&"DataTable("&Chr(34)&tempArray(0)&Chr(34)&","&Chr(34)&Sheet_Name&Chr(34)&")"&"<"&chr(34)&tempArray(1)&chr(34) End If ElseIf InStr(expressArray(i),">") Then tempArray = Split(expressArray(i),">") If i=LBound(expressArray) Then expressStr = "DataTable("&Chr(34)&tempArray(0)&Chr(34)&","&Chr(34)&Sheet_Name&Chr(34)&")"&">"&chr(34)&tempArray(1)&chr(34) else expressStr = expressStr&" and "&"DataTable("&Chr(34)&tempArray(0)&Chr(34)&","&Chr(34)&Sheet_Name&Chr(34)&")"&">"&chr(34)&tempArray(1)&chr(34) End If ElseIf InStr(expressArray(i),"=") Then tempArray = Split(expressArray(i),"=") If i=LBound(expressArray) Then expressStr = "DataTable("&Chr(34)&tempArray(0)&Chr(34)&","&Chr(34)&Sheet_Name&Chr(34)&")"&"="&chr(34)&tempArray(1)&chr(34) else expressStr = expressStr&" and "&"DataTable("&Chr(34)&tempArray(0)&Chr(34)&","&Chr(34)&Sheet_Name&Chr(34)&")"&"="&chr(34)&tempArray(1)&chr(34) End If Else MsgBox("不支持此表达式") End If Next Else expressStr = "DataTable( 1 "&","&Chr(34)&Sheet_Name&Chr(34)&")"&"<>"&chr(34)&chr(34) End If 'logPrint("在generateFilterExp方法中，条件语句解析结果："&expressStr) generateFilterExp = expressStrEnd Function'随机函数生成'输入值：生成值范围 i～j'返回值：随机数Public Function Get_RandNum(fromNum,toNum) If (fromNum<0) Or (toNum<0) Then MsgBox "只接受大于零的输入" ElseIf fromNum>toNum then MsgBox "起始值必须小于结束值" Else Dim RunTime Randomize RunTime = Int((10 * Rnd) + 1) Dim MyValue,i For i = 1 To RunTime Randomize MyValue = Int(((toNum - fromNum + 1) * Rnd) + (fromNum)) Next Get_randNum=MyValue End IfEnd Function Function MakeString(inputlength) Dim I,x,B,A If IsNumeric(inputlength) Then For I = 1 To inputlength A = Array("0","1","2","3","4","5","6","7","8","9","a","b","c","d","e","f","g","h","i","j","k","l","m","n","o","p","q","r","s","t","u","v","w","x","y","z") Randomize x=Get_RandNum(0,35) B = A(x) makestring =makestring +B Next MakeString = makestring else msgbox ("只接受数字输入") End IfEnd FunctionFunction CarNum(inputlength) Dim I,x,B,A If IsNumeric(inputlength) Then For I = 1 To inputlength A = Array("0","1","2","3","4","5","6","7","8","9") Randomize x=Get_RandNum(0,9) B = A(x) CarNum =carnum +B Next CarNum = carnum else msgbox ("只接受数字输入") End IfEnd FunctionFunction dyht(sqlstrm,keyname) Dim Cnn '定义一个数据库连接串Set Cnn = CreateObject("ADODB.Connection")Cnn.Open ="Provider=OraOLEDB.Oracle.1;Password=ywquery;Persist Security Info=True;User ID=ywquery;Data Source=ceshidb"'If Cnn.State = 0 Then '判断数据库连接是否成功 ' Reporter.ReportEvent micFail, "CESHIDB", "连接数据库失败"'else' Reporter.ReportEvent micPass, "CESHIDB", "连接数据库成功"'End IfDim RsDim sqlDim uidif Cnn.State<> 0 then Set Rs=CreateObject("ADODB.Recordset") '生成记录集对象 sql =sqlstrm '从数据库中查询cust的所有记录(需参数化) Rs.Open sql ,Cnn,1,3 '执行sql语句，记录可以自由移动，单数记录处于只读模式 uid=Rs(keyname) '取得字段为custid的记录，游标定义在第一行，所以取得的是该字段所在行的第一行数据 'msgbox uidEnd Ifdyht=uidEnd FunctionFunction openie(url)Dim ie '定义浏览器对象set ie=createobject("internetexplorer.application") ie.visible=true ie.navigate url '打开系统End FunctionFunction updatedb(sql)'更新数据库 Dim res,Conn,strConn,Cmd strConn="Provider=OraOLEDB.Oracle.1;Password=ywuser252;Persist Security Info=True;User ID=ywuser;Data Source=ceshidb" 'sql="update t_address set address='HK' where id=3" '建立数据库连接对象 Set Conn=CreateObject("adodb.connection") '打开数据库连接 Conn.open strConn '建立记录集对象 Set res=CreateObject("adodb.recordset") '建立命令对象 Set Cmd=CreateObject("adodb.command") Cmd.ActiveConnection=Conn Cmd.CommandText=sql '执行更新 Cmd.Execute Conn.close '释放资源 Set res=Nothing Set Conn=Nothing '输出显示End Function '关闭ie Function closeie() dim s s="iexplore.exe" Set objWMIService =GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2") Set colProcessList=objWMIService.ExecQuery _ ("Select * from Win32_Process Where Name='" & s & "'") For Each objProcess in colProcessList 'msgbox "已发现目标！" objProcess.Terminate() Next End Function'格式化时间的函数Function FormateDateTime(sendTime,Para) select case Para Rem YYYYMMDDHHmmss case "1" sendTime = year(sendTime) & right( "00" & month(sendTime),2) & right( "00" & day(sendTime),2) & right( "00" & hour(sendTime),2) & right( "00" & minute(sendTime),2) & right( "00 " & second(sendTime),2) Rem YYYYMMDD case "2" sendTime = year(sendTime) & right( "00" & month(sendTime),2) & right( "00" & day(sendTime),2) Rem YYYY-MM-DD case "3" sendTime = year(sendTime) & "-"& right( "00" & month(sendTime),2) & "-"& right( "00" & day(sendTime),2) Rem YYYY年MM月DD日 case "4" sendTime = year(sendTime) & "年"& right( "00" & month(sendTime),2) & "月"& right( "00" & day(sendTime),2)& "日 " Rem YYYY-MM-DD HH:mm:ss case "5" sendTime = year(sendTime) & "-"& right( "00" & month(sendTime),2) & "-"& right( "00" & day(sendTime),2) & " "& right( "00" & hour(sendTime),2) & ": "& right( "00 " & minute(sendTime),2) & ": "& right( "00 " & second(sendTime),2) end select FormateDateTime = SendTime end Function'msgbox FormateDateTime(date(),"3")'创建txt的函数Function CreateFile(sFilename,bOverwrite) Set fso = CreateObject("Scripting.FileSystemObject") Set CreateFile = fso.CreateTextFile(sFilename,bOverwrite)End Function'Set f = CreateFile("C:\been.txt",True)'打印logPublic Function logPrint(ByVal logMessage) Dim fso, logFile Set fso = CreateObject("Scripting.FileSystemObject") Set logFile = fso.OpenTextFile(ProjectDir&"runtime.log", 8, True) 'Open a file and write to the end of the file and open as Unicode logFile.WriteLine(date() & " " & hour(now) & ":" & minute(now) & ":" & second(now) & ": " & logMessage) logFile.CloseEnd Function'logPrint("this is log")Public Function ErrorHandle() If Err.Number <> 0 Then logPrint "Error Num: " & Err.Number & "; Error Src: " & Err.Source & "; Error Desc: " & Err.Description Err.Clear End IfEnd Function 3、脚本代码片段，完整代码请见工程源码
option explicit '规范声明'定义变量Dim ProjectDir '根目录Dim TestSetExcelFile '测试用例Excel路径Dim vbprpDuserUserCode1'定义用户名Dim vbprpDuserUserCode2'定义用户名Dim vbprpDuserPassword'定义密码Dim row_count ' Global中用例行数Dim rownum ' 当前运行的行Dim sqlstrm 'sql查询变量Dim keyname '数据库字段Dim TestCasesFileDim SheetNameExcelDim isRunDim StartTimeDim EndTimeDim inRespTimeDim n '定义循环变量Dim vbprpNRegistReportorName1'定义客户名Dim vbprpNRegistReportorName'定义客户姓名Dim vbprpNRegistDamageAddress'定义出险地点Dim vbprpNRegistDamageCourse'定义出险过程Dim vbprpNRegistCarDriverPhoneNumber'定义客户联系方式Dim vbprpNRegistCarDrivingLicenseNo'客户证件号Dim vbprpNRegistCarDrivingLicenseNo2'三者证件号Dim vbprpNRegistCarDriverPhoneNumber2'三者联系方式Dim vbprpNRegistCarReportLoss'定义报损金额Dim vbBAOANNum1'定义商业险报案号Dim vbBAOANNum2'定义交强险报案号Dim vbJIEANNumDim vbJIEANNum1Dim vbBAODANNum1'定义保单号Dim vbBAODANNum2Dim vbOutHospDateDim vbAccountCodeDim accountcodeDim vbSHUNum'计算书号Dim vbPEIANNum'赔案号Dim vbSHUNum1Dim vbPEIANNum1Dim vbSHIGUNum'定义事故号Dim vbscheduleDeptCode'定义客户二账户名Dim vbLicenseNo'定义车牌号Dim JBYXSJ'定义日期'参数赋值'定义项目所在的根目录ProjectDir = getParentFolderPath(Environment.Value("TestDir")) '项目所在的根目录，'msgbox ProjectDirExtern.Declare micVoid,"capture",ProjectDir&"CreateBitmap.dll","",micString'将用例转化为中间表TestCasesFile = ProjectDir&"TEST.xls" '管理所有测试用例的Excel文件的路径'msgbox TestCasesFileSheetNameExcel = "Sheet1"Call carinsured()Function carinsured()JBYXSJ = FormateDateTime(date(),"3")vbOutHospDate = date+3Call DataTable.ImportSheet(TestCasesFile,"Sheet1","Global")row_count = DataTable.GetSheet("Global").GetRowCount'得到用例中总行数'msgbox row_count'此处添加循环For n = 1 to row_countDataTable.GetSheet("Global").SetCurrentRow(n)datatable.Export ProjectDir&JBYXSJ&"流程验证结果.xls" '导出运行结果，生成result.xls文件'导入中间表TestSetExcelFile = ProjectDir&JBYXSJ&"流程验证结果.xls" '管理所有测试用例的Excel文件的路径Call DataTable.ImportSheet(TestSetExcelFile,"Global","Global")'row_count = DataTable.GetSheet("Global").GetRowCount'得到用例中总行数isRun=DataTable.Value("RUN", "Global")If isRun = "Y" Then rowNum = datatable.GetSheet("Global").GetCurrentRow' msgbox rowNumvbprpDuserUserCode1 = DataTable("帐号一","Global")vbprpDuserUserCode2 = DataTable("帐号二","Global")vbprpDuserPassword = DataTable("用户密码","Global")vbprpNRegistReportorName = DataTable("客户姓名","Global")vbprpNRegistDamageAddress = DataTable("出险地点","Global")vbprpNRegistDamageCourse = DataTable("出险经过","Global")vbprpNRegistCarDriverPhoneNumber = DataTable("客户联系电话","Global")vbprpNRegistCarDrivingLicenseNo = DataTable("客户证件号码","Global")vbLicenseNo = DataTable("客户车牌号","Global")vbprpNRegistCarReportLoss = DataTable("报损金额","Global")...... '调用用户自定义的逻辑代码DataTable("流程是否通过") = "是"DataTable("备注") = "流程全部通过"datatable.ExportSheet ProjectDir&JBYXSJ&"流程验证结果.xls","Global" '导出运行结果，生成result.xls文件closeie()End IfNextEnd FUNCTION