与其他人所说的相反,在 VB6 中可以获得 UDT 的运行时类型信息(尽管它不是内置的语言功能)。微软的TypeLib 信息对象库 http://msdn.microsoft.com/en-us/magazine/bb985086.aspx(tlbinf32.dll) 允许您在运行时以编程方式检查 COM 类型信息。如果您安装了 Visual Studio,您应该已经拥有此组件:要将其添加到现有 VB6 项目,请转到项目->参考文献并检查标有“TypeLib Information”的条目。请注意,您必须在应用程序的安装程序中分发并注册 tlbinf32.dll。
您可以在运行时使用 TypeLib 信息组件检查 UDT 实例,只要您的 UDT 已声明Public
并被定义在一个Public
班级。为了使 VB6 为 UDT 生成 COM 兼容的类型信息(然后可以使用 TypeLib 信息组件中的各种类来枚举),这是必需的。满足此要求的最简单方法是将所有 UDT 放入公共UserTypes
将被编译成 ActiveX DLL 或 ActiveX EXE 的类。
工作示例摘要
这个例子包含三个部分:
-
Part 1:创建一个包含所有公共 UDT 声明的 ActiveX DLL 项目
-
Part 2: 创建一个例子
PrintUDT
演示如何枚举 UDT 实例的字段的方法
-
Part 3:创建自定义迭代器类,使您可以轻松迭代任何公共 UDT 的字段并获取字段名称和值。
工作示例
第 1 部分:ActiveX DLL
正如我已经提到的,您需要使 UDT 可供公众访问,以便使用 TypeLib 信息组件枚举它们。实现此目的的唯一方法是将 UDT 放入 ActiveX DLL 或 ActiveX EXE 项目内的公共类中。应用程序中需要访问 UDT 的其他项目将引用这个新组件。
要遵循此示例,首先创建一个新的 ActiveX DLL 项目并将其命名UDTLibrary
.
接下来,重命名Class1
类模块(IDE 默认添加)到UserTypes
并向该类添加两个用户定义的类型,Person
and 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
类为“2-PublicNotCreatable”。任何人都没有理由实例化UserTypes
直接类,因为它只是充当我们的 UDT 的公共容器。
最后,确保Project Startup Object
(under 项目->属性)设置为“(无)”并编译项目。您现在应该有一个名为UDTLibrary.dll
.
第 2 部分:枚举 UDT 类型信息
现在是时候演示如何使用 TypeLib 对象库来实现PrintUDT
method.
首先,首先创建一个新的标准 EXE 项目,并将其命名为您喜欢的名称。添加对文件的引用UDTLibrary.dll
这是在第 1 部分中创建的。由于我只想演示其工作原理,因此我们将使用“立即”窗口来测试我们将编写的代码。
创建一个新模块,命名它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 的字段,以及模块中创建一个实用程序函数UDTMemberIterator
对于给定的 UDT 实例。这将允许您在代码中执行类似以下操作,这与您在问题中发布的伪代码更接近:
Dim member As UDTMember 'UDTMember wraps a TLI.MemberInfo instance'
For Each member In UDTMemberIteratorFor(someUDT)
Debug.Print member.Name & " : " & member.Value
Next
实际上做到这一点并不太难,我们可以重用大部分代码PrintUDT
第 2 部分中创建的例程。
首先,新建一个ActiveX项目并命名UDTTypeInformation
或类似的东西。
接下来,确保新项目的启动对象设置为“(无)”。
要做的第一件事是创建一个简单的包装类,它将隐藏TLI.MemberInfo
类,并可以轻松获取 UDT 字段的名称和值。我给这个班级打电话UDTMember
. The 实例化这个类的属性应该是公共不可创建.
'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
,这将允许我们使用 VBFor Each...In
迭代 UDT 实例字段的语法。这Instancing
此类的属性应设置为PublicNotCreatable
(稍后我们将定义一个实用方法,它将代表调用代码创建实例)。
EDIT:(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
class.
请注意,为了使此类可迭代,以便For Each
可以与它一起使用,您必须在Item
and _NewEnum
方法(如代码注释中所述)。您可以从“工具”菜单(“工具”->“过程属性”)更改过程属性。
最后,我们需要一个效用函数(UDTMemberIteratorFor
在本节的第一个代码示例中)将创建一个UDTMemberIterator
对于 UDT 实例,我们可以对其进行迭代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
和UDTLibrary.dll
在第 1 部分中创建并在新模块中尝试以下代码:
'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
class.