Вопреки тому, что говорили другие, возможно получить информацию о типах во время выполнения для UDT в VB6 (хотя это не встроенная языковая функция). Библиотека информационных объектов TypeLib от Microsoft (tlbinf32.dll) позволяет программно проверять информацию о типах COM во время выполнения. У вас уже должен быть этот компонент, если у вас установлена Visual Studio: чтобы добавить его в существующий проект VB6, перейдите в Project-> References и проверьте запись с пометкой «Информация о TypeLib». Обратите внимание, что вам нужно будет распространить и зарегистрировать tlbinf32.dll в программе установки вашего приложения.
Вы можете проверять экземпляры UDT, используя компонент информации TypeLib во время выполнения, если ваши UDT объявлены Public и определены в классе Public. Это необходимо для того, чтобы VB6 генерировал COM-совместимую информацию о типе для вашего UDT (который затем может быть перечислен с различными классами в компоненте TypeLib Information). Самый простой способ выполнить это требование - поместить все ваши UDT в открытый класс UserTypes, который будет скомпилирован в ActiveX DLL или ActiveX EXE.
Краткое изложение рабочего примера
Этот пример состоит из трех частей:
- Часть 1 : создание проекта ActiveX DLL, который будет содержать все публичные объявления UDT
- Часть 2 : создание примера метода
PrintUDT, чтобы продемонстрировать, как можно перечислять поля экземпляра UDT
- Часть 3 : Создание пользовательского класса итератора, который позволяет легко перебирать поля любого общедоступного UDT и получать имена и значения полей.
Рабочий пример
Часть 1: ActiveX DLL
Как я уже упоминал, вам нужно сделать ваш UDT общедоступным, чтобы перечислять их с помощью компонента информации TypeLib. Единственный способ сделать это - поместить свой UDT в открытый класс внутри проекта ActiveX DLL или ActiveX EXE. Другие проекты в вашем приложении, которым требуется доступ к вашему UDT, будут ссылаться на этот новый компонент.
Чтобы следовать этому примеру, начните с создания нового проекта DLL ActiveX и назовите его 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
Затем измените свойство Instancing для класса UserTypes на "2-PublicNotCreatable". Ни у кого нет причин создавать экземпляры класса UserTypes напрямую, потому что он просто действует как открытый контейнер для наших UDT.
Наконец, убедитесь, что для Project Startup Object (в Project-> Properties ) установлено значение "(Нет)" и скомпилируйте проект. Теперь у вас должен быть новый файл с именем UDTLibrary.dll.
Часть 2. Перечисление информации о типе UDT
Теперь пришло время продемонстрировать, как мы можем использовать библиотеку объектов TypeLib для реализации PrintUDT метода.
Сначала начните с создания нового проекта Standard EXE и назовите его как хотите. Добавьте ссылку на файл UDTLibrary.dll, созданный в части 1. Поскольку я просто хочу продемонстрировать, как это работает, мы будем использовать окно Immediate для проверки кода, который мы напишем.
Создайте новый модуль, назовите его 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. Свойство 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 (позже мы определим служебный метод, который будет создавать экземпляры от имени вызывающего кода).
РЕДАКТИРОВАТЬ: (15.02.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 в самом первом примере кода в этом разделе), которая создаст 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.