Самопроверка UDT VB6
-
23-08-2019 - |
Вопрос
У меня такое чувство, что ответ на этот вопрос будет «невозможно», но я попробую...Я нахожусь в незавидном положении: модифицирую устаревшее приложение VB6 с некоторыми улучшениями.Переход на более умный язык невозможен.Приложение использует большую коллекцию определяемых пользователем типов для перемещения данных.Я хотел бы определить общую функцию, которая может ссылаться на любой из этих типов и извлекать содержащиеся в ней данные.
В псевдокоде вот что я ищу:
Public Sub PrintUDT ( vData As Variant )
for each vDataMember in vData
print vDataMember.Name & ": " & vDataMember.value
next vDataMember
End Sub
Похоже, эта информация должна быть где-то доступна COM...Кто-нибудь из гуру VB6 хочет попробовать?
Спасибо,
Дэн
Решение
Вопреки тому, что говорили другие, МОЖНО получить информацию о типе времени выполнения для UDT в VB6 (хотя это не встроенная функция языка).Microsoft Библиотека информационных объектов TypeLib (tlbinf32.dll) позволяет программно проверять информацию о типе COM во время выполнения.У вас уже должен быть этот компонент, если у вас установлена Visual Studio:чтобы добавить его в существующий проект VB6, перейдите к Проект->Ссылки и проверьте запись с надписью «Информация Typelib». Обратите внимание, что вам придется распространять и зарегистрировать TLBINF32.dll в программе настройки вашего приложения.
Вы можете проверять экземпляры UDT с помощью информационного компонента TypeLib во время выполнения, если ваши UDT объявлены. Public
и определяются в рамках Public
сорт.Это необходимо для того, чтобы VB6 генерировал информацию о типах, совместимую с COM, для ваших UDT (которые затем можно перечислять с помощью различных классов в компоненте информации TypeLib).Самый простой способ удовлетворить это требование — разместить все ваши UDT в общедоступном виде. UserTypes
класс, который будет скомпилирован в ActiveX DLL или ActiveX EXE.
Краткое изложение рабочего примера
Этот пример состоит из трех частей:
- Часть 1:Создание проекта ActiveX DLL, который будет содержать все общедоступные объявления UDT.
- Часть 2:Создание примера
PrintUDT
метод, демонстрирующий, как можно перечислять поля экземпляра определяемого пользователем типа. - Часть 3:Создание собственного класса итератора, который позволяет легко перебирать поля любого общедоступного определяемого пользователем типа и получать имена и значения полей.
Рабочий пример
Часть 1:Библиотека ActiveX
Как я уже упоминал, вам необходимо сделать ваши UDT общедоступными, чтобы перечислять их с помощью информационного компонента TypeLib.Единственный способ добиться этого — поместить ваши UDT в общедоступный класс внутри проекта ActiveX DLL или ActiveX EXE.Другие проекты в вашем приложении, которым необходим доступ к вашему UDT, будут ссылаться на этот новый компонент.
Чтобы следовать этому примеру, начните с создания нового проекта ActiveX DLL и назовите его. UDTLibrary
.
Далее переименуйте Class1
class-модуль (он добавляется в 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
класс на «2-PublicNotCreatable».Ни у кого нет оснований создавать экземпляры UserTypes
класс напрямую, потому что он просто действует как общедоступный контейнер для наших UDT.
Наконец, убедитесь, что Project Startup Object
(под Проект->Свойства) установлено значение «(Нет)» и скомпилируйте проект.Теперь у вас должен быть новый файл с именем UDTLibrary.dll
.
Часть 2:Перечисление информации о типе определяемого пользователем типа
Теперь пришло время продемонстрировать, как мы можем использовать библиотеку объектов TypeLib для реализации PrintUDT
метод.
Сначала начните с создания нового проекта Standard 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
class из вызывающего кода и упростите получение имени и значения поля UDT.Я позвонил в этот класс UDTMember
.А Создание экземпляров свойство для этого класса должно быть Пабликноткреатабле.
'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
синтаксис для перебора полей экземпляра определяемого пользователем типа.А 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
сорт.
Другие советы
@Дэн,
Похоже, вы пытаетесь использовать RTTI UDT.Я не думаю, что вы действительно сможете получить эту информацию, не зная о UDT до выполнения.Для начала попробуйте:
Понимание пользовательских типов
Из-за отсутствия этой способности отражения.Я бы создал свой собственный RTTI для своих UDT.
Чтобы дать вам основу.Попробуй это:
Type test
RTTI as String
a as Long
b as Long
c as Long
d as Integer
end type
Вы можете написать утилиту, которая будет открывать каждый исходный файл и добавлять RTTI с именем типа в UDT.Вероятно, было бы лучше поместить все UDT в общий файл.
RTTI будет примерно таким:
«Строка:Длинный:Длинный:Длинный:Целое»
Используя память UDT, вы можете извлечь значения.
Если вы измените все свои типы на классы.У вас есть варианты.Большая ошибка при переходе от типа к классу заключается в том, что вам придется использовать новый ключевой мир.Каждый раз при объявлении переменной типа добавляют новую.
Затем вы можете использовать ключевое слово варианта или 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 позволяет использовать строки для вызова полей и методов класса.
То, что делает VB6, когда вы объявляете Dim как New, весьма интересно и значительно сводит к минимуму ошибки в этом преобразовании.Ты видишь это
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 был выбран как Test, а Set T = New Test.Но в вашем случае, поскольку вы хотите преобразовать типы в классы с наименьшим количеством побочных эффектов, лучше всего использовать Dim T в качестве нового теста.Это связано с тем, что Dim as New заставляет переменную более точно имитировать работу типов.