zoukankan      html  css  js  c++  java
  • QTP的那些事—QTP11+QC11框架整理源码(个人原创)2012615更新版

    最新可用的源码更新如下(主要修改了对应的EXCEL的操作,修改为了单例模式进行操作EXCEL对象,使得操作excel更加的快速,而且有效);

    源码如下:(本框架本博客版权所有,未经本人许可不得用于其他商业用途,转载请注明出处.谢谢)

    '*******************************************************************************************
    '功能:新建一个excel文件
    '参数:无
    '返回值:创建一个excelapp的进程
    '作者:judd
    '*******************************************************************************************
    Function CreateExcel() 'As Excel.Application
        Dim excelSheet 'As Excel.worksheet
        Set ExcelApp = CreateObject("Excel.Application") 'Create a new excel Object
       ' ExcelApp.Workbooks.Add
        ExcelApp.Visible = false
        ExcelApp.AlertBeforeOverwriting=false
        Set CreateExcel = ExcelApp
    End Function
    
    '*******************************************************************************************
    '功能:得到对应的指定文件的sheet实例对象
    '参数:打开对应的一个excelapp进程对应的sheet名称
    '返回值:excelapp的一个sheet对象
    '作者:judd
    '*******************************************************************************************
    Function GetSheet(ExcelApp,sheetindex,pathtpe,filename) 'As Excel.worksheet
             On Error Resume Next
             testpath=getFilePath(pathtype,filename)    '获取需要写入的文件的路径
            ExcelApp.Visible=False
            Set GetSheet=ExcelApp.Workbooks.Open(testpath).Worksheets(sheetindex)
           On Error GoTo 0
    End Function
    '*******************************************************************************************
    '功能:对excel中写入值
    '参数:对应的excelapp的一个sheet的实例对象xlswork,sheet对象,x,行数,y,列数,values,对应的写入的值
    '返回值:无
    '作者:judd
    '*******************************************************************************************
    
    Function writeExcelDatas(xlswork,x,y,values)
        On error resume next
            '    xlswork.Worksheets(sheetindex).Activate
                xlswork.cells(x,y)=values
       On Error GoTo 0
    End Function
    
    
    '*******************************************************************************************
    '功能:获取excel中指定的单元格中的数据
    '参数:testpath表示需要写入数据的excel的路径,sheetname表示需要写入的excel的sheet名称,x代表excel代表单元格中的行,y代表单元格中的列
    '返回值:获取你所需指定的单元格的值
    '作者:judd
    '*******************************************************************************************
    
    Function readExcelDatas(xlswork,row,columny)
         value = 0
         Err = 0
         On Error Resume Next
         tempValue = xlswork.Cells(row, columny)
         If Err = 0 Then
            lastvalue = tempValue
            Err = 0
        End If
        On Error GoTo 0
        readExcelDatas = lastvalue
       ' MsgBox "successbox"
    End Function
    
    
    '*******************************************************************************************
    '功能:删除对应的excel中的指定的行
    '参数:xlswork指定的sheet对象,rownum指定的行数
    '返回值:null
    '作者:judd
    '*******************************************************************************************
    Function deleterow(xlswork,rownum)
               xlswork.rows(rownum).delete
    End Function
    'openAndWriteExcel "d:\maybe.xlsx",1,1,"abcziptestdddddddddddddddd"
    '*******************************************************************************************
    '功能:关闭excelapp进程
    '参数:excelapp对应的是excel的进程对象
    '返回值:无
    '作者:judd
    '*******************************************************************************************
    Sub CloseExcel(ExcelApp)
        Set excelSheet = ExcelApp.ActiveSheet
        Set excelBook = ExcelApp.ActiveWorkbook
        Set fso = CreateObject("Scripting.FileSystemObject")
        On Error Resume Next
        fso.CreateFolder "C:\Temp"
        fso.DeleteFile "C:\Temp\ExcelExamples.xls"
        excelBook.SaveAs "C:\Temp\ExcelExamples.xls"
        ExcelApp.Quit
        Set ExcelApp = Nothing
        Set fso = Nothing
        Err = 0
        On Error GoTo 0
    End Sub
    
    '*******************************************************************************************
    '功能:保存已经实现的excel进程实例的sheet对象
    '参数:excelApp表示对应的excel进程对象,workbookIdentifier 表示sheet的id,path表示临时保存的excel的路径,可不写为空字符
    '返回值:无
    '作者:judd
    '*******************************************************************************************
    Function SaveWorkbook(ExcelApp, workbookIdentifier, path) 'As String
        Dim workbook 'As Excel.workbook
        On Error Resume Next
        Set workbook = ExcelApp.Workbooks(workbookIdentifier)
        On Error GoTo 0
        If Not workbook Is Nothing Then
            If path = "" Or path = workbook.FullName Or path = workbook.Name Then
                workbook.Save
            Else
                Set fso = CreateObject("Scripting.FileSystemObject")
     
                'if the path has no file extension then add the 'xls' extension
                If InStr(path, ".") = 0 Then
                    path = path & ".xls"
                End If
     
                On Error Resume Next
                fso.DeleteFile path
                Set fso = Nothing
                Err = 0
                On Error GoTo 0
                workbook.SaveAs path
            End If
            SaveWorkbook = "OK"
        Else
            SaveWorkbook = "Bad Workbook Identifier"
        End If
    End Function
    
    '*******************************************************************************************
    '功能:比较两个excel的sheet的内容是否一致
    '参数:sheet1,第一个sheet的实例sheet2第二个sheet的实例对象 startColumn第几列 numberOfColumns共计多少列 startRow, 第几行numberOfRows,共计有多少行trimed是否忽略空格
    '返回值:无
    '作者:judd
    '*******************************************************************************************
    
    
    Function CompareSheets(expectsheet, actualsheet, startColumn, numberOfColumns, startRow, numberOfRows, trimed) 'As Boolean
        Dim returnVal 'As Boolean
        Dim totaldatas
        totaldatas=numberOfColumns*numberOfRows
        print "共计有多少数据"&totaldatas
        returnVal = true
        'In case that one of the sheets doesn't exists, don't continue the process
        If expectsheet Is Nothing Or actualsheet Is Nothing Then
            CompareSheets = false
    'reportResult(teststep, expectvalue, actualvalue)
            reportResult "比较对应的测试结果的两个sheet内容","两个sheet内容存在","两个sheet的内容为空,请确认sheet后再操作"
    
             Exit Function
        End If
     
        'loop through the table and fill values into the two worksheets
        For r = startRow to (startRow + (numberOfRows - 1))
            For c = startColumn to (startColumn + (numberOfColumns - 1))
                Value1 = expectsheet.Cells(r, c)
                Value2 = actualsheet.Cells(r, c)
     
                'if 'trimed' equels True then used would like to ignore blank spaces
                If trimed Then
                    Value1 = Trim(Value1)
                    
                    Value2 = Trim(Value2)
    
                End If
               print "value expect:"&Value1
               print "value acutal:"&Value2
                'in case that the values of a cell are not equel in the two worksheets
                'create an indicator that the values are not equel and set return value
                'to False
                If Value1 <> Value2 Then
                    Dim cell 'As Excel.Range
                '    print  "运行的[实际结果为:]" & Value2 & "'[,预期结果为:]" & Value1 
                    reportResult "Failed:比较sheet对应的单元格值",Value1, Value2
                    expectsheet.cells(r, c) = "此处结果为:[" & Value1 & "],实际结果为:[" & Value2&"]"
                    Set cell = expectsheet.cells(r, c)
            '        print "当前运行"&r&"第列"&c
                    cell.Font.Color = vbRed
                     returnVal = False
                 else
                      reportResult "PASS:比较sheet对应的单元格值",Value1, Value2
                End If
            Next
        Next
        CompareSheets = returnVal
    End Function 
    '
    'MsgBox(getCellDatas("d:\maybe.xlsx",1,1))
    '*******************************************************************************************
    '功能:获取excel文件的路径
    '参数:path代表excel文件名
    '返回值:获取excel文件的绝对路径
    '作者:
    '*******************************************************************************************
    
    'Function findPath(path)
    '   findPath=pathfinder.Locate(path)
    'End Function
    
    '字符串截取特殊字符重新生成所需新的字符串
    '*******************************************************************************************
    '功能:时间字符串格式转换
    '参数:str代表时间字符串,formatdata代表需要截取的字符
    '返回值:获取你所需指定的单元格的值
    '作者:judd
    '*******************************************************************************************
    
    Function joinString(teststring,formatdata)
            converstr=Split(teststring,formatdata,-1,1)
            mystring=join(converstr,"")
            joinString=mystring
    End function
    
    '时间格式化操作函数
    '*******************************************************************************************
    '功能:将vb的时间设置成固定的格式后
    '参数:str代表时间字符串,formatdata代表需要截取的方式,
    '返回值:获取你所需指定的单元格的值
    '作者:judd
    '*******************************************************************************************
    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   时间格式为:HH:mm:ss 
                case   "5" 
                sendTime   =  right( "00"&hour(sendTime),2)&":"&right( "00"&minute(sendTime),2)&":"&right( "00"&second(sendTime),2) 
                end   select   
            '    If error.number>0 Then
                'reportResult(teststep, expectvalue, actualvalue)
                   '   reportResult "时间日期转换函数","转换成功","转换成功"
                
                'End If
                FormateDateTime   =   SendTime 
    end   Function 
    
    '*******************************************************************************************
    
    '功能:发送邮件通知执行步骤
    '参数:sentto表示需要发送的人,subject邮件的主题,body邮件需要发送的内容,attachment表示邮件的附件的路径
    '返回值:无
    '作者:
    '*******************************************************************************************
    Function SendMail(SendTo, Subject, Body, Attachment) 
    
        Set ol=CreateObject("Outlook.Application") 
        Set Mail=ol.CreateItem(0) 
            Mail.to=SendTo 
            Mail.Subject=Subject 
            Mail.Body=Body 
            If (Attachment <> "") Then 
                Mail.Attachments.Add(Attachment) 
            End If 
            Mail.Send 
            ol.Quit 
        Set Mail = Nothing 
        Set ol = Nothing 
    End Function 
    
    
    '*******************************************************************************************
    
    '功能:打印QTP的报告
    '参数:teststep表示在QTP的报告中报告的步骤,expectvalue表示预期的测试执行结果,actualvalue表示实际的测试执行结果
    '返回值;
    '作者:
    '*******************************************************************************************
    Function reportResult(teststep,expectvalue, actualvalue)
       On error resume next
       'expectvalue="exp_"&actualvalue
       finaltime=FormateDateTime(now(),"5")
       timestamp=mid(finaltime,4,2)+mid(finaltime,7,2)
       resultpath=environment.Value("RunImgs")
       'listpath=resultpath&"\"&teststep&"---"&timestamp&".png"
       rndnum=getRandNum(1,10)
       imgpath=resultpath&"\"&teststep&"截图--"&timestamp&rndnum&".png"
       finalexpect=trim(expectvalue)
       finalactual=trim(actualvalue)
       '打印当前运行的状态。。
        writeLogs teststep
        desktop.CaptureBitmap imgpath
       'Reporter.ReportEvent micDone,"当前测试内容【"&teststep&"】,列表如下:","测试执行开始!!!",imgpath
       If finalexpect=finalactual Then
           'desktop.CaptureBitmap imgpath
           Reporter.ReportEvent micPass,"当前的测试步骤为-【"&teststep&"】-执行成功!","当前的测试用例结果:"&",预期的测试结果为【"&finalexpect&"】,实际的测试结果为【"&finalactual&"】,与预期结果相同"&vbcrlf&"测试执行通过---PASS",imgpath
      else 
          ' desktop.CaptureBitmap imgpath
           Reporter.ReportEvent micFail,"当前的测试步骤为-【"&teststep&"】-执行失败!","当前的测试用例结果:"&",预期的测试结果为【"&finalexpect&"】,实际的测试结果为【"&finalactual&"】,与结果不相同"&vbcrlf&"测试执行失败---FAILED",imgpath
                  '      SendMail "charilyhu@gmail.com","测试执行步骤","执行步骤"&teststep,""
      End If
    End Function
    '*******************************************************************************************
    '功能:在指定的已有的excel中插入一个sheet,最大支持45列(注意)
    '参数:filename表示excel的名称,oldsheetname表示需要excel文件中的第一个sheet的名称,templatefilename表示需要导入excel中的sheet的模板excel文件名称,支持模糊匹配
    'templatefsheetname表示导入excel中的sheet的模板excel文件的sheet名称
    '返回值:
    '*******************************************************************************************
    Function InsertNewSheet(pathtype,filename,oldsheetname,templatefilename,templatesheetindex)
       On error resume next
        Dim workbook 'As Excel.workbook
        Dim worksheet 'As Excel.worksheet
        excelpath=getFilePath(pathtype,filename)
        '如果指定的工作薄不存在,将在当前激活状态的工作表中添加工作表
        'print excelpath
        Set ExcelApp=CreateObject("excel.application")
        Set xlwork=ExcelApp.Workbooks.Open(excelpath)
        Set workbook = ExcelApp.ActiveWorkbook
        sheetCount = workbook.Sheets.Count '获取工作薄中工作表的数量
        Set tname=ExcelApp.Worksheets.Item(1) '得到第一个sheet名称
    '    Debug.Write tname.name
        If (tname.name=oldsheetname) Then
             Set worksheet=workbook.Sheets.Add(, workbook.Sheets(sheetCount)) '添加工作表
    '         Set worksheet = workbook.Sheets(sheetCount + 1) '初始化worksheet为新添加的工作表对象    
           ' =  '初始化worksheet为新添加的工作表对象
            '设置新添加的工作表名称
             temppath=getFilePath(pathtype,templatefilename)
            ' rownum=getRowRange(temppath,templatesheetindex)   'excel中的可用的行数,此处的调用会弹出excel对象重用的问题,所有不考虑使用这种方式
             Set tempwork=ExcelApp.Workbooks.Open(temppath)
              rownum=ExcelApp.Worksheets(templatesheetindex).usedrange.rows.count
              getvalue=ExcelApp.Worksheets(templatesheetindex).usedrange.range("A1:AT"&rownum).value   '得到可用区域的所有的表格的内容数组
             For testrow=1 to rownum
                For valuecol=1 to 45
                          worksheet.cells(testrow,valuecol)=getvalue(testrow,valuecol)
                Next
            Next
              
                If oldsheetname <> "" Then
                    worksheet.Name = oldsheetName&sheetCount
                     InsertNewWorksheet = worksheet.Name
                End If
           Else
            reportProgress "文件sheet名称不存在,出现错误",2    
           End if           
    '    ExcelApp.c
        ExcelApp.DisplayAlerts=false
         ExcelApp.SaveWorkspace
         ExcelApp.Save
         workbook.Close
         Set ExcelApp=Nothing
        
    End Function
    '*******************************************************************************************
    '
    '功能:通过QTP的自身的环境变量进行确认相关的需要的路径
    '参数:需要查询的文件的路径的文件名称,pathtype表示查询路径的类型,可选的是0,1,2,3,4
    '返回值:返回查询文件的绝对路径
    '*******************************************************************************************
    Function  getFilePath(pathtype,filename)
    
            On error resume next
            Set tfso=createobject("scripting.filesystemobject")
            testfiles=environment.Value("RunLogs")
            If pathtype=0 Then
                 datapath=environment.Value("TestPath")
            elseif pathtype=1 then
                 datapath=environment.Value("InputData")
            elseif pathtype=2 then
                 datapath=environment.Value("OutputData")
            elseif pathtype=3 then
                 datapath=environment.Value("RunImgs")
            elseif pathtype=4 then
                 datapath=environment.Value("RunLogs")
            else 
                 datapath=environment.Value("TestPath")
            End If
            tempFilePath datapath,filename   '引入的下面的文件的遍历操作
            set openfile=tfso.OpenTextFile(testfiles&"\FilePaths.txt")
            getFilePath=trim(openfile.ReadLine)  '读取临时的log文件中的第一行的路径名称
             openfile.Close
            Set openfile=nothing
            Set fso=nothing
    
    End Function
    '*******************************************************************************************
    '
    '功能:遍历环境变量中预设的数据值路径,然后过滤找到指定的文件名,并存放在text文件中
    '参数:datapath表示查找文件的路径,filename表示需要查找的文件名称
    '返回值:无
    '*******************************************************************************************
    Function tempFilePath(datapath,filename)
       On error resume next
       Set fso=createobject("scripting.filesystemobject")
      bfile=trim(filename)
       If fso.FolderExists(datapath) Then
           Set firstsub=fso.GetFolder(datapath)
           For each testfolder in firstsub.SubFolders
               strpath=datapath&"\"&testfolder.name
               tempFilePath strpath,filename
           Next
           For each testfile in firstsub.Files
             ' print trim(testfile.name)
        '      print instr(1,trim(testfile.name),bfile,1)
               If instr(1,testfile.name,trim(filename),1)>0 Then
                      logpath=environment.Value("RunLogs")
                    'If not fso.FileExists(logpath&"\FilePaths.txt") Then
                        set logfile=fso.CreateTextFile(logpath&"\FilePaths.txt",true)
                        logfile.WriteLine testfile.path
                        logfile.Close
                       Set logfile=nothing
        ' Set firstsub=nothing
                       Set fso=nothing
                       Exit function 
                else
                    'ReportProgress(Text, Title, TimeOut)
                     'ReportProgress "在指定的路径下没有找到你需要的文件"
                    '  logfile.WriteLine testfile.path
                  '    logfile.Close
                   '   Set logfile=nothing
        ' Set firstsub=nothing
                   '   Set fso=nothing
                '   print "没有找到对象啊"
               End If
           Next
        else
          'ReportProgress(Text, Title, TimeOut)
                reportProgress "enviroment文件中的测试路径找不到,请确认你的environment文件正确配置或者加载到QTP中,使用loadQTPXML方法进行加载XML文件到QTP中!",2
            '     logfile.WriteLine testfile.path
                logfile.Close
                Set logfile=nothing
        ' Set firstsub=nothing
                 Set fso=nothing
       End If
         
    End Function
    
    'Function: LoadDictionary
    'Website: http://KnowledgeInbox.com
    'Author: Tarun Lalwani
    'Description: Load Dictionary object from a XML file
    'Parameters:
    '@oDic: The Dictionary object in which the values need to be loaded
    '@FileName: The XMLfile path from where the dictionary needs to be loaded
    'Return value:
    'The oDic dictionary object
     
    Function LoadDictionary(oDic, FileName)
        'Exit if the file doesn't exist
        If Not CreateObject("Scripting.FileSystemObject").FileExists(FileName) Then Exit Function
        Dim allKeys, sKey
     
        allKeys = oDic.Keys
     
        'Load the XMLfile
        Set oXML = XMLutil.CreateXMLFromFile (FileName)
        Set oRoot = oXML.GetRootElement
     
        'Load all XML variables
        Set allElements = oRoot.ChildElementsByPath("//Variable")
        Dim oElement
     
        'Enumerate and populate each dictionary key
        For i = 1 to allElements.Count
            Set oElement = allElements.Item(i)
            sKey = oElement.ChildElementsByPath("Name").Item(1).CDATASections.Item(1)
            sValue = oElement.ChildElementsByPath("Value").Item(1).CDATASections.Item(1)
            oDic(sKey) = sValue
        Next
    End Function
     
     
    'Function: LoadDictionary
    'Website: http://KnowledgeInbox.com
    'Author: Tarun Lalwani
    'Description: Save dictionary object to a XML file
    'Parameters:
    '@oDic: The Dictionary object for which the values need to be exported as XML
    '@FileName: The XMLfile path where the dictionary needs to be saved
    'Return value:
    'The oDic dictionary object
    
    '
    ''
    '
    '
    Function saveDIC(words)
       Dim WshShell
       Set WshShell =CreateObject("WScript.Shell")
       
       WshShell.RegWrite "HKCU/Software/Mercury Interactive/QuickTest Professional/MicTest/ReservedObjects/GlobalDictionary/ProgID", "Scripting.Dictionary","REG_SZ"
        Set WshShell = Nothing
        GlobalDictionary.RemoveAll
        GlobalDictionary.Add "name",words
      ' saveDIC=mydic.Item("name")
    End Function
    
    '*******************************************************************************************
    '功能:在excel中查找一个特定的字符
    '参数:testpath表示excel路径,x,y代表查找的单元格的行和列,newvalues是查找的字符
    '返回值:查找到的sheet的名称
    '作者:judd
    '*******************************************************************************************
    
    Function findSheetOfWords(pathtype,filename,x,y,words)
       On error resume next
       testpath=getFilePath(pathtype,filename)
       Set excelapp=createobject("excel.application")
       set xlswork=excelapp.Workbooks.Open(testpath)
       Set activework=excelapp.ActiveWorkbook
       sheetnum=activework.sheets.count
       For sheeta=1 to sheetnum
                  tempdata=trim(activework.sheets(sheeta).cells(x,y))
                  if instr(1,tempdata,trim(words),1)<>0  then
                     'reportResult(teststep, expectvalue, actualvalue)
                       reportResult "在excel中查找字符","查找到期望字符","查找到期望字符"
                        sheetnames=activework.Sheets(sheeta).name
                        Exit for
                    else
                       sheetnames="0"
                       reportResult "在excel中查找字符","能查找到期望字符","没有查找到期望的字符"
                  end if
       Next
      findSheetOfWords=sheetnames
      xlswork.Save
      xlswork.Close
      Set excelapp=nothing
    
    End Function
    
    
    
    '*******************************************************************************************
    '功能:测试用,观察当前运行的测试执行情况
    '参数:text表示运行的弹出的提醒的文本,timeout表示等待的时候,如果在等待的时候内,对弹出窗口没有响应,则会自动关闭
    '返回值:无
    '作者:
    
    '*******************************************************************************************
    Public Sub reportProgress (Text, TimeOut) 
        Set WshShell = CreateObject("WScript.Shell") 
        WshShell.Popup Text, TimeOut, "测试执行过程观察器"
    
    End Sub 
    
    '*******************************************************************************************
    '功能:导入运行中的excel数据到datatable中
    '参数:filename表示指定的需要导入当前的action的名称,支持模糊输入,sheetindex表示excel的sheet的索引,srcsheetname表示需要导入的datatable对象中的sheet名称
    '返回值:无
    '作者:judd
    
    '*******************************************************************************************
    Function  importDatatable(pathtype,filename,sheetindex,srcsheetname)
    'findPathByEnv(filename, pathtype)
       excelpath=getFilePath(pathtype,filename)
       datatable.ImportSheet excelpath,sheetindex,srcsheetname
    End Function
    
    
    
    
    '*******************************************************************************************
    '功能:获得excel的可用区域行数
    '参数:filename表示excel文件的名称,支持模糊输入,sheetindex表示excel的sheet的索引数
    '返回值:excel中可用的行数(带有数据的)
    '作者:judd
    '*******************************************************************************************
    Function getRowRange(xlswork)
         On error resume next
         totalrow=xlswork.usedrange.rows.count
         getRowRange=totalrow
    End Function
    
    '*******************************************************************************************
    '功能:清空指定的sheet的第二行起的所有内容
    '参数:filename表示需要清空的excel文件名称,支持模糊文件名称,sheetindex表示需要清空的excel的sheet的索引
    '返回值:无
    '作者:
    
    '*******************************************************************************************
    Function clearSheetContent(pathtype,filename,sheetindex)
        On error resume next
       excelpath=getFilePath(pathtype,filename)  '获取指定文件的完整路径
       Set excelapps=CreateObject("Excel.Application")
       excelapps.Visible=false    '将excel对象隐藏不要显示打开
       Set xlsworks=excelapps.Workbooks.Open(excelpath)
       Set xlssheets=xlsworks.Worksheets(sheetindex)   '获得sheet对象
        trows=xlssheets.usedrange.rows.count '获得excel中的有数据的行数
            'xlssheets.usedrange.clear   全部删除内容
           ' xlssheets.Rows(rowt).Delete
        xlssheets.Range( "A1:AI"&trows).clear
       excelapps.Application.DisplayAlerts=false
        xlsworks.Save
        xlsworks.Close
       excelapps.Quit
        Set excelapps=Nothing
    End Function
    '*******************************************************************************************
    '功能:运行进程中是否存在某进程,如果有返回true,没有返回false
    '参数:processname:进程名
    '返回值:true:有该进程,false:没有该进程
    '作者:judd
    
    '*******************************************************************************************
    
    Function existProcess(processname)
        on error resume next
        set y=getobject("winmgmts:\\.\root\cimv2")  'wmi调用的方式
        set ws=createobject("wscript.shell")
        set x=y.execquery("select * from win32_process")   '查询数据表
        
        for each i in x
            'ReportProgress(Text, Title, TimeOut)
            'print i.name
            If instr(1,i.Name,processname,1)<>0 Then    
    
                '     ReportProgress  i.name&"进程存在,测试需要关闭该进程,请尽快保存该进程对应的文件,系统将在10秒内强制关闭该进程",10
                     existProcess=true        
                     Exit function 
            else
                   existProcess=false
             End If
        next
        reporter.ReportEvent micDone,"判断是否存在"&processname&"进程","该进程不存在"
        'existProcess=false
    End Function
    '*******************************************************************************************
    '功能:获得当前脚本运行机器的IP地址
    '参数:无
    '返回值:运行脚本的机器的IP地址
    '作者:judd
    
    '*******************************************************************************************
    Function getIP()  
        Set WshShell = CreateObject("WScript.Shell")
        Set oExec = WshShell.Exec("ipconfig.exe")
        Set oStdOut = oExec.StdOut
        ip = ""
        Do Until oStdOut.AtEndOfStream
            strLine = oStdOut.ReadLine
            If InStr(strLine, "本地连接") > 0 Then
                strLine = oStdOut.ReadLine
                strLine = oStdOut.ReadLine
                strLine = oStdOut.ReadLine
                ip = Mid(strLine, InStr(strLine, ":") + 2)
                ip=replace(ip,vbCrLf,"")
                Exit Do
            End If
        Loop
        
        If ip = "" Then
            reporter.ReportEvent micFail,"获取执行机器IP地址","获取IP地址失败"
            getIP=null
        Else
            getIP=trim(ip)
        End If
    
    End Function
    
    
    '*******************************************************************************************
    '功能:加载XML文件
    '参数:ip表示共享存放文件的机器IP地址,xmlfilename表示加载的xml文件名称
    '返回值:无
    '作者:judd
    
    '*******************************************************************************************
    Function loadQTPXML(ip,xmlfilename)
       filepath="\\"&ip&"\ScriptDatas\XML\"&xmlfilename
       'envs=environment.Value("TestPath")
    'reportResult(teststep, expectvalue, actualvalue)
                   environment.LoadFromFile(filepath)
            
                '  reportResult  "加载xml到环境中","加载成功","xml已经加载在环境中了"
    
    End Function
    
    '*******************************************************************************************
    '功能:获得web对象中的table对象的表头列所对应的列号
    '参数:obj参数表示table对象,textid表示table的标头列所在的行数,indextext表示标头列的文本,支持模糊匹配
    '返回值:所在的列数
    '作者:judd
    
    '*******************************************************************************************
    
    Function getTableColumn(obj,textid,indextext)
            Set Table=obj
            For i=1 to Table.ColumnCount(textid)
                'print "ttt:"&Table.GetCellData(textid,i)
                If instr(1,Table.GetCellData(textid,i),indextext,1)<>0 then
                    columnid=i
                    Exit for
                else    
                    columnid=0
                end if 
            next
            getTableColumn=columnid
            Set Table=nothing
    End Function
    '*******************************************************************************************
    '功能:获得web对象中的table对象的表头列所对应的文本数组
    '参数:obj参数表示table对象,textid表示table的标头列所在的行数,indextext表示标头列的文本,支持模糊匹配
    '返回值:所有的列头的文本数组对象
    '作者:judd
    
    '*******************************************************************************************
    Function getTableIndexText(obj,textid)
           On error resume next
            Set Table=obj
            Set textdic=createobject("scripting.dictionary")
            For i=1 to Table.ColumnCount(textid)
                textdic.Add i,Table.GetCellData(textid,i)
            next
            getTableIndexText=textdic.Items
            Set textdic=nothing
            Set Table=nothing
    End Function
    
    '*******************************************************************************************
    '功能:生成不同的action之间传值的一个全局对象
    '参数:无
    '返回值:无
    '作者:judd
    '使用实例:直接在QTP中使用DataDic即可使用该字典对象
    
    '*******************************************************************************************
    
    
    Function registerData()
       On error resume next
         Set WshShell=createobject("wscript.shell")
         WshShell.RegWrite "HKCU\Software\Mercury Interactive\QuickTest Professional\MicTest\ReservedObjects\DataDic\ProgID", "Scripting.Dictionary","REG_SZ"
         Set WshShell = Nothing
          DataDic.RemoveAll
    End Function
    '*******************************************************************************************
    '功能:将打印日志在text文件中
    '参数:teststep表示需要打印的日志内容
    '返回值:无
    
    '*******************************************************************************************
    Function writeLogs(teststep)
      Const ForReading = 1, ForWriting = 2, ForAppending = 8
       Dim fso, f
       Set fso = CreateObject("Scripting.FileSystemObject")
       filepath=environment.Value("RunLogs")&"\"&teststep&"_"&formateDateTime(now,1)&".txt"
       Set f = fso.OpenTextFile(filepath, ForAppending, True)
       f.Writeline cstr(now())&"     当前测试步骤为:"&teststep
       f.Close
    End Function
    
    
    '*******************************************************************************************
    '功能:将打印日志在text文件中
    '参数:teststep表示需要打印的日志内容
    '返回值:无
    
    '*******************************************************************************************
    Function writeDetailLogs(filename,teststep,inputdata)
      Const ForReading = 1, ForWriting = 2, ForAppending = 8
       Dim fso, f
       Set fso = CreateObject("Scripting.FileSystemObject")
       filepath=environment.Value("RunLogs")&"\"&filename&".txt"
       Set f = fso.OpenTextFile(filepath, ForAppending, True)
       f.Writeline cstr(now())&"     当前测试步骤为:"&teststep
       f.WriteLine "'*******************************************************************************************'***********************************************************************************"
       f.WriteLine inputdata   
       f.WriteLine "'*******************************************************************************************'***********************************************************************************"
       f.Close
    End Function
    
    
    '*******************************************************************************************
    '功能:随机函数生成
    '输入值:生成值范围 i~j
    '返回值:随机数
    '*******************************************************************************************
    Public Function getRandNum(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
           getRandNum=MyValue
          End If
    End Function
    
    '*******************************************************************************************
    '功能:随机生成一定长度的字符串
    '输入值:需要生成的字符串的长度
    '返回值:字符串
    '作者:judd
    '*******************************************************************************************
    Function randomString(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=getRandNum(0,35)
            B = A(x)
            randomString =randomString +B
        Next
            randomString = randomString
        else
            msgbox ("只接受数字输入")
        End If
    End Function
    
    '*******************************************************************************************
    '功能:加载页面,等待页面显示
    '输入值:frameobj表示iframe对象,
    '返回值:无
    '作者:judd
    '*******************************************************************************************
    Function loadIFame(frameobj)
       Set myframe=frameobj
       While not myframe.exist(1)
            wait 3
       Wend
    End Function
    
    
    '*******************************************************************************************
    '功能:导航页面到指定的页面中
    '输入值:url表示需要导航的页面的地址
    '返回值:无
    '作者:judd
    '*******************************************************************************************
    Function navigateURL(url)
        'existProcess(processname)
          isie=existProcess("iexplore.exe")   '关闭IE进程
          If isie=True Then
              isclosed=systemutil.CloseProcessByName("iexplore.exe")
              If typename(isclosed)="Long" Then
    'reportResult(teststep, expectvalue, actualvalue)
                    reportResult "关闭IE进程中","关闭成功","关闭成功"&isclosed
               else
            'reportResult(teststep, expectvalue, actualvalue)
                      reportResult "关闭IE进程中","关闭成功","关闭失败"&isclosed
        
              End If
          End If
          wait  5
           systemutil.Run "iexplore.exe",url,"","",3
    End Function
    
    '*******************************************************************************************
    ' 函 数名: CloseBrowsers
    ' 功能说明: 关闭所有IE浏览器
    ' 参  数 1: 无
    ' 返 回值: 无
    ' 附加说明: 无
    ' 举例说明: CloseBrowsers()
    '*******************************************************************************************
    
    Public Function CloseBrowsers()
        On Error Resume Next
        If Browser("micclass:=Browser").Exist (0) Then
             Browser("micclass:=Browser").Close
        End If
        While Browser("micclass:=Browser", "index:=1").Exist (0)
             Browser("index:=1").Close
        Wend
        If Browser("micclass:=Browser").Exist (0) Then'再次关闭IE,防止前面过程还有IE没有关闭掉
            Browser("micclass:=Browser").Close
        End If
        CloseBrowsers = true
    End Function
    
    '*******************************************************************************************
    '功能:值交换函数
    '参数:a第一个数,b第二个数
    '返回值:无
    '作者:
    '*******************************************************************************************
    Public Sub swapNumbers(byref a,byref b)
        Dim c
        c = a
        a = b
        b = c
    End Sub 
    '*******************************************************************************************
    '功能:去掉字符串中的重复项
    '参数:inp字符串,sp重复的字符
    '返回值:无重复的字符串
    '作者:judd
    '*******************************************************************************************
    
    Function NoRepeat(Inp,Sp)
    Dim aa,flag,words,length,i,j,k,sp1,sp2,cc
        aa = Inp
        Do 
            flag = False 
            words = Split(aa,Sp)
            length = UBound(words)
            For i = 0 To (length -1)
                sp1 = words(i)
                For j = (i+1) To length
                    sp2 = words(j)
                    If sp1 = sp2 Then
                        flag = True
                        aa = ""
                        For k = 0 To (j-1)
                            aa = aa & words(k) & sp
                        Next
                        For k = (j + 1) To length
                            aa = aa & words(k) & sp
                        Next
                        
                        cc = Len(aa)
                        aa = Left(aa,(cc - 1)) 
                    End If 
                Next 
                If flag = True Then
                    Exit For
                End if
            Next 
        Loop Until flag = false
        NoRepeat = aa
    End Function
    '*******************************************************************************************
    

    作者:高级测试开发网
    博客地址:https://seniortesting.club
    本文版权归作者和博客园共有,欢迎转载,但未经作者同意必须保留此段声明,且在文章页面明显位置给出原文连接,否则保留追究法律责任的权利。

  • 相关阅读:
    [題解]51nod_1515_明辨是非
    任务调度问题(贪心) hdu4864
    B站学习记:贪心与博弈
    poj1505(二分+贪心)
    温故知新:互质排列
    Radar Installation(利用数据有序化进行贪心选择)
    Wooden Sticks(贪心)
    计算a除b的第一位小数 in C++.
    龙龙的暑假贪心算法大冒险
    HDU-2037(贪心)
  • 原文地址:https://www.cnblogs.com/seniortestingdev/p/2551076.html
Copyright © 2011-2022 走看看