我在修改遗留VB6应用程序的一些增强功能处于不利的位置。转换为更聪明的语言不是一个选择。
该应用程序依赖于大量用户定义的类型来移动数据。我想定义一个通用函数，可以引用任何这些类型并提取包含的数据。
在伪代码中，我正在寻找的是：
Public Sub PrintUDT ( vData As Variant )
for each vDataMember in vData
print vDataMember.Name & ": " & vDataMember.value
next vDataMember
End Sub
似乎这个信息需要可用于COM某个地方…任何VB6大师在那里关心拍摄？
谢谢，
担
只要您的UDT被声明为Public并且在Public类中定义，您可以在运行时使用TypeLib Information组件检查UDT实例。这是为了使VB6为您的UDT生成COM兼容类型的信息(然后可以使用TypeLib信息组件中的各种类别枚举)。满足这个要求的最简单的方法就是把你所有的UDT放到一个公共的UserTypes类中，这个类将被编译成一个ActiveX DLL或者ActiveX EXE。
一个工作实例的总结
此示例包含三个部分：
>第1部分：创建一个将包含所有公共UDT声明的ActiveX DLL项目
>第2部分：创建一个示例PrintUDT方法来演示如何枚举UDT实例的字段
>第3部分：创建一个自定义迭代器类，允许您轻松地遍历任何公共UDT的字段，并获取字段名称和值。
工作实例
第1部分：ActiveX DLL
正如我已经提到的，您需要使您的UDT可以公开访问，以便使用TypeLib信息组件枚举它们。完成此操作的唯一方法是将您的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->属性下)设置为“(无)”并编译项目。您现在应该有一个名为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
第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 …在语法中迭代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方法上设置某些Procedure Attributes(如代码注释中所述)。您可以从工具菜单(工具 – >过程属性)更改过程属性。
最后，我们需要一个实用功能(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类。