Перечисление членов объекта

[ReMAG]

Собственно, сабж. Есть, например, объект WebBrowser.Document. Нужно перечислить все его члены и засунуть их в TreeView. Если все это сделать рекурсивно, то результат по идее получится как в WatchWindow. Но как это сделать - никаких идей пока нет

[GSerg]

Подключи TypeLib Information в references.

[ReMAG]

Подключи TypeLib Information в references.

Подключил сразу, но вопрос в том, как перечислить все члены этого документа (с их значениями) в ран-тайме.

[GSerg]

Ну после подключения возникли какие-то мысли по использованию? Там, может методы ClassInfoFromObject или InterfaceInfoFromObject были замечены, или ещё что...

[ReMAG]

Ну после подключения возникли какие-то мысли по использованию? Там, может методы ClassInfoFromObject или InterfaceInfoFromObject были замечены, или ещё что...

Ок, InterfaceInfoFromObject возвращает структуру, в которой есть все нужные Members. Для рекурсивного построения дерева теперь необходимо отдать в InterfaceInfoFromObject все входящие объекты... Их имена определены в Members(i).Name, следовательно, нужно по имени объекта получить сам объект. Как это сделать?

[GSerg]

Очевидно, через members(i).value.

Хотя, если я ошибаюсь, то через callbyname(parent,members(i).name,vbGet), причём что вместо vbGet, определять из members(i).invokekind

[ReMAG]

Где-то я неправ, но где - не пойму...

Код: Выделить всё


Option Explicit
Private nCountId As Long, nRecLevel

Private Sub Form_Load()
   Tree.Nodes.Add , , "B_a_s_e", "Root"
   AddToTree frmMain.Browser.Document, "B_a_s_e"
End Sub

Private Sub AddToTree(Obj As Object, cParent As String)
   Dim IFaceInfo As TLI.InterfaceInfo, i As Long, cLine As String
   Dim oChild As Object
   
   nRecLevel = nRecLevel + 1
   If nRecLevel < 10 Then
      Set IFaceInfo = TLI.InterfaceInfoFromObject(Obj)
      On Error Resume Next
      For i = 1 To IFaceInfo.Members.Count
         cLine = IFaceInfo.Members(i).Name
         cLine = cLine & " = " & IFaceInfo.Members(i).Value
         nCountId = nCountId + 1
         Tree.Nodes.Add cParent, tvwChild, "Key" & CStr(nCountId), cLine
         Set oChild = Nothing
         Select Case IFaceInfo.Members(i).InvokeKind
            Case INVOKE_CONST
               Set oChild = CallByName(Obj, IFaceInfo.Members(i).Name, VbGet)
            Case INVOKE_EVENTFUNC
               ' методы закомментарил, т.к. они по CallByName выполняются...
               'Set oChild = CallByName(Obj, IFaceInfo.Members(i).Name, VbMethod)
            Case INVOKE_FUNC
               'Set oChild = CallByName(Obj, IFaceInfo.Members(i).Name, VbMethod)
            Case INVOKE_PROPERTYGET
               Set oChild = CallByName(Obj, IFaceInfo.Members(i).Name, VbGet)
            Case INVOKE_PROPERTYPUT
               Set oChild = CallByName(Obj, IFaceInfo.Members(i).Name, VbLet)
            Case INVOKE_PROPERTYPUTREF
               Set oChild = CallByName(Obj, IFaceInfo.Members(i).Name, VbSet)
            Case INVOKE_UNKNOWN
               Set oChild = CallByName(Obj, IFaceInfo.Members(i).Name, VbGet)
         End Select
         If Not oChild Is Nothing Then
            AddToTree oChild, "Key" & CStr(nCountId)
         End If
      Next i
      On Error GoTo 0
      Set IFaceInfo = Nothing
   End If
   nRecLevel = nRecLevel - 1
End Sub



Value не определен ни у одного из элементов, и в дерево не попадают многие вложенные структуры типа "frames".

[GSerg]

Хм... Для начала, убрать все ветки, кроме INVOKE_PROPERTYGET... Всё равно от остальных толку нет... Потом, для мембера проверять .ReturnType.valuetype, и глядя на него решать, будет возвращён объект или нет...
После этого всего количество возникающих ошибок сильно сократится, и тогда убрать on error и отдебажить...

