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

erwinsun

Dim TestPath
Dim  ParamFile
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
                                If  Int(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
                   If  Have_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
                                                        If  fs.Name = SQLFileName Then
                                                                For Each fl in fc_l
                                                                        If fl.Name <> SQLFileName Then
                                        check = 0
                                                                                Else
                                                                                check = 1
                                                                        End If
                                                                NEXT
                                                                If check = 0  Then
                                                                Set QTPFile = objFSO.GetFile(ServerPath&SQLFileName)
                                                                objFSO.CopyFile  ServerPath&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
                 If  Have_Attach = 1 Then
                        For Each f1 in fc
                                If Instr(1, f1.Name, ExtendName1)  >1 or  Instr(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
                                                             If  Instr(1, TextChar,"SQLDataBaseCheck_Function")  >1 or  f1.size = "8435" Then
                                                                        Check_SQF = 1
                                                                        SQF =  f1.Name
                                                                    For i = 0  To CountFile - 1
                                                                          FileName = FileNameArray(i)
                                                                          NameLen = Len(FileName)
                                                                          j = Instr(1, FileName, "~", 1)
                                                                          RealName = Right(FileName,(NameLen - j) )
                                                                            If  RealName =  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
                                                                 If  Instr(1, TextChar,"Get_URL_Module")  >1 or  f1.size = "424" Then
                                                                        Check_GUF = 1
                                                                        GUF =  f1.Name
                                                                         For i = 0  To CountFile - 1
                                                                          FileName = FileNameArray(i)
                                                                          NameLen = Len(FileName)
                                                                          j = Instr(1, FileName, "~", 1)
                                                                          RealName = Right(FileName,(NameLen - j) )
                                                                            If  RealName =  f1.Name Then
                                                                                     FileNameArray(i) = Empty
                                                                                End If
                                                                        Next
                                                                End if
                                                        End select
                                                   If  Instr(1, f1.Name, ExtendName2)  >1 Then
                                                                        Check_PF = 1
                                                                        ParamFileName =  f1.Name
                                                                         For i = 0  To CountFile - 1
                                                                          FileName = FileNameArray(i)
                                                                          NameLen = Len(FileName)
                                                                          j = Instr(1, FileName, "~", 1)
                                                                          RealName = Right(FileName,(NameLen - j) )
                                                                            If  RealName =  f1.Name Then
                                                                                    FileNameArray(i) =Empty
                                                                                End If
                                                                        Next
                                                                        End If
                                                End If
                     End If
                 NEXT
                         Else
        End If
                                If   Have_Attach = 1 Then
                                         If  FileNameArray(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 To  CountFile - 1
                                                        If  FileNameArray(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
                                                If  OtherFileName <> Empty Then
                                                    If  Check_SQF = 1 or Check_GUF = 1Then
                                                                 If  Check_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
                                                      If  Check_PF = 1 Then
                                                                Reporter.ReportEvent 2,"脚本初始化结果：","脚本初始化成功。"&vblf&"成功从TD服务器上下载了脚本包含的"&_
                                                                "："&vblf&"参数文件："&ParamFileName&vblf&"其它类型文件："&OtherFileName
                                                                End If
                                                End If
                                                        Else
                                                        If  Check_SQF = 1 or Check_GUF = 1Then
                                                                 If  Check_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
                                                      If  Check_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

顶一下

applebugs

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

eric.y

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

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

higkoo

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

miniyal

好厉害呀~~sdlkfj8

DZDD

顶！顶！顶！

apron

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

flowerfeifei

谢谢

htot05

学习了

handle

太牛了，顶机

nijinyi726

sdlkfj4 好厉害哦

chbhaha

牛

梦想流浪

太厉害了，顶楼主一下

liyun100

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

hanguolong21

回复 4# eric.y


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

lyscser

舍近求远……