QTP自己封装的函数

参考：http://zjjlover.blog.163.com/blog/static/1732090412010101210204549/

常用的Object对象

'文件操作
CreateObject("Scripting.FileSystemObject")
'剪切板
Mercury.Clipboard
'vbs脚本环境
wscript.shell
'操作excel
Excel.Application
'操作数据库
ADODB.Connection

'邮箱

Outlook.Application

'qtp

QuickTest.Application

1、关闭进程

function killprocess(proname)
        Dim wmi,processlist
    Set wmi=GetObject("winmgmts:")
    set processlist = wim.execquery("select * from win32_process where name="&chr(34)&proname&chr(34))
    if not processlist.count="0" then
        systemUtil.CloseProcessByName proname
    End if
    set processlist = nothing
    set wmi = nothing
End Function

  [问题] 有时会发现以上的代码没有效果，查看任务管理器中的进程后，发现没有“iexplore.exe”进程，那IE的进程哪去了呢？因为注册表的一个值的设置，导致IE使用了桌面进程“Explore.exe”。因此，只要修改注册表相应的值，重启IE就可以发现又出现“iexplore.exe”进程了。

       具体做法如下：

把注册表项：

[HKEY_CURRENT_USER/Software/Microsoft/Windows/CurrentVersion/Explorer/BrowseNewProcess]

的键值改为：

BrowseNewProcess='yes'

2、vbs调用qtp脚本（调用文件夹下所有子文件夹的脚本）

用vbs调qtp

'编写自动执行指定的QTP脚本的VBS：
'利用QTP本身的Quicktest.Application 对象
Dim qtApp
Set qtApp = CreateObject ("Quicktest.Application")
qtApp.Launch
qtApp.Visible = True
qtApp.Open "H:\QTP\QTPscript\Test1"
qtApp.Test.Run ,True

例子2：

Dim folderObj,mainfoleder,subfolder,testname
set folderObj = CreateObject("Scripting.FileSystemObject")

mainfolder = folderObj.GetFolder("D:\test")
set subfolder = mianfolder.SubFolders
For each folder in subfolder
    wscript.sleep 1000
    testname = folder.name
    path = "D:\test\"&testname
    if testname = ".svn" then
    else
    ExcQtpScript path,path&"\Res"
    End if
    killprocess("QTAutomationAgent.exe")
    killprocess("iexplore.exe")
Next

Function ExcQtpScript(TestsPath,ResPath)
    KillProcess "QTPro.exe"
    wscript.sleep 2000
    Sim qtApp,qtTest,qtResultsOpt

    Set qtApp = CreateObject("QuickTest.Application")
    sflag = FindProcess("QtAutomationAgent.exe")
    if Ucase(sflag) = "TRUE" then
    Else
        set atApp = nothing
        wscript.sleep 2000
        set atApp = CreateObject("QuickTest.Application")
    End if

    qtApp.Launch
    qtApp.Visible = true

    qtApp.Options.Run.ImageCaptureForTestResults = "OnError"
    qtApp.Options.Run.RunMode = "Fast"
    qtApp.Options.Run.ViewRusults = false
    qtApp.Open TestsPath,True

    qtTest.Settings.Run.InterationMode = "rngItrations"
    qtTest.Settings.Run.StartIteration = 1
    qtTest.Setting.Run.EndIteration = 1

    set qtRestultsOpt = CreateObject("QuickTest.RunResultsOptions")
    qtResultsOpt.ResultsLocation = ResPath
    qtTest.Close

    set qtRestultsOpt = nothing
    set qtTest = nothing
    set qtApp = nothing
    killprocess "QTPro.exe"
End Function

Function FindProcess(byval processname)
    FindProcess = false
    set shell = CreateObject ("Wscript.shell")
    set shellResult = shell.Exec("TaskList")
    
    While Not ShellResult.StdOut.AtEndOfStream
    if Instr(Ucase(shellResult.StdOut.ReadLine),Ucase(processname)) then
    FindProcess = true
    exit function
    End if
    Wend
End Function

3、操作数据库  参考：http://blog.csdn.net/zzzmmmkkk/article/details/5947390

'获取数据

Provider=OraOLEDB.Oracle.1;Persist Security Info=False;User ID=test;;Password=test;Data Source=192.168.13.19

Dim Cnn  '定义一个数据库连接串
Set Cnn = CreateObject("ADODB.Connection")
Cnn.ConnectionString ="Provider=OraOLEDB.Oracle.1;Persist Security Info=False;User ID=test;Password=test;Data Source=31"

Cnn.Open   '打开数据库连接
If Cnn.State = 0 Then      '判断数据库连接是否成功
     Reporter.ReportEvent micFail, "testing", "连接数据库失败"
else
     Reporter.ReportEvent micPass, "testing",   "连接数据库成功"
End If
 
if Cnn.State<> 0  then
    Set Rs=CreateObject("ADODB.Recordset")    '生成记录集对象
    strsql ="Select  *    from t_sys_user"   '从数据库中查询t_sys_user的所有记录
    Rs.Open strsql ,Cnn,1,3   '执行sql语句，记录可以自由移动，单数记录处于只读模式
    ydl=Rs("USER_ID")         '取得字段为USER_ID的记录，游标定义在第一行，所以取得的是该字段所在行的第一行数据
    msgbox  ydl
    dim a
    a="1188"  '该a的数据库可以从外部获取，可以是某个页面的某个值，拿来跟数据库中的值做比较
    for  i=1  to  Rs.Recordcount   '开始遍历数据库中所有的行数，Rs.Recordcount表示统计数据库表的总记录数
      if Rs("USER_ID")=a then   '将数据库中USER_ID字段的值与变量a进行挨个比较，
         msgbox "a在数据库中存在"  
         exit for                        '如果找到记录a，则推出for循环      
         else
         Rs.MoveNext                      '如果数据库中的值与a不相等的话，那么在数据库中将游标移到下一行
      end  if  
   next
end if

RS.close      '关闭记录集
Set RS=nothing        '释放对象
Cnn.Close   '关闭数据连接
Set Cnn=nothing '释放对象

’更新或删除数据
Function UpdateData(byval strsql)
Provider=OraOLEDB.Oracle.1;Persist Security Info=False;User ID=test;;Password=test;Data Source=192.168.13.19

Dim Cnn  '定义一个数据库连接串
Set Cnn = CreateObject("ADODB.Connection")
Cnn.ConnectionString =Provider

Cnn.Open   '打开数据库连接
If Cnn.State = 0 Then      '判断数据库连接是否成功
     Reporter.ReportEvent micFail, "testing", "连接数据库失败"
else
     Reporter.ReportEvent micPass, "testing",   "连接数据库成功"
End If
 
if Cnn.State<> 0  then
    Set Cmd=CreateObject("adodb.command")
    Cmd.ActiveConnection=Provider
    Cmd.CommandType =1
       Cmd.CommandText=strsql
    '执行更新
    Cmd.Execute
end if

Set Cmd.ActiveConnection=nothing        '释放对象
Set Cmd=nothing        '释放对象
Cnn.Close   '关闭数据连接
Set Cnn=nothing '释放对象
End Function

4、获取剪切板

Function GetClipBoardText()
    set MyClipboard = CreateObject("Mercury.Clipboard")
    GetClipBoardText = MyClipboard.GetText
    set MyClipboard = notiong
End Function

5、操作qtp

'让QTP运行时保持最小化
Function MinQtp()
 Dim objQTPWin
 Set bjQTPWin = GetObject("" , "QuickTest.Application")
 objQTPWin.WindowState = "Minimized"
 Set bjQTPWin = Nothing
End Function

'恢复QTP窗口
Function MaxQtp()
 Dim objQTPWin
 Set bjQTPWin = GetObject("" , "QuickTest.Application")
 objQTPWin.WindowState = "Restored"
 Set bjQTPWin = Nothing
End Function

6、写txt文件

Function WriteTxt(byval strtxt)
Const ForReading=1,ForWriting=2,ForAppending=8
Set fso = CreateObject("Scripting.FileSystemObject")
set openfile=fso.OpenTextFile("C:/Users/luyime/Desktop/1.txt",ForAppending,true)
openfile.WriteLine(CStr(strtxt))
openfile.Close
set openfile=noting
Set fso=nothing
End Function

'输入值：写入内容
Public Function QTP_WriteFile(pathway,words)
    Dim fileSystemObj,fileSpec,logFile,way
    Set fileSystemObj = CreateObject("Scripting.FileSystemObject")
    fileSpec = pathway
    Set logFile = fileSystemObj.OpenTextFile(fileSpec, 8, true)
    logFile.WriteLine (CStr(words))
    logFile.Close
    Set logFile = Nothing
End Function

'读指定文本文件指定行内容
Function ReadLine(pathway, rowcount)
 Dim fso,myfile,i,flag
 flag = 1
 Set fso=CreateObject("scripting.FileSystemObject")
 If fso.FileExists(pathway) then
  Set myfile = fso.openTextFile(pathway,1,false)
 Else
  flag = 0
 End If
 
 For i=1 to rowcount-1
  If Not myfile.AtEndOfLine Then
   myfile.SkipLine
  End If
 Next
 
 If flag = 1 then
  If Not myfile.AtEndOfLine Then
   ReadLine = myfile.ReadLine
  Else
   ReadLine = "文本越界"
  End If
  myfile.close
 Else
  ReadLine = "文件不存在"
 End If
End Function

修改指定内容

Function UpdateFile
    Dim fso,myfile,filepath,newfilepath
    filepath = "D:\111.txt"
    newfilepath = "D:\new_111.txt"
    flag = 1
    set fso = CreateObject("wscripting.shell")    

    if fso.FileExists(filepath) then
        set myfile = fso.OpenTextFile (filepath,1,false)
        if fso.FileExists(newfilepath) then
            fso.DeleteFile(newfilepath) '清空文件
        end if
        set newfilepath = fso.CreateTextFile(newfilepath,false)
    else
        flag =0
    end if
    '正则表达式
    set regEx = new RegExp
    regEx.Pattern = "status.*"
    
    if flag =1 then
        do
            txt = myfile.ReadLine()
            if regEx.Test(txt) then
            temptxt = "status=init"
            newfile.WriteLine(temptxt)
            else
            txt = "status=init"     '添加内容
            newfile.WriteLine(txt)    
            End if
        loop while(not myfile.AtendOfStream)
    end if

    fso.CopyFile newfilepath,filepath

    set myfile = Nothing
    set filepath = Nothing
    set newfilepath = Nothing
    set fso = Nothing        
End Function

7、操作excel

'读Excel文件元素
Public Function QTP_Read_Excel(pathway,sheetname,x,y)
 Dim srcData,srcDoc,ret
 set srcData = CreateObject("Excel.Application")
 srcData.Visible = True
 set srcDoc = srcData.Workbooks.Open(pathway)
 srcDoc.Worksheets(sheetname).Activate
 ret = srcDoc.Worksheets(sheetname).Cells(x,y).value
 srcData.Workbooks.Close
 Window("text:=Microsoft Excel").Close
 QTP_Read_Excel = ret
End Function

'写Excel文件元素并保存退出
Public Function QTP_Write_Excel(pathway,sheetname,x,y,content)
 Dim srcData,srcDoc,sp1,sp2,num,use,a1,a2,a3
 set srcData = CreateObject("Excel.Application")
 srcData.Visible = True
 set srcDoc = srcData.Workbooks.Open(pathway)
 srcDoc.Worksheets(sheetname).Activate
 srcDoc.Worksheets(sheetname).Cells(x,y).value = content
 
' sp1 = Split(pathway,".")
' sp2 = Split(sp1(0),"\")
' num = UBound(sp2)
' use = sp2(num)

' Set a1 = Description.Create()
' a1("text").value="Microsoft Excel - " + use + ".xls"
' a1("window id").value="0"

' Set a3 = Description.Create()
' a3("Class Name").value="WinObject"
' a3("text").value= use + ".xls"

' Window(a1).WinObject(a3).Type micCtrlDwn + "s" + micCtrlUp

 Dim WshShell
 Set WshShell=CreateObject("Wscript.Shell")
 WshShell.SendKeys "^s"
 wait(1)
 
 srcData.Workbooks.Close
 Set srcDoc = nothing
 
 Window("text:=Microsoft Excel").Close
End Function

'excel超链接
Function  ReportInformation(filename)    
Set ExcelObj = CreateObject("Excel.Application")   
ExcelObj.Workbooks.Add
Set NewSheet = ExcelObj.Sheets.Item(1)
NewSheet.Name = "Page Information"
NewSheet.Cells(1,1).Value = "Tom"    
NewSheet.Cells(2,1).Value = "Sohu"  
NewSheet.Hyperlinks.Add NewSheet.Cells(1,1), "http://www.tom.com/"  
NewSheet.Hyperlinks.Add NewSheet.Cells(2,1), "http://www.sohu.com/"
      ExcelObj.ActiveWorkbook.SaveAs filename    
      ExcelObj.Quit
      Set ExcelObj = Nothing   
   End Sub
call ReportInformation("d:\test.xls")
End Function

8、截图

'捕获当前屏幕（截图）
Public Function PrintScreen(pathway)
  MinQtp()
  Dim datestamp
  Dim filename
  datestamp = Now()
  filename = Environment("TestName")&"_"&datestamp&".png"
  filename = Replace(filename,"/","")
  filename = Replace(filename,":","")
  filename = pathway + "\" + ""&filename
  Desktop.CaptureBitmap filename
End Function

9、发邮件

'发送电子邮件
Function SendMail(SendTo, Subject, Body, Attachment)
 Dim ol,mail
    Set l=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 l = Nothing
End Function