[ReMAG]

... Потом, для мембера проверять .ReturnType.valuetype, и глядя на него решать, будет возвращён объект или нет...

Насколько я понимаю, для объектов .ReturnType.VarType должен соответствовать значению VT_EMPTY = 0?

[GSerg]

Нет. VT_DISPATCH и VT_UNKNOWN.
Впрочем, ввиду позднего времени лучше проверь...

Но не EMPTY.

[ReMAG]

Нет. VT_DISPATCH и VT_UNKNOWN.
Впрочем, ввиду позднего времени лучше проверь...

Но не EMPTY.

Код: Выделить всё


Private Sub AddToTree(Obj As Object, cParent As String)
   Dim IFaceInfo As TLI.InterfaceInfo, i As Long, cLine As String
   Dim oChild As Object
   
   nRecLevel = nRecLevel + 1
   If nRecLevel < 10 Then
      Set IFaceInfo = TLI.InterfaceInfoFromObject(Obj)
      On Error Resume Next
      For i = 1 To IFaceInfo.Members.Count
         cLine = IFaceInfo.Members(i).Name
         cLine = cLine & " = " & IFaceInfo.Members(i).Value
         nCountId = nCountId + 1
         Tree.Nodes.Add cParent, tvwChild, "Key" & CStr(nCountId), cLine
         Set oChild = Nothing
         If IFaceInfo.Members(i).InvokeKind = INVOKE_PROPERTYGET Then
            ' через следующий фильтр ничего практически не проходит
            If IFaceInfo.Members(i).ReturnType.VarType = VT_UNKNOWN Or _
               IFaceInfo.Members(i).ReturnType.VarType = VT_DISPATCH Then
               Set oChild = CallByName(Obj, IFaceInfo.Members(i).Name, VbGet)
               AddToTree oChild, "Key" & CStr(nCountId)
            End If
         End If
      Next i
      On Error GoTo 0
      Set IFaceInfo = Nothing
   End If
   nRecLevel = nRecLevel - 1
End Sub


Как-то работает, когда VT_EMPTY, а с этими практически ничего не проходит (только Script, Namespases и ChildNodes).
И Value ни у одного элемента не определен (IFaceInfo.Members(i).Value в Watch-е показывает Application-defined or Object-defined error)

[GSerg]

Дорабатывай.

Код: Выделить всё

Option Explicit
Private nCountId As Long, nRecLevel As Long, done As Collection

Private Sub Form_Load()
  Tree.Nodes.Add , , "B_a_s_e", "Root"
 
  'Элементы содержат ссылки на родителей
  Set done = New Collection
 
  AddToTree Browser.Document, "B_a_s_e"
 
  Set done = Nothing
End Sub

