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 项目，请转到 Project->References 并检查标有“TypeLib Information”的条目。请注意，您必须在应用程序的安装程序中分发和注册 tlbinf32.dll。

您可以在运行时使用 TypeLib Information 组件检查 UDT 实例，只要您的 UDT 声明为 Public 并在 Public 类中定义。这对于使 VB6 为您的 UDT 生成与 COM 兼容的类型信息是必要的（然后可以使用 TypeLib 信息组件中的各种类进行枚举）。满足此要求的最简单方法是将所有 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（在Project->Properties下）设置为“(None)”并编译项目。您现在应该有一个名为 UDTLibrary.dll 的新文件。

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

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

首先，首先创建一个新的标准 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（稍后我们将定义一个实用方法，它将代表调用代码创建实例）。

编辑：（2009 年 2 月 15 日）我已经清理了更多代码。

'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 方法上设置某些过程属性（如代码 cmets 中所述）。您可以从工具菜单（工具->过程属性）更改过程属性。

最后，我们需要一个实用函数（本节第一个代码示例中的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 类。

Answer 2

@丹，

您似乎正在尝试使用 UDT 的 RTTI。如果在运行时之前不了解 UDT，我认为您无法真正获得该信息。 为了让你开始尝试：

Understanding UDTs
因为没有这种反射能力。我会为我的 UDT 创建自己的 RTTI。

给你一个基线。试试这个：

Type test
    RTTI as String
    a as Long
    b as Long 
    c as Long
    d as Integer
end type

您可以编写一个实用程序来打开每个源文件并将带有类型名称的 RTTI 添加到 UDT。将所有 UDT 放在一个公共文件中可能会更好。

RTTI 应该是这样的：

“字符串：长：长：长：整数”

使用 UDT 的内存，您可以提取值。

Answer 3

如果您将所有类型更改为类。你有选择。从类型更改为类的最大缺陷是您必须使用新的密钥世界。每次有一个类型变量的声明添加新的。

然后您可以使用变体关键字或 CallByName。 VB6 没有任何类型的反射，但您可以列出有效字段并测试它们是否存在

类测试有以下内容

Public Key As String
Public Data As String

然后您可以执行以下操作

Private Sub Command1_Click()
    Dim T As New Test 'This is NOT A MISTAKE read on as to why I did this.
    T.Key = "Key"
    T.Data = "One"
    DoTest T
End Sub

Private Sub DoTest(V As Variant)
    On Error Resume Next
    Print V.Key
    Print V.Data
    Print V.DoesNotExist
    If Err.Number = 438 Then Print "Does Not Exist"
    Print CallByName(V, "Key", VbGet)
    Print CallByName(V, "Data", VbGet)
    Print CallByName(V, "DoesNotExist", VbGet)
    If Err.Number = 438 Then Print "Does Not Exist"
End Sub

如果您尝试使用不存在的字段，则会引发错误 438。 CallByName 允许您使用字符串来调用类的字段和方法。

当您将 Dim 声明为 New 时，VB6 所做的事情非常有趣，并且将大大减少此转换中的错误。你看这个

Dim T as New Test

不完全等同于

Dim T as Test
Set T = new Test

例如，这将起作用

Dim T as New Test
T.Key = "A Key"
Set T = Nothing
T.Key = "A New Key"

这会报错

Dim T as Test
Set T = New Test
T.Key = "A Key"
Set T = Nothing
T.Key = "A New Key"

这样做的原因是，在第一个示例中，VB6 标记了 T，以便在访问成员时检查 T 是否为空。如果是，它将自动创建测试类的新实例，然后分配变量。

在第二个示例中，VB 没有添加此行为。

在大多数项目中，我们严格确保我们将 Dim T 作为测试，设置 T = 新测试。但是在您的情况下，因为您想使用 Dim T 作为新测试将类型转换为副作用最少的类是要走的路。这是因为 Dim as New 导致变量更接近地模仿类型的工作方式。