Самоконтроль UDT VB6

Ответ 1

В отличие от других, можно получить информацию типа времени выполнения для UDT в VB6 (хотя это не встроенная функция языка). Microsoft Библиотека информационных объектов TypeLib (tlbinf32.dll) позволяет программно проверять информацию типа COM во время выполнения. Вы должны уже иметь этот компонент, если у вас установлена ​​Visual Studio: чтобы добавить его в существующий проект VB6, перейдите в Project- > References и проверьте запись с надписью "Информация о TypeLib". Обратите внимание, что вам придется распространять и регистрировать tlbinf32.dll в своей программе установки приложений.

Вы можете проверять экземпляры UDT с помощью информационного компонента TypeLib во время выполнения, пока ваш UDT объявлен Public и определены в классе Public. Это необходимо для того, чтобы VB6 генерировал COM-совместимую информацию о типе для вашего UDT (который затем может быть перечислен с различными классами в информационном компоненте TypeLib). Самый простой способ удовлетворить это требование - поставить весь ваш UDT в общедоступный класс UserTypes, который будет скомпилирован в ActiveX DLL или ActiveX EXE.

Резюме рабочего примера

Этот пример содержит три части:

• Часть 1: создание DLL-проекта ActiveX, который будет содержать все общедоступные объявления UDT
• Часть 2: создание примера метода PrintUDT для демонстрации того, как вы можете перечислять поля экземпляра UDT
• Часть 3. Создание пользовательского класса итератора, который позволяет легко перебирать поля любого открытого UDT и получать имена и значения полей.

Рабочий пример

Часть 1: DLL ActiveX

Как я уже упоминал, вам нужно сделать общедоступным доступ к 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 (позже мы будем определять метод утилиты, который будет создавать экземпляры от имени вызывающего кода).

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.

Обратите внимание, что для того, чтобы сделать этот класс итерабельным, чтобы с ним можно было использовать 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.

Ответ 2

Если вы измените все свои типы на классы. У вас есть варианты. Большая ошибка перехода от типа к классу заключается в том, что вам нужно использовать новый keyworld. Каждый раз, когда объявление переменной типа добавляет новый.

Затем вы можете использовать ключевое слово варианта или 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 как New заставляет переменную подражать способу работы более тесно.

Ответ 3

@Dan,

Похоже, вы пытаетесь использовать RTTI UDT. Я не думаю, что вы действительно можете получить эту информацию, не зная о UDT перед временем выполнения. Чтобы начать работу, выполните следующие действия:

Понимание UDTs

Из-за отсутствия возможности отражения. Я бы создал свой собственный 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 будет примерно таким:

"Строка: Long: Long: Long: Integer"

Используя память UDT, вы можете извлечь значения.