51Testing软件测试论坛

标题: 远程读取QC的TestPlan中的附件 [打印本页]

作者: lyghe    时间: 2009-3-13 14:25
标题: 远程读取QC的TestPlan中的附件
做这个函数的原因有两个:
1. 找不到直接访问存放在QC中的附件的方法。
2. 愤怒于ExecuteFile不能读取Unicode格式的文件。
3. 更加愤怒于QT的编辑器一定会保存成Unicode格式。

已在QT9.0上测试通过。
  1. '作用:
  2. '        读取QC上的附件中的文件内容。
  3. '        自动识别Unicode文件。
  4. '        可用于替代ExecuteFile,修正其不能调用Unicode文件的问题

  5. '调用示例:
  6. '
  7. 'QC上的文件
  8. 'Execute QCFileContent( "[QualityCenter] Subject\99 共用函数库\MyLib.vbs" )
  9. '        ^^
  10. '本地文件
  11. 'Execute   FileContent( "E:\MyLib.vbs" )
  12. '        ^^


  13. Const ERRNUM_QCFC_QCPATH_ONLY_TEST                = 9010001        : Const ERRDESC_QCFC_QCPATH_ONLY_TEST                = "路径中只包含测试"
  14. Const ERRNUM_QCFC_DUPLICATE_TEST                = 9010002        : Const ERRDESC_QCFC_DUPLICATE_TEST                        = "找到重名的测试"
  15. Const ERRNUM_QCFC_NO_ATTACHMENT                        = 9010003        : Const ERRDESC_QCFC_NO_ATTACHMENT                        = "找不到附件!"
  16. Const ERRNUM_QCFC_UNKNOWN_NODE_TYPE                = 9010004        : Const ERRDESC_QCFC_UNKNOWN_NODE_TYPE                = "未知的节点类型!"
  17. Const ERRNUM_QCFC_DUPLICATE_ATTACHMENT        = 9010005        : Const ERRDESC_QCFC_DUPLICATE_ATTACHMENT        = "找到重名的附件!"


  18. '读取QC上某个文件的内容
  19. Function QCFileContent( qcFilePath )
  20.         QCFileContent = FileContent( QCTransFilePath2Local(qcFilePath) )
  21. End Function


  22. '读取本地某个文件的内容
  23. Function FileContent( filePath )
  24.         FileContent = ""
  25.         
  26.         '打开脚本文件
  27.         Const ForReading = 1, ForWriting = 2
  28.         Dim fso, f
  29.         Set fso = CreateObject("Scripting.FileSystemObject")
  30.         'MsgBox filePath

  31.         '首先以ASCII方式打开
  32.         Set f = fso.OpenTextFile(filePath, ForReading, False, False)
  33.         '判断头上2个字节是否为FF FE
  34.         Dim fileTypeBytes
  35.         fileTypeBytes = f.Read(2)
  36.         '是Unicode文件,则重新打开文件
  37.         If mid(fileTypeBytes,1,1) = String(1,255) Then
  38.                 Set f = fso.OpenTextFile(filePath, ForReading, False, True)        
  39.         '不是Unicode文件,则头上2个字节也要算进来
  40.         Else
  41.                 FileContent = fileTypeBytes
  42.         End If

  43.         '读取脚本内容
  44.         If Not f.AtEndOfStream Then        '一定要加判断,否则当文件为空时会报错“输入超出了文件尾”
  45.                 FileContent = FileContent + f.ReadAll
  46.         End If
  47.         'MsgBox FileContent


  48.         '关闭文件
  49.         f.Close
  50.         Set f = Nothing
  51.         Set fso = Nothing
  52. End Function


  53. '将QC中的路径转换成本地临时文件路径
  54. Function QCTransFilePath2Local( byval qcPath )
  55.         Dim nodeNames
  56.         qcPath = Replace( qcPath, "[QualityCenter] ", "" )
  57.         nodeNames = Split( qcPath, "\" )
  58.         'MsgBox ubound(nodeNames)

  59.         Dim qcConn, treeM
  60.         set qcConn        = QCUtil.QCConnection
  61.         Set treeM        = qcConn.TreeManager

  62.         Dim level        : level = 0
  63.         '进入根
  64.         Set node = treeM.TreeRoot( nodeNames(level) )
  65.         level = level + 1

  66.         '依次进入节点
  67.         Do While level < ubound(nodeNames)
  68.                 Dim child        : child = null
  69.                 'MsgBox nodeNames(level)
  70.                 '在子节点中寻找。防止节点不存在时的报错
  71. On Error Resume Next
  72.                 Set child = node.FindChildNode( nodeNames(level) )
  73. On Error GoTo 0
  74.                 'MsgBox typename(child)
  75.                 'MsgBox child.Name
  76.                 '找到则进入子节点
  77.                 If not IsNull(child) Then
  78.                         'MsgBox "找到节点:" + child.Name
  79.                         Set node = child
  80.                         level = level + 1
  81.                 '没找到则停止寻找
  82.                 Else
  83.                         Exit Do
  84.                 End If
  85.         Loop

  86.         '所有节点名都耗尽了
  87.         If level > ubound(nodeNames) Then
  88.                 Err.Raise ERRNUM_QCFC_QCPATH_ONLY_TEST, "", ERRDESC_QCFC_QCPATH_ONLY_TEST
  89.                 QCTransFilePath2Local = ""
  90.                 Exit Function
  91.         End If

  92.         '判断是否是Test
  93.         Dim test        : test = null
  94.         '加上过滤器,根据测试名过滤。此处一定要用filter,直接用名称不行
  95.         Dim testFilter        'filter一定要拿出来用,因为每次都会创建一个
  96.         Set testFilter = node.TestFactory.Filter
  97.         testFilter("TS_NAME") = "'" + nodeNames(level) + "'"    ': MsgBox testFilter.Text
  98.         Set testList = node.TestFactory.NewList( testFilter.Text )  ': MsgBox testList.Count
  99.         '没有测试,则可能不是测试,不理
  100.         If testList.Count = 0 Then
  101.         '重名
  102.         ElseIf testList.Count > 1 Then
  103.                 Err.Raise ERRNUM_QCFC_DUPLICATE_TEST, "", ERRDESC_QCFC_DUPLICATE_TEST
  104.                 QCTransFilePath2Local = ""
  105.                 Exit Function
  106.         '正中靶心
  107.         Else
  108.                 Set test = testList(0)
  109.         End If

  110.         
  111.         '开始寻找附件的旅程''''''''''''''''
  112.         Dim attList, att
  113.         
  114.         '找到测试,则在测试中寻找附件
  115.         If not IsNull(test) Then
  116.                 '进入测试
  117.                 level = level + 1
  118.                
  119.                 '所有节点名都耗尽了
  120.                 If level > ubound(nodeNames) Then
  121.                         Err.Raise ERRNUM_QCFC_QCPATH_ONLY_TEST, "", ERRDESC_QCFC_QCPATH_ONLY_TEST
  122.                         QCTransFilePath2Local = ""
  123.                         Exit Function
  124.                 End If

  125.                 '在测试中寻找附件
  126.                 Set att = QCFindAttachment( test, nodeNames(level) )
  127.                 If not IsNull(att) Then
  128.                         QCTransFilePath2Local = att.FileName
  129.                         Exit Function
  130.                 End If

  131.                 '没找到附件
  132.                 Err.Raise ERRNUM_QCFC_NO_ATTACHMENT, "", ERRDESC_QCFC_NO_ATTACHMENT
  133.                 QCTransFilePath2Local = ""
  134.                
  135.         '没找到测试,则可能就是附件
  136.         Else
  137.                 '在节点中寻找附件
  138.                 Set att = QCFindAttachment( node, nodeNames(level) )
  139.                 If not IsNull(att) Then
  140.                         QCTransFilePath2Local = att.FileName
  141.                         Exit Function
  142.                 End If

  143.                 '没找到附件
  144.                 Err.Raise ERRNUM_QCFC_NO_ATTACHMENT, "", ERRDESC_QCFC_NO_ATTACHMENT
  145.                 QCTransFilePath2Local = ""
  146.         End If
  147.         
  148. End Function


  149. '在QC中的某个地方寻找某个附件
  150. Function QCFindAttachment( nodeOrTest, attName )
  151.         Dim attList, att        : att = null
  152.         '拼装文件的内部名称,用于查找附件对象的过滤器
  153.         Dim attInnerName
  154.         If typename(nodeOrTest) = "ISubjectNode" Then
  155.                 attInnerName = "ALL_LISTS_" + cstr(nodeOrTest.NodeID) + "_"
  156.         ElseIf typename(nodeOrTest) = "ITest" Then
  157.                 attInnerName = "Test_" + cstr(nodeOrTest.ID) + "_"
  158.         Else
  159.                 Err.Raise ERRNUM_QCFC_UNKNOWN_NODE_TYPE, "", ERRDESC_QCFC_UNKNOWN_NODE_TYPE
  160.         End If
  161.         attInnerName = attInnerName + attName
  162.         'MsgBox attInnerName
  163.         '设置过滤器,根据内部文件名过滤
  164.         Dim attFilter
  165.         Set attFilter = nodeOrTest.Attachments.Filter
  166.         attFilter("CR_REFERENCE") = attInnerName
  167.         '在节点中寻找附件
  168.         Set attList = nodeOrTest.Attachments.NewList( attFilter.Text )
  169.         '没找到
  170.         If attList.Count = 0 Then
  171.                 att = null
  172.                 MsgBox "没找到。"
  173.         '找到很多
  174.         ElseIf attList.Count > 1 Then
  175.                 att = null
  176.                 Err.Raise ERRNUM_QCFC_DUPLICATE_ATTACHMENT, "", ERRDESC_QCFC_DUPLICATE_ATTACHMENT
  177.         '正中
  178.         Else
  179.                 Set att = attList(0)
  180.                
  181.                 '找到附件。name(1)表示用户看到的文件名。而name(0)则为服务器上的实际文件名
  182. '                MsgBox                "Name : " + att.Name _
  183. '                        +vbcr+        "Name(0) : " + att.Name(0) _
  184. '                        +vbcr+        "Name(1) : " + att.Name(1) _
  185. '                        +vbcr+        "FileName : " + att.FileName _
  186. '                        +vbcr+        "ServerFileName : " + att.ServerFileName _
  187. '                        +vbcr+        "DirectLink : " + att.DirectLink

  188.                 '找到附件了,则下载到本地磁盘。第二个参数True,表示等待文件下载结束
  189.                 '此处不能用filter的Text,应该直接用内部名
  190.                 att.AttachmentStorage.Load att.Name(0), True
  191.                         
  192.         End If

  193.         Set QCFindAttachment = att
  194. End Function
复制代码

作者: jenvee    时间: 2009-5-16 21:38
顶起
作者: kenva    时间: 2010-4-9 16:08
感谢!!!!!!!!!我的问题解决了!楼主乃神人!饿滴神啊~~~




欢迎光临 51Testing软件测试论坛 (http://bbs.51testing.com/) Powered by Discuz! X3.2