远程读取QC的TestPlan中的附件
做这个函数的原因有两个：1. 找不到直接访问存放在QC中的附件的方法。
2. 愤怒于ExecuteFile不能读取Unicode格式的文件。
3. 更加愤怒于QT的编辑器一定会保存成Unicode格式。
已在QT9.0上测试通过。'作用：
' 读取QC上的附件中的文件内容。
' 自动识别Unicode文件。
' 可用于替代ExecuteFile，修正其不能调用Unicode文件的问题
'调用示例：
'
'QC上的文件
'Execute QCFileContent( " Subject\99 共用函数库\MyLib.vbs" )
' ^^
'本地文件
'Execute FileContent( "E:\MyLib.vbs" )
' ^^
Const ERRNUM_QCFC_QCPATH_ONLY_TEST = 9010001 : Const ERRDESC_QCFC_QCPATH_ONLY_TEST = "路径中只包含测试"
Const ERRNUM_QCFC_DUPLICATE_TEST = 9010002 : Const ERRDESC_QCFC_DUPLICATE_TEST = "找到重名的测试"
Const ERRNUM_QCFC_NO_ATTACHMENT = 9010003 : Const ERRDESC_QCFC_NO_ATTACHMENT = "找不到附件！"
Const ERRNUM_QCFC_UNKNOWN_NODE_TYPE = 9010004 : Const ERRDESC_QCFC_UNKNOWN_NODE_TYPE = "未知的节点类型！"
Const ERRNUM_QCFC_DUPLICATE_ATTACHMENT = 9010005 : Const ERRDESC_QCFC_DUPLICATE_ATTACHMENT = "找到重名的附件！"
'读取QC上某个文件的内容
Function QCFileContent( qcFilePath )
QCFileContent = FileContent( QCTransFilePath2Local(qcFilePath) )
End Function
'读取本地某个文件的内容
Function FileContent( filePath )
FileContent = ""
'打开脚本文件
Const ForReading = 1, ForWriting = 2
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
'MsgBox filePath
'首先以ASCII方式打开
Set f = fso.OpenTextFile(filePath, ForReading, False, False)
'判断头上2个字节是否为FF FE
Dim fileTypeBytes
fileTypeBytes = f.Read(2)
'是Unicode文件，则重新打开文件
If mid(fileTypeBytes,1,1) = String(1,255) Then
Set f = fso.OpenTextFile(filePath, ForReading, False, True)
'不是Unicode文件，则头上2个字节也要算进来
Else
FileContent = fileTypeBytes
End If
'读取脚本内容
If Not f.AtEndOfStream Then '一定要加判断，否则当文件为空时会报错“输入超出了文件尾”
FileContent = FileContent + f.ReadAll
End If
'MsgBox FileContent
'关闭文件
f.Close
Set f = Nothing
Set fso = Nothing
End Function
'将QC中的路径转换成本地临时文件路径
Function QCTransFilePath2Local( byval qcPath )
Dim nodeNames
qcPath = Replace( qcPath, " ", "" )
nodeNames = Split( qcPath, "\" )
'MsgBox ubound(nodeNames)
Dim qcConn, treeM
set qcConn = QCUtil.QCConnection
Set treeM = qcConn.TreeManager
Dim level : level = 0
'进入根
Set node = treeM.TreeRoot( nodeNames(level) )
level = level + 1
'依次进入节点
Do While level < ubound(nodeNames)
Dim child : child = null
'MsgBox nodeNames(level)
'在子节点中寻找。防止节点不存在时的报错
On Error Resume Next
Set child = node.FindChildNode( nodeNames(level) )
On Error GoTo 0
'MsgBox typename(child)
'MsgBox child.Name
'找到则进入子节点
If not IsNull(child) Then
'MsgBox "找到节点：" + child.Name
Set node = child
level = level + 1
'没找到则停止寻找
Else
Exit Do
End If
Loop
'所有节点名都耗尽了
If level > ubound(nodeNames) Then
Err.Raise ERRNUM_QCFC_QCPATH_ONLY_TEST, "", ERRDESC_QCFC_QCPATH_ONLY_TEST
QCTransFilePath2Local = ""
Exit Function
End If
'判断是否是Test
Dim test : test = null
'加上过滤器，根据测试名过滤。此处一定要用filter，直接用名称不行
Dim testFilter 'filter一定要拿出来用，因为每次都会创建一个
Set testFilter = node.TestFactory.Filter
testFilter("TS_NAME") = "'" + nodeNames(level) + "'" ': MsgBox testFilter.Text
Set testList = node.TestFactory.NewList( testFilter.Text )': MsgBox testList.Count
'没有测试，则可能不是测试，不理
If testList.Count = 0 Then
'重名
ElseIf testList.Count > 1 Then
Err.Raise ERRNUM_QCFC_DUPLICATE_TEST, "", ERRDESC_QCFC_DUPLICATE_TEST
QCTransFilePath2Local = ""
Exit Function
'正中靶心
Else
Set test = testList(0)
End If
'开始寻找附件的旅程''''''''''''''''
Dim attList, att
'找到测试，则在测试中寻找附件
If not IsNull(test) Then
'进入测试
level = level + 1
'所有节点名都耗尽了
If level > ubound(nodeNames) Then
Err.Raise ERRNUM_QCFC_QCPATH_ONLY_TEST, "", ERRDESC_QCFC_QCPATH_ONLY_TEST
QCTransFilePath2Local = ""
Exit Function
End If
'在测试中寻找附件
Set att = QCFindAttachment( test, nodeNames(level) )
If not IsNull(att) Then
QCTransFilePath2Local = att.FileName
Exit Function
End If
'没找到附件
Err.Raise ERRNUM_QCFC_NO_ATTACHMENT, "", ERRDESC_QCFC_NO_ATTACHMENT
QCTransFilePath2Local = ""
'没找到测试，则可能就是附件
Else
'在节点中寻找附件
Set att = QCFindAttachment( node, nodeNames(level) )
If not IsNull(att) Then
QCTransFilePath2Local = att.FileName
Exit Function
End If
'没找到附件
Err.Raise ERRNUM_QCFC_NO_ATTACHMENT, "", ERRDESC_QCFC_NO_ATTACHMENT
QCTransFilePath2Local = ""
End If
End Function
'在QC中的某个地方寻找某个附件
Function QCFindAttachment( nodeOrTest, attName )
Dim attList, att : att = null
'拼装文件的内部名称，用于查找附件对象的过滤器
Dim attInnerName
If typename(nodeOrTest) = "ISubjectNode" Then
attInnerName = "ALL_LISTS_" + cstr(nodeOrTest.NodeID) + "_"
ElseIf typename(nodeOrTest) = "ITest" Then
attInnerName = "Test_" + cstr(nodeOrTest.ID) + "_"
Else
Err.Raise ERRNUM_QCFC_UNKNOWN_NODE_TYPE, "", ERRDESC_QCFC_UNKNOWN_NODE_TYPE
End If
attInnerName = attInnerName + attName
'MsgBox attInnerName
'设置过滤器，根据内部文件名过滤
Dim attFilter
Set attFilter = nodeOrTest.Attachments.Filter
attFilter("CR_REFERENCE") = attInnerName
'在节点中寻找附件
Set attList = nodeOrTest.Attachments.NewList( attFilter.Text )
'没找到
If attList.Count = 0 Then
att = null
MsgBox "没找到。"
'找到很多
ElseIf attList.Count > 1 Then
att = null
Err.Raise ERRNUM_QCFC_DUPLICATE_ATTACHMENT, "", ERRDESC_QCFC_DUPLICATE_ATTACHMENT
'正中
Else
Set att = attList(0)
'找到附件。name(1)表示用户看到的文件名。而name(0)则为服务器上的实际文件名
' MsgBox "Name : " + att.Name _
' +vbcr+ "Name(0) : " + att.Name(0) _
' +vbcr+ "Name(1) : " + att.Name(1) _
' +vbcr+ "FileName : " + att.FileName _
' +vbcr+ "ServerFileName : " + att.ServerFileName _
' +vbcr+ "DirectLink : " + att.DirectLink
'找到附件了，则下载到本地磁盘。第二个参数True，表示等待文件下载结束
'此处不能用filter的Text，应该直接用内部名
att.AttachmentStorage.Load att.Name(0), True
End If
Set QCFindAttachment = att
End Function 顶起 感谢！！！！！！！！！我的问题解决了！楼主乃神人！饿滴神啊~~~
页:
[1]
