|
|
我07年的帖子，现在还有那么多网友支持真是激动不已，现在我又回来做QTP了，也积累了更多更新的经验工作总结 - 请上E测中国站点我的博客，我在那边的用户名为wally，愿与大家一起学习进步！
大家好，由于换了新的工作环境，这里不再使用QTP了，所以我可能几年不上QTP这个板块了
临走吐点vbs脚本出来送给大家，大家可以加到qtp的resource里去，就可以直接调用了，也欢迎大家以后加函数进去
（外部链接milo.jiang兄的数据库操作：http://bbs.51testing.com/viewthread.php?tid=118028&highlight=）
另外申明一下：
1.有部分函数改写了 风过无息 的blog的函数
2.有部分函数多余了，比如对于日期处理的函数vb本来就有自己的函数，大家可以用vb的函数
3.但是有部分vbs的函数不太好，被我改写了，比如vb的随机函数，发现使用起来相当不随机，我改写了这个函数，现在随机多了
4.附件的rar文件里有个excel的文件，包含了多这些函数的输入参数和输出参数的定义
希望大家多多交流，扩充这个底层脚本。也可以联系我提意见
这个板块成就了如今的我，所以我把我的这些脚本贡献出来，希望能让更多的人受益 Sharing will get in more
谢谢各位
（共42个函数，这里举隅一二，详细请见rar附件）
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''上海(保密一下)软件有限公司 开发部''''''''''''''''''''''''''''''''''''
'''''函数功能：Quick 和 Robot 常用库函数'''''''''''''''''''''''''''''
'''''说明：1.以QTP_开头的函数只适用于QuickTest'''''''''''''''''''''''
''''' 2.以Robot_开头的函数只适用于Robot'''''''''''''''''''''''''
''''' 3.除以上外，QuickTest和Robot都适用''''''''''''''''''''''''
'''''作者：俞戴龙''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''开始编撰日期：2007-8-17'''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''
'''测试用调用函数'''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''以下为QuickTest和Robot都适用函数''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'随机函数生成
'输入值：生成值范围 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 If
End Function
'去掉字符串中的重复项
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
'按ASCII码值冒泡排序
Function BubbleSort(VString,Spl,Func)
Dim Str,StrLength,i,j
Str = Split(VString,Spl)
StrLength = UBound(Str) + 1
For i = 1 To (StrLength-1)
For j = (i+1) To StrLength
If Func = 1 then
If Asc(Str(i-1)) < Asc(Str(j-1)) Then
Call Swap(Str(i-1),Str(j-1))
End If
Else
If Asc(Str(i-1)) > Asc(Str(j-1)) Then
Call Swap(Str(i-1),Str(j-1))
End If
End If
Next
Next
j = ""
For i = 1 To StrLength
j = j & Str(i-1) & Spl
Next
j = Left(j,(StrLength * 2 -1))
BubbleSort = j
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''以下为仅QuickTest适用函数'''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'让QTP运行时保持最小化
Public Sub QTP_Small()
Dim objQTPWin
Set objQTPWin = GetObject("" , "QuickTest.Application")
objQTPWin.WindowState = "Minimized"
Set objQTPWin = Nothing
End Sub
'恢复QTP窗口
Public Sub QTP_Big()
Dim objQTPWin
Set objQTPWin = GetObject("" , "QuickTest.Application")
objQTPWin.WindowState = "Restored"
Set objQTPWin = Nothing
End Sub
'定时停留弹出框函数
Sub QTP_Msgbox(Value,waitTime,Title)
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
WshShell.Popup Value, waitTime, Title
Set WshShell = nothing
End Sub
'改变Excel的单元格颜色
Public Function QTP_Change_Color(pathway,sheetname,x,y,color)
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
If color = "red" Then
srcDoc.Worksheets(sheetname).Cells(x,y).Interior.color=vbred
ElseIf color = "green" Then
srcDoc.Worksheets(sheetname).Cells(x,y).Interior.color=vbgreen
Else
MsgBox "输入的颜色参数不正确，只接收""red""和""green"""
End If
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文件元素并保存退出
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
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
[ 本帖最后由 yuandjing 于 2009-11-5 18:03 编辑 ] |
|
/1 
关于我们
发表于 2008-1-28 11:49:58
QQ好友和群
QQ空间
腾讯微博
腾讯朋友
微信
收藏
置顶服务
换色服务
发表于 2013-11-14 09:50:49
