解析QTP资源文件(转)

------------------------------------
' 从XML格式的资源文件中获取对象
'------------------------------------
Public Function GetResource(Byval XmlFile,byval ResourceFile)
 Dim XmlObj,i,j,curRow
 Dim ObjRoot,Children
 Dim childCnt,Parent
 Dim Layer,CurLayerIndex()
 Dim sourceID,ParentID,sourceClass,sourceName
 
 Dim ExcelApp,Exlsheet,ExcelWorkBook
 Set ExcelApp = CreateObject("Excel.Application")
 ExcelApp.Visible = True
 ExcelApp.DisplayAlerts = False
 Set ExcelWorkBook = ExcelApp.Workbooks.Open(ResourceFile)
 Set Exlsheet = ExcelApp.Sheets("对象库")
 Exlsheet.Activate
 
 Set XmlObj = XMLUtil.CreateXMLFromFile(XmlFile)
 
  '---当前行
 curRow = 1
 '----子对象个数
 childCnt = 1
 
 '---------获取根对象
 Set bjRoot = XmlObj.GetRootElement().ChildElements().ItemByName("qtpRep:Objects")
 set  Children = ObjRoot.ChildElementsByPath( "./qtpRep:Object" )
 
 For i = 1 to Children.count()
  ' 第一层对象
  Layer =  0
  ReDim Preserve CurLayerIndex(Layer)
  CurLayerIndex(Layer )  = i
  j = 1
  Set Child = Children.item(i) 
  curRow = curRow + 1
  Parent = curRow - 1
  Set Children = Child.ChildElementsByPath( "./qtpRep:ChildObjects/qtpRep:Object" )
 
  sourceID =  curRow - 1
  Call GetAttrib(Child,sourceClass,sourceName)
  ParentID = 0
  Exlsheet.cells(curRow,1) = sourceID
  Exlsheet.cells(curRow,2) = sourceName
  Exlsheet.cells(curRow,3) = ParentID
  Exlsheet.cells(curRow,4) = sourceClass
  Exlsheet.cells(curRow,5) = "(" + chr(34) + sourceName + chr(34) + ")"
 
  If Children.count() >0  Then
   Layer = Layer + 1
   ReDim Preserve CurLayerIndex(Layer)
  End If
 
  While Children.count() > 0
    If  Children.count() >= j  Then
     CurLayerIndex(Layer )  = j
     Set Child = Children.item(j)
    
     curRow = curRow + 1
     sourceID =  curRow-1
     Call GetAttrib(Child,sourceClass,sourceName)
     ParentID = Parent
     Exlsheet.cells(curRow,1) = sourceID
     Exlsheet.cells(curRow,2) = sourceName
     Exlsheet.cells(curRow,3) = ParentID
     Exlsheet.cells(curRow,4) = sourceClass
     Exlsheet.cells(curRow,5) = "(" + chr(34) + sourceName + chr(34) + ")"
    
     childCnt = Child.ChildElementsByPath( "./qtpRep:ChildObjects/qtpRep:Object" ).count()
 
     If  childCnt > 0 Then
      Layer = Layer + 1
      ReDim Preserve CurLayerIndex(Layer)
      Set Children = Child.ChildElementsByPath( "./qtpRep:ChildObjects/qtpRep:Object" )
      Parent = curRow - 1
      j = 1
      CurLayerIndex(Layer )  = j
     Else
      j = j + 1
     End If
    Else
     temprow = CurRow
     parent = CInt(Exlsheet.cells(parent + 1,3))
    
     Layer = Layer - 1
     Set Child = Child.Parent.Parent
     Set Children = Child.Parent.Parent.ChildElementsByPath( "./qtpRep:ChildObjects/qtpRep:Object" )
              
      j = CurLayerIndex(Layer) + 1
    End If
  Wend
  Set Children = Child.Parent.ChildElementsByPath( "./qtpRep:Object" )
 Next
 ExcelWorkBook.save
 ExcelApp.Quit
 Set ExcelApp = Nothing
End Function

'--------------------------------------
' 获取资源对象的描述
'--------------------------------------
Public Function GetAttrib(byval Obj,byref attrClass,byref attrName)
 Dim attrIdx
 GetAttrib = ""
 Set CurPara = Obj
 Set attribs = CurPara.Attributes()
 Set attr = attribs.Item(1)
 attrClass = attr.Value()
 GetAttrib = GetAttrib + attr.name() + "=" + chr(34) + attrClass + chr(34) + " "
 Set attr = attribs.Item(2)
 attrName = attr.Value()
 GetAttrib = GetAttrib + attr.name() + "=" + chr(34) + attrName + chr(34)

End Function