|
做这个函数的原因有两个:
1. 找不到直接访问存放在QC中的附件的方法。
2. 愤怒于ExecuteFile不能读取Unicode格式的文件。
3. 更加愤怒于QT的编辑器一定会保存成Unicode格式。
已在QT9.0上测试通过。- '作用:
- ' 读取QC上的附件中的文件内容。
- ' 自动识别Unicode文件。
- ' 可用于替代ExecuteFile,修正其不能调用Unicode文件的问题
- '调用示例:
- '
- 'QC上的文件
- 'Execute QCFileContent( "[QualityCenter] 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, "[QualityCenter] ", "" )
- 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
复制代码 |
|