Is there a way to enumerate all properties in a vb

问题:

In .Net you can use reflection to get access to an enumeration of all properties of a class. Can this be done too with a VB6 class module?

回答1:

Found it!

You need to set a reference to the TypeLib library (tlbinf32.dll) and then you can use code like (this is class module):

EDIT: Unfortunately, while the code below works as expected when run in debug mode inside the VB6 IDE, it fails when compiled. After compiling any attempt to read the .Members propery causes an 'Object doesn't support this action' error (445). I have given up on it, unless someone can make the code below work both in and outside of the 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

I am heavily endebted to this post.