vb6 - VB6 UDT的自检

Question

我觉得这将是“不可能的”答案，但是我会试一试...
我无法通过一些增强功能来修改旧版VB6应用程序。转换为更智能的语言不是一种选择。
该应用程序依赖大量用户定义的类型来移动数据。我想定义一个通用函数，该函数可以引用任何这些类型并提取包含的数据。
用伪代码，这就是我要寻找的东西：

Public Sub PrintUDT ( vData As Variant )
  for each vDataMember in vData
    print vDataMember.Name & ": " & vDataMember.value 
  next vDataMember 
End Sub

似乎此信息需要在某个地方提供给COM ...那里有任何VB6专家在乎吗？

谢谢，

担

Answer 1

与其他人所说的相反，可以在VB6中获取UDT的运行时类型信息（尽管它不是内置的语言功能）。 Microsoft的TypeLib Information Object Library（tlbinf32.dll）允许您在运行时以编程方式检查COM类型信息。如果已安装Visual Studio，则应该已经具有此组件：将其添加到现有的VB6项目中，请转到“项目”->“参考”并检查标记为“ TypeLib信息”的条目。请注意，您将必须在应用程序的安装程序中分发并注册tlbinf32.dll。

您可以在运行时使用TypeLib信息组件检查UDT实例，只要您的UDT被声明为Public并且在Public类中定义即可。为了使VB6为您的UDT生成COM兼容类型信息，这是必需的（然后可以用TypeLib Information组件中的各种类枚举）。满足此要求的最简单方法是将所有UDT放入公共UserTypes类中，该类将被编译为ActiveX DLL或ActiveX EXE。

工作示例摘要

本示例包含三个部分：


第1部分：创建将包含所有公共UDT声明的ActiveX DLL项目
第2部分：创建示例PrintUDT方法以演示如何枚举UDT实例的字段
第3部分：创建自定义迭代器类，使您可以轻松地遍历任何公共UDT的字段并获取字段名称和值。




工作示例

第1部分：ActiveX DLL

正如我已经提到的，您需要使您的UDT公开访问，以便使用TypeLib Information组件枚举它们。实现此目的的唯一方法是将您的UDT放入ActiveX DLL或ActiveX EXE项目中的公共类中。然后，应用程序中需要访问UDT的其他项目将引用此新组件。

要继续执行此示例，请先创建一个新的ActiveX DLL项目并将其命名为UDTLibrary。

接下来，将Class1类模块（IDE默认添加）重命名为UserTypes，并向该类添加两个用户定义的类型Person和Animal：

' UserTypes.cls '

Option Explicit

Public Type Person
    FirstName As String
    LastName As String
    BirthDate As Date
End Type

Public Type Animal
    Genus As String
    Species As String
    NumberOfLegs As Long
End Type

清单1： UserTypes.cls充当UDT的容器

接下来，将 UserTypes类的Instancing属性更改为“ 2-PublicNotCreatable”。没有任何人可以直接实例化 UserTypes类，因为它只是充当我们UDT的公共容器。

最后，确保 Project Startup Object（在“项目”->“属性”下）设置为“（无）”并编译该项目。现在，您应该有一个名为 UDTLibrary.dll的新文件。

第2部分：枚举UDT类型信息

现在是时候演示如何使用TypeLib对象库实现 PrintUDT方法。

首先，首先创建一个新的Standard EXE项目，然后根据需要进行调用。添加对在第1部分中创建的文件 UDTLibrary.dll的引用。由于我仅想演示其工作原理，因此我们将使用“即时”窗口来测试将要编写的代码。

创建一个新的模块，将其命名为 UDTUtils并添加以下代码：

'UDTUtils.bas'
Option Explicit    