Private Sub AddToTree(ByVal Obj As Object, cParent As String)
  Dim IFaceInfo As TLI.InterfaceInfo, i As Long, cLine As String
  Dim oChild As Object
 
  nRecLevel = nRecLevel + 1
 
  If nRecLevel < 5 Then
    Set IFaceInfo = TLI.InterfaceInfoFromObject(Obj)
   
    For i = 1 To IFaceInfo.Members.Count
      With IFaceInfo.Members(i)
        cLine = .Name
       
        If .InvokeKind = INVOKE_PROPERTYGET Then
          If .Parameters.Count = 0 Then
           
            On Error Resume Next
            Set oChild = CallByName(Obj, .Name, VbGet)
           
            If Err.Number Then
              Err.Clear
             
              On Error GoTo errh:
              cLine = cLine & " = """ & CallByName(Obj, .Name, VbGet) & """"
            End If
           
            On Error GoTo 0
           
            nCountId = nCountId + 1
            Tree.Nodes.Add cParent, tvwChild, "Key" & CStr(nCountId), cLine
           
            If Not oChild Is Nothing Then
              If Not InCol(done, CStr(ObjPtr(oChild))) Then
                done.Add oChild, CStr(ObjPtr(oChild))
                AddToTree oChild, "Key" & CStr(nCountId)
              End If
            End If
           
          End If
        End If
      End With
    Next
         
    Set IFaceInfo = Nothing
  End If
 
  nRecLevel = nRecLevel - 1
 
  Exit Sub
 
errh:
  cLine = cLine & " = <" & Err.Description & ">"
  Resume Next
End Sub

Private Function InCol(ByVal c As Collection, key As Variant) As Boolean
  On Error GoTo errh
  c.Item key
  InCol = True
  Exit Function
errh:
End Function

[ReMAG]

Дорабатывай.

Супер! Спасибо! Даже дорабатывать вроде не надо
Единственное, там где коллекции (как например WebBrowser.Document.Forms), в дереве отображается _newEnum, а в Watch-е все члены (Item 1, Item 2...), которые можно развернуть - это уже, видимо, нужно делать самому...

[ReMAG]

Вобщем, если я еще не натормозил, то может кому понадобится...

Код: Выделить всё


Option Explicit
Private nCountId As Long, nRecLevel As Long, done As Collection

Private Sub Form_Load()
   Tree.Nodes.Add , , "B_a_s_e", "Root"
   Set done = New Collection
   AddToTree frmMain.Browser.Document, "B_a_s_e"
   Set done = Nothing
End Sub

Private Sub AddToTree(ByVal Obj As Object, cParent As String)
   Dim IFaceInfo As TLI.InterfaceInfo, i As Long, cLine As String
   Dim oChild As Object
   
   Dim lHasEnum As Boolean, lHasMembers As Boolean
   Dim nMembers As Long, cMember As String, j As Long
   
   nRecLevel = nRecLevel + 1
   If nRecLevel < 5 Then
      Set IFaceInfo = TLI.InterfaceInfoFromObject(Obj)
      For i = 1 To IFaceInfo.Members.Count
         With IFaceInfo.Members(i)
            cLine = .Name
           
            ' это для коллекций
            If cLine = "_newEnum" Then lHasEnum = True
            If cLine = "length" Then lHasMembers = True
           
            If .InvokeKind = INVOKE_PROPERTYGET Then
               If .Parameters.Count = 0 Then
                  On Error Resume Next
                  Set oChild = CallByName(Obj, .Name, VbGet)
                  If Err.Number Then
                     Err.Clear
                     On Error GoTo errh:
                     If cLine = "length" Then
                        nMembers = CLng(CallByName(Obj, .Name, VbGet))
                        cLine = cLine & " = """ & CStr(nMembers) & """"
                     Else
                        cLine = cLine & " = """ & CallByName(Obj, .Name, VbGet) & """"
                     End If
                  End If
                  On Error GoTo 0
                  nCountId = nCountId + 1
                  Tree.Nodes.Add cParent, tvwChild, "Key" & CStr(nCountId), cLine
                  If Not oChild Is Nothing Then
                     If Not InCol(done, CStr(ObjPtr(oChild))) Then
                        done.Add oChild, CStr(ObjPtr(oChild))
                        AddToTree oChild, "Key" & CStr(nCountId)
                     End If
                  End If
               End If
            End If
         End With
      Next i
     
      ' добавление членов коллекций
      If lHasEnum And lHasMembers Then
         For j = 1 To nMembers
            nCountId = nCountId + 1
            cMember = "Item " & j
            Tree.Nodes.Add cParent, tvwChild, "Key" & CStr(nCountId), cMember
            Set oChild = CallByName(Obj, CStr(j - 1), VbGet)
            If Not InCol(done, CStr(ObjPtr(oChild))) Then
               done.Add oChild, CStr(ObjPtr(oChild))
               AddToTree oChild, "Key" & CStr(nCountId)
            End If
         Next j
      End If
      Set IFaceInfo = Nothing
   End If
   nRecLevel = nRecLevel - 1
   Exit Sub
errh:
   cLine = cLine & " = <" & Err.Description & ">"
   Resume Next
End Sub

Private Function InCol(ByVal c As Collection, key As Variant) As Boolean
   On Error GoTo errh
   c.Item key
   InCol = True
   Exit Function
errh:
End Function


Работает только долго... Еще раз большое спасибо!