以下是我自写一个QTP自动下载TD中附件的脚本，共享和大家一起学习

erwinsun 发表于 2006-5-11 10:46:15

Dim TestPath
DimParamFile
Dim Get_URL_File
Dim DataCheck_File
Dim Have_Attach
Dim FileNameArray(50)
Dim CountFile
Dim hWnd
TestPath = Environment ("TestDir")
Get_URL_File = TestPath & "\Get_URL_Module.txt"
DataCheck_File = TestPath & "\SQLDataBaseCheck_Function.txt"
'ExecuteFile Get_URL_File
'URL = Get_URL_Module()
'SystemUtil.Run URL
'hWnd = Browser(Browser).GetROProperty("hwnd")

'检查数据库中打开的脚本是否包含附件
Function Check_File
Dim TestName
Dim Con,Record,Sql1,Sql2,j,Id,SQLFile,RealFile,NameLen,I,s
TestName = Environment ("TestName")
Set Con=CreateObject("Adodb.Connection")
'在以下修改数据库的连接，指定数据库服务器名（SERVER、WSID）、帐号（UID）、密码（PWD）、项目使用的数据库（DATABASE）
Con.Open "Description=QTP_ODBC;DRIVER=SQL Server;SERVER=服务器名;UID=帐号;"&_
"PWD=密码;APP=Quick Test Pro;WSID=服务器名;DATABASE=项目使用的数据库"
Set Record1=CreateObject("Adodb.Recordset")
Set Record2=CreateObject("Adodb.Recordset")
CountFile = 0
Have_Attach = 0
sql1="select*from td.TEST order by TS_TEST_ID DESC "
sql2="select*from td.CROS_REF"
Record1.Open Sql1,Con
Record2.Open Sql2,Con
DO
If Record1("TS_NAME").Value= TestName and Record1("TS_ATTACHMENT").Value="Y"Then
Have_Attach = 1
Id = Record1("TS_TEST_ID").Value
Do
IfInt(Record2("CR_KEY_1").Value) = id Then
SQLFile = Record2("CR_REFERENCE").Value
NameLen = Len(SQLFile)
i = Instr(6, SQLFile, "_", 1)
RealFile = Right(SQLFile,(NameLen - i) )
FileNameArray(CountFile) = SQLFile&"~"&RealFile
CountFile = CountFile + 1
End If
Record2.MoveNext
Loop Until Record2.Eof=true
Record2.Close
Set Record2=Nothing
End If
Record1.MoveNext
Loop Until Record1.Eof=true
Record1.Close
Set Record1=Nothing
Con.Close
Set Con=Nothing
End Function

'通过远程凭证（自动建立一个RPC通道）
Function Remote_Access
   DIM ObjShell,ShellCmd
Set ObjShell=CreateObject("WScript.Shell")
ShellCmd ="net use \\TD服务器名\TD共享目录名密码 /user:用户"
ObjShell.Run ShellCmd,1,True
Set objShell = Nothing
End Function

'复制TD服务器共享目录下脚本包含的附件到本地QTP运行目录下
Function CopyFileToLocalHost
   Dim ServerHost,ServerPath
   Dim objFSO,f_s,f_l,fc_s,fc_l,fs,fl
   Dim SQLFileName,RealName,FileName,NameLen,QTPFile
   Dim k,i,check
   'TD服务器地址（ServerHost），TD中项目保存附件的共享目录（ServerPathTD）
   ServerHost ="TD服务器地址"
   ServerPath = ServerHost&"TD中项目保存附件的共享目录"
      Set objFSO = CreateObject("Scripting.FileSystemObject")
Set f_s = objFSO.GetFolder(ServerPath)
Set f_l = objFSO.GetFolder(TestPath)
Set fc_s=f_s.Files
Set fc_l=f_l.Files
   IfHave_Attach = 1 Then
      For k = 0 To CountFile - 1
FileName = FileNameArray(k)
NameLen = Len(FileName)
i = Instr(1, FileName, "~", 1)
RealName = Right(FileName,(NameLen - i) )
SQLFileName = Left(FileName,(i-1))
For Each fs in fc_s
Iffs.Name = SQLFileName Then
For Each fl in fc_l
If fl.Name <> SQLFileName Then
                                    check = 0
Else
check = 1
End If
NEXT
If check = 0Then
Set QTPFile = objFSO.GetFile(ServerPath&SQLFileName)
objFSO.CopyFileServerPath&SQLFileName,TestPath&"\"&RealName
   End If
End If
               NEXT
      NEXT
   End If
End Function

'结果显示处理
Function Result_Display
   Dim objFSO,f,fc,f1
   Dim ExtendName1,ExtendName2,QTPdefaultXLS,TextChar
   Dim Check_SQF,SQF,Check_GUF,GUF,Check_PF,ParamFileName,i,l,j,OtherFileName,FileName,NameLen,OtherFileNameN
ExtendName1 = "txt"
ExtendName2= "xls"
QTPdefaultXLS = "Default.xls"
Const ForReading = 1
      Set objFSO = CreateObject("Scripting.FileSystemObject")
Set f = objFSO.GetFolder(TestPath)
Set fc=f.Files
IfHave_Attach = 1 Then
For Each f1 in fc
If Instr(1, f1.Name, ExtendName1)>1 orInstr(1, f1.Name, ExtendName2)>1 Then
If f1.Name <> QTPdefaultXLS Then
Select Case f1.Name
Case "SQLDataBaseCheck_Function.txt"
Set MyFile = objFSO.OpenTextFile(TestPath& "\SQLDataBaseCheck_Function.txt", ForReading)
TextChar = MyFile.ReadLine
      IfInstr(1, TextChar,"SQLDataBaseCheck_Function")>1 orf1.size = "8435" Then
Check_SQF = 1
SQF =f1.Name
   For i = 0To CountFile - 1
   FileName = FileNameArray(i)
   NameLen = Len(FileName)
   j = Instr(1, FileName, "~", 1)
   RealName = Right(FileName,(NameLen - j) )
   IfRealName =f1.Name Then
      FileNameArray(i) = Empty
End If
Next
      End if
Case "Get_URL_Module.txt"
Set MyFile = objFSO.OpenTextFile( TestPath&"\Get_URL_Module.txt", ForReading)
TextChar = MyFile.ReadLine
IfInstr(1, TextChar,"Get_URL_Module")>1 orf1.size = "424" Then
Check_GUF = 1
GUF =f1.Name
For i = 0To CountFile - 1
   FileName = FileNameArray(i)
   NameLen = Len(FileName)
   j = Instr(1, FileName, "~", 1)
   RealName = Right(FileName,(NameLen - j) )
   IfRealName =f1.Name Then
      FileNameArray(i) = Empty
End If
Next
End if
End select
   IfInstr(1, f1.Name, ExtendName2)>1 Then
Check_PF = 1
ParamFileName =f1.Name
For i = 0To CountFile - 1
   FileName = FileNameArray(i)
   NameLen = Len(FileName)
   j = Instr(1, FileName, "~", 1)
   RealName = Right(FileName,(NameLen - j) )
   IfRealName =f1.Name Then
   FileNameArray(i) =Empty
End If
Next
End If
End If
            End If
         NEXT
Else
End If
If Have_Attach = 1 Then
IfFileNameArray(0) =Empty Then
   i = 1
   FileName = FileNameArray(i)
   NameLen = Len(FileName)
   l= Instr(1, FileName, "~", 1)
   OtherFileName = Right(FileName,(NameLen - l) )
   Else
   i = 0
   FileName = FileNameArray(i)
   NameLen = Len(FileName)
   l= Instr(1, FileName, "~", 1)
   OtherFileName = Right(FileName,(NameLen - l) )
   End If
For k = i +1 ToCountFile - 1
IfFileNameArray(k) <> Empty Then
      FileName = FileNameArray(k)
      NameLen = Len(FileName)
      l= Instr(1, FileName, "~", 1)
   OtherFileNameN = Right(FileName,(NameLen - l) )
OtherFileName = OtherFileName&vblf&OtherFileNameN
   End If
Next
IfOtherFileName <> Empty Then
   IfCheck_SQF = 1 or Check_GUF = 1Then
IfCheck_PF = 1 Then
         Reporter.ReportEvent 2,"脚本初始化结果：","脚本初始化成功。"&vblf&"成功从TD服务器上下载了脚本包含的"&_
"："&vblf&"参数文件："&ParamFileName&vblf&"功能插件："&SQF&vblf&GUF&vblf&"其它类型文件："&OtherFileName
Else
         Reporter.ReportEvent 2,"脚本初始化结果：","脚本初始化成功。"&vblf&"成功从TD服务器上下载了脚本包含的"&_
"："&vblf&"功能插件："&SQF&vblf&GUF&vblf&"其它类型文件："&OtherFileName
         End If
      Else
      IfCheck_PF = 1 Then
Reporter.ReportEvent 2,"脚本初始化结果：","脚本初始化成功。"&vblf&"成功从TD服务器上下载了脚本包含的"&_
"："&vblf&"参数文件："&ParamFileName&vblf&"其它类型文件："&OtherFileName
End If
End If
Else
IfCheck_SQF = 1 or Check_GUF = 1Then
IfCheck_PF = 1 Then
         Reporter.ReportEvent 2,"脚本初始化结果：","脚本初始化成功。"&vblf&"成功从TD服务器上下载了脚本包含的"&_
"："&vblf&"参数文件："&ParamFileName&vblf&"功能插件："&SQF&vblf&GUF
      Else
         Reporter.ReportEvent 2,"脚本初始化结果：","脚本初始化成功。"&vblf&"成功从TD服务器上下载了脚本包含的"&_
"："&vblf&"功能插件："&SQF&vblf&GUF
   End If
      Else
      IfCheck_PF = 1 Then
Reporter.ReportEvent 2,"脚本初始化结果：","脚本初始化成功。"&vblf&"成功从TD服务器上下载了脚本包含的"&_
"："&vblf&"参数文件："&ParamFileName
End If
   End If
End If
      Else
Reporter.ReportEvent 2,"脚本初始化结果：","脚本初始化成功，脚本不包含参数文件和功能插件。"
End If
End Function

[ 本帖最后由 erwinsun 于 2006-5-11 10:48 编辑 ]

wwg1020 发表于 2006-7-20 23:34:43

顶一下

applebugs 发表于 2006-8-1 17:49:28

太强了

这也能写出来呀，利害！留个MSN呀，以便向你学习和交流

eric.y 发表于 2006-9-6 12:12:46

哇,好长啊~~~
我给大家发一个程序,可以下载td中的附件,这样其他测试工具都可以用了

[ 本帖最后由 eric.y 于 2006-9-6 12:13 编辑 ]

higkoo 发表于 2006-9-6 12:56:50

哈哈，顶一下

路过，再一次路过，反复路过，不停的路过，逛多人路过……

miniyal 发表于 2006-12-1 14:20:50

好厉害呀~~sdlkfj8

DZDD 发表于 2007-4-5 15:05:03

不顶没天理啊！顶！

顶！顶！顶！

apron 发表于 2007-4-5 15:47:17

果然牛人太多了啊！
强烈佩服你！

flowerfeifei 发表于 2007-4-5 17:53:17

谢谢

htot05 发表于 2007-4-6 13:44:33

学习了

handle 发表于 2007-4-8 18:41:53

太牛了，顶机

nijinyi726 发表于 2007-4-10 11:21:22

sdlkfj4 好厉害哦

chbhaha 发表于 2007-4-11 09:20:28

牛

梦想流浪 发表于 2007-4-12 09:07:37

太厉害了，顶楼主一下

liyun100 发表于 2007-4-12 15:27:03

我还不知道TD是干什么用的呢？
有人告诉我吗？

hanguolong21 发表于 2010-12-14 16:22:04

回复 4# eric.y

这个工具可以用在QC上吗？能详细说说不？我这试验了无数次了，始终不成功

lyscser 发表于 2010-12-16 08:24:05

舍近求远……

页: [1]

51Testing软件测试论坛 's Archiver