有没有办法枚举vb6类模块中的所有属性?

时间:2010-07-11 06:20:41

标签: reflection vb6

在.Net中,您可以使用反射来访问类的所有属性的枚举。用VB6类模块可以做到这一点吗?

1 个答案:

答案 0 :(得分:4)

发现它!

您需要设置对TypeLib库(tlbinf32.dll)的引用,然后您可以使用类似的代码(这是类模块):

编辑:不幸的是,虽然下面的代码在VB6 IDE中以调试模式运行时按预期工作,但在编译时失败。在编译任何读取.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

我非常喜欢this post