有没有办法枚举 vb6 类模块中的所有属性? [英] Is there a way to enumerate all properties in a vb6 class module?

问题描述

在 .Net 中，您可以使用反射来访问类的所有属性的枚举.这也可以用 VB6 类模块来完成吗?

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?

推荐答案

找到了！

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

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):

不幸的是，虽然下面的代码在 VB6 IDE 中以调试模式运行时按预期工作，但编译时失败.编译任何读取 .Members 属性的尝试后都会导致对象不支持此操作"错误 (445).我已经放弃了，除非有人能让下面的代码在 IDE 内外都能工作.

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

我非常感谢这篇文章.

这篇关于有没有办法枚举 vb6 类模块中的所有属性?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！