Есть ли способ перечислить все свойства в модуле класса vb6?

Question

В .Net вы можете использовать отражение, чтобы получить доступ к перечислению всех свойств класса.Можно ли это сделать также с помощью модуля класса VB6?

Answer 1

Нашли это!

Вам нужно установить ссылку на библиотеку TypeLib (tlbinf32.dll), а затем вы можете использовать такой код (это модуль класса):

РЕДАКТИРОВАТЬ: К сожалению, приведенный ниже код работает как ожидаетсяработать в режиме отладки в среде IDE VB6, происходит сбой при компиляции.После компиляции любой попытки чтения свойства .Members возникает ошибка «Объект не поддерживает это действие» (445).Я отказался от этого, если кто-то не может заставить приведенный ниже код работать как внутри, так и за пределами IDE.

Option Explicit
Private TLI As TLIApplication
Private m_clsInterface As InterfaceInfo
Private m_clsClassUnderInvestigation As Object

Private Sub Class_Terminate()

    Set m_clsClassUnderInvestigation = Nothing
    Set m_clsInterface = Nothing
    Set TLI = Nothing
End Sub


Public Sub FillListBoxWithMembers(pList As ListBox, Optional pObject As Object)
    Dim lMember As MemberInfo
    If pObject = Empty Then
        Set pObject = ClassUnderInvestigation
    End If
    Set m_clsInterface = TLI.InterfaceInfoFromObject(pObject)

    For Each lMember In m_clsInterface.Members
        pList.AddItem lMember.Name & " - " & WhatIsIt(lMember)
    Next

    Set pObject = Nothing
End Sub

Public Function GetPropertyLetNames() As Collection
    Dim filters(1 To 1) As InvokeKinds
    filters(1) = INVOKE_PROPERTYPUT
    Set GetPropertyLetNames = Filter(filters)
End Function

Public Function GetPropertySetNames() As Collection
    Dim filters(1 To 1) As InvokeKinds
    filters(1) = INVOKE_PROPERTYPUTREF
    Set GetPropertySetNames = Filter(filters)
End Function

Public Function GetPropertyLetAndSetNames() As Collection
    Dim filters(1 To 2) As InvokeKinds
    filters(1) = INVOKE_PROPERTYPUT
    filters(2) = INVOKE_PROPERTYPUTREF
    Set GetPropertyLetAndSetNames = Filter(filters)
End Function

Public Function GetPropertyGetNames() As Collection
    Dim filters(1 To 1) As InvokeKinds
    filters(1) = INVOKE_PROPERTYGET
    Set GetPropertyGetNames = Filter(filters)
End Function

Private Function Filter(filters() As InvokeKinds) As Collection
    Dim Result As New Collection
    Dim clsMember As MemberInfo
    Dim i As Integer

    For Each clsMember In m_clsInterface.Members
        For i = LBound(filters) To UBound(filters)
            If clsMember.InvokeKind = filters(i) Then
                Result.Add clsMember.Name
            End If
        Next i
    Next
    Set Filter = Result
End Function
Private Function WhatIsIt(lMember As Object) As String
    Select Case lMember.InvokeKind
        Case INVOKE_FUNC
            If lMember.ReturnType.VarType <> VT_VOID Then
                WhatIsIt = "Function"
            Else
                WhatIsIt = "Method"
            End If
        Case INVOKE_PROPERTYGET
            WhatIsIt = "Property Get"
        Case INVOKE_PROPERTYPUT
            WhatIsIt = "Property Let"
        Case INVOKE_PROPERTYPUTREF
            WhatIsIt = "Property Set"
        Case INVOKE_CONST
            WhatIsIt = "Const"
        Case INVOKE_EVENTFUNC
            WhatIsIt = "Event"
        Case Else
            WhatIsIt = lMember.InvokeKind & " (Unknown)"
    End Select
End Function

Private Sub Class_Initialize()
    Set TLI = New TLIApplication
End Sub

Public Property Get ClassUnderInvestigation() As Object

    Set ClassUnderInvestigation = m_clsClassUnderInvestigation

End Property

Public Property Set ClassUnderInvestigation(clsClassUnderInvestigation As Object)
    Set m_clsClassUnderInvestigation = clsClassUnderInvestigation
    Set m_clsInterface = TLI.InterfaceInfoFromObject(m_clsClassUnderInvestigation)
End Property

Я сильно склонен к этому посту .