Public Sub PrintUDT(ByVal someUDT As Variant)

    ' Make sure we have a UDT and not something else... '
    If VarType(someUDT) <> vbUserDefinedType Then
        Err.Raise 5, , "Parameter passed to PrintUDT is not an instance of a user-defined type."
    End If

    ' Get the type information for the UDT '
    ' (in COM parlance, a VB6 UDT is also known as VT_RECORD, Record, or struct...) '

    Dim ri As RecordInfo
    Set ri = TLI.TypeInfoFromRecordVariant(someUDT)

    'If something went wrong, ri will be Nothing'

    If ri Is Nothing Then
        Err.Raise 5, , "Error retrieving RecordInfo for type '" & TypeName(someUDT) & "'"
    Else

        ' Iterate through each field (member) of the UDT '
        ' and print the out the field name and value     '

        Dim member As MemberInfo
        For Each member In ri.Members

            'TLI.RecordField allows us to get/set UDT fields:                 '
            '                                                                 '
            ' * to get a fied: myVar = TLI.RecordField(someUDT, fieldName)    '
            ' * to set a field TLI.RecordField(someUDT, fieldName) = newValue ' 
            '                                                                 '
            Dim memberVal As Variant
            memberVal = TLI.RecordField(someUDT, member.Name)

            Debug.Print member.Name & " : " & memberVal

        Next

    End If

End Sub

Public Sub TestPrintUDT()

    'Create a person instance and print it out...'

    Dim p As Person

    p.FirstName = "John"
    p.LastName = "Doe"
    p.BirthDate = #1/1/1950#

    PrintUDT p

    'Create an animal instance and print it out...'

    Dim a As Animal

    a.Genus = "Canus"
    a.Species = "Familiaris"
    a.NumberOfLegs = 4

    PrintUDT a

End Sub

清单2：一个示例 PrintUDT方法和一个简单的测试方法

第3部分：使其成为面向对象

上面的示例对如何使用TypeLib信息对象库枚举UDT的字段进行了“快速而肮脏的”演示。在现实世界中，我可能会创建一个 UDTMemberIterator类，该类使您可以更轻松地遍历UDT的字段，以及在模块中为给定UDT实例创建 UDTMemberIterator的实用程序函数。这将使您可以在代码中执行类似以下的操作，这与您在问题中发布的伪代码非常接近：

Dim member As UDTMember 'UDTMember wraps a TLI.MemberInfo instance'

For Each member In UDTMemberIteratorFor(someUDT)
   Debug.Print member.Name & " : " & member.Value
Next

实际上，这样做并不难，我们可以重复使用第2部分中创建的 PrintUDT例程中的大多数代码。

首先，创建一个新的ActiveX项目并将其命名为 UDTTypeInformation或类似名称。

接下来，确保将新项目的启动对象设置为“（无）”。

要做的第一件事是创建一个简单的包装器类，该类将对调用代码隐藏 TLI.MemberInfo类的详细信息，并使获取UDT字段的名称和值变得容易。我称此类为 UDTMember。此类的Instancing属性应为PublicNotCreatable。

'UDTMember.cls'
Option Explicit

Private m_value As Variant
Private m_name As String

Public Property Get Value() As Variant
    Value = m_value
End Property

'Declared Friend because calling code should not be able to modify the value'
Friend Property Let Value(rhs As Variant)
    m_value = rhs
End Property

Public Property Get Name() As String
    Name = m_name
End Property

'Declared Friend because calling code should not be able to modify the value'
Friend Property Let Name(ByVal rhs As String)
    m_name = rhs
End Property

清单3： UDTMember包装器类

现在我们需要创建一个迭代器类 UDTMemberIterator，该类将允许我们使用VB的 For Each...In语法来迭代UDT实例的字段。此类的 Instancing属性应设置为 PublicNotCreatable（稍后我们将定义一个实用程序方法，该方法将代表调用代码创建实例）。

编辑：（2/15/09）我已经清理了一些代码。

'UDTMemberIterator.cls'

Option Explicit

Private m_members As Collection ' Collection of UDTMember objects '


' Meant to be called only by Utils.UDTMemberIteratorFor '
'                                                       '
' Sets up the iterator by reading the type info for     '
' the passed-in UDT instance and wrapping the fields in '
' UDTMember objects                                     '

Friend Sub Initialize(ByVal someUDT As Variant)

    Set m_members = GetWrappedMembersForUDT(someUDT)

End Sub

Public Function Count() As Long

    Count = m_members.Count

End Function

' This is the default method for this class [See Tools->Procedure Attributes]   '
'                                                                               '
Public Function Item(Index As Variant) As UDTMember

    Set Item = GetWrappedUDTMember(m_members.Item(Index))

End Function

