QTP的那些事—QTP11+QC11框架整理源码（个人原创）2012-6-15更新版

'*******************************************************************************************
'功能:新建一个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&"---"×tamp&".png"
rndnum=getRandNum(1,10)
imgpath=resultpath&"\"&teststep&"截图--"×tamp&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
'*******************************************************************************************