标题: 以下是我自写一个QTP自动下载TD中附件的脚本，共享和大家一起学习 [打印本页] 作者: erwinsun 时间: 2006-5-11 10:46 标题: 以下是我自写一个QTP自动下载TD中附件的脚本，共享和大家一起学习 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