' This function returns the enumerator for this                                     '
' collection in order to support For...Each syntax.                                 '
' Its procedure ID is (-4) and marked "Hidden" [See Tools->Procedure Attributes]    '
'                                                                                   '
Public Function NewEnum() As stdole.IUnknown

    Set NewEnum = m_members.[_NewEnum]

End Function

' Returns a collection of UDTMember objects, where each element                 '
' holds the name and current value of one field from the passed-in UDT          '
'                                                                               '
Private Function GetWrappedMembersForUDT(ByVal someUDT As Variant) As Collection

    Dim collWrappedMembers As New Collection
    Dim ri As RecordInfo
    Dim member As MemberInfo
    Dim memberVal As Variant
    Dim wrappedMember As UDTMember

    ' Try to get type information for the UDT... '

    If VarType(someUDT) <> vbUserDefinedType Then
        Fail "Parameter passed to GetWrappedMembersForUDT is not an instance of a user-defined type."
    End If

    Set ri = tli.TypeInfoFromRecordVariant(someUDT)

    If ri Is Nothing Then
        Fail "Error retrieving RecordInfo for type '" & TypeName(someUDT) & "'"
    End If

    ' Wrap each UDT member in a UDTMember object... '

    For Each member In ri.Members

        Set wrappedMember = CreateWrappedUDTMember(someUDT, member)
        collWrappedMembers.Add wrappedMember, member.Name

    Next

    Set GetWrappedMembersForUDT = collWrappedMembers

End Function

' Creates a UDTMember instance from a UDT instance and a MemberInfo object  '
'                                                                           '
Private Function CreateWrappedUDTMember(ByVal someUDT As Variant, ByVal member As MemberInfo) As UDTMember

    Dim wrappedMember As UDTMember
    Set wrappedMember = New UDTMember

    With wrappedMember
        .Name = member.Name
        .Value = tli.RecordField(someUDT, member.Name)
    End With

    Set CreateWrappedUDTMember = wrappedMember

End Function

' Just a convenience method
'
Private Function Fail(ByVal message As String)

    Err.Raise 5, TypeName(Me), message

End Function

清单4： UDTMemberIterator类。

请注意，为了使此类可迭代以便可以使用 For Each，您将必须在 Item和 _NewEnum方法上设置某些过程属性（如代码注释中所述）。您可以从“工具”菜单（“工具”->“过程属性”）更改过程属性。

最后，我们需要一个实用函数（在本节的第一个代码示例中为 UDTMemberIteratorFor），该函数将为UDT实例创建一个 UDTMemberIterator，然后可以使用 For Each进行迭代。创建一个名为 Utils的新模块，并添加以下代码：

'Utils.bas'

Option Explicit

' Returns a UDTMemberIterator for the given UDT    '
'                                                  '
' Example Usage:                                   '
'                                                  '
' Dim member As UDTMember                          '
'                                                  '        
' For Each member In UDTMemberIteratorFor(someUDT) '
'    Debug.Print member.Name & ":" & member.Value  '
' Next                                             '
Public Function UDTMemberIteratorFor(ByVal udt As Variant) As UDTMemberIterator

    Dim iterator As New UDTMemberIterator
    iterator.Initialize udt

    Set UDTMemberIteratorFor = iterator

End Function

清单5： UDTMemberIteratorFor实用程序功能。

最后，编译项目并创建一个新项目以对其进行测试。

在测试项目中，添加对新创建的 UDTTypeInformation.dll和在第1部分中创建的 UDTLibrary.dll的引用，并在新模块中尝试以下代码：

'Module1.bas'

Option Explicit

Public Sub TestUDTMemberIterator()

    Dim member As UDTMember

    Dim p As Person

    p.FirstName = "John"
    p.LastName = "Doe"
    p.BirthDate = #1/1/1950#

    For Each member In UDTMemberIteratorFor(p)
        Debug.Print member.Name & " : " & member.Value
    Next

    Dim a As Animal

    a.Genus = "Canus"
    a.Species = "Canine"
    a.NumberOfLegs = 4

    For Each member In UDTMemberIteratorFor(a)
        Debug.Print member.Name & " : " & member.Value
    Next

End Sub

清单6：测试 UDTMemberIterator类。