Самостоятельная проверка УДТ VB6

Asked
Viewd8116

18

У меня такое чувство, что ответ на этот вопрос будет "невозможно", но я попробую ... Я нахожусь в незавидном положении, когда модифицирую устаревшее приложение VB6 с некоторыми улучшениями. Переход на более умный язык - это не вариант. Приложение использует большой набор определяемых пользователем типов для перемещения данных. Я хотел бы определить общую функцию, которая может ссылаться на любой из этих типов и извлекать содержащиеся данные.
В псевдокоде я ищу вот что:

 Public Sub PrintUDT ( vData As Variant )
  for each vDataMember in vData
    print vDataMember.Name & ": " & vDataMember.value 
  next vDataMember 
End Sub
 

Похоже, эта информация должна быть где-то доступна для COM ... Кто-нибудь из гуру VB6 захочет попробовать?

Спасибо,

Дэн

3 ответов

40

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

Вы можете проверять экземпляры UDT с помощью компонента TypeLib Information во время выполнения, если ваши 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 Information. Единственный способ добиться этого - поместить ваш 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

Затем измените свойство Instancing для класса UserTypes на «2-PublicNotCreatable». У кого-либо нет причин создавать экземпляр класса UserTypes напрямую, потому что он просто действует как публичный контейнер для наших UDT.

Наконец, убедитесь, что для Project Startup Object (в разделе Проект-> Свойства ) установлено значение «(Нет)», и скомпилируйте проект. Теперь у вас должен быть новый файл с именем UDTLibrary.dll.

Часть 2: Перечисление информации о типе UDT

Теперь пора продемонстрировать, какe может использовать библиотеку объектов 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

  • @Bob - Can you be more specific? I agree it’s not super elegant, but if you have any specific clean-up suggestions/ideas to make it look nicer, I’d be interested in hearing them.

    Mike Spross15 февраля 2009, 21:54
  • Whoa. Totally forgot about answers automatically switching to wiki mode after a certain number of revisions…

    Mike Spross15 февраля 2009, 23:09
  • Also, Bob’s comment about separately compiled had me nervous, but this worked fine as a new class in an existing ActiveX dll.

    Dan16 февраля 2009, 13:56
  • Just got finished with the “quick and dirty” version of implementation. Everything works like a charm! Like MarkJ said, would give +2 if possible. Although, this this solution could also have the unintended consequence of prolonging this component’s existence in VB6…

    Dan16 февраля 2009, 13:55
  • Thanks for the great answer! I’ve been trying to come up with a metyhod for this for a long time. I’ll see how an implementation goes today.

    Dan16 февраля 2009, 13:23
  • Hi again. Can you modify your code to make it handle nested UDTs? I have changes to do this, but would like to document them here for posterity. Thanks, Dan

    Dan16 февраля 2009, 14:38
  • The code needs some cleanup as well. GetWrappedmembersForUDT is particularly rough.

    Bob15 февраля 2009, 20:58
  • Of course this makes the assumption that you are working with UDTs that have type information, i.e. those declared in “public modules” (separately compiled DLL, OCX, etc.).

    Bob15 февраля 2009, 20:51
  • @Dan, я должен был быть более ясным в своем ответе относительно публикации UDT. Как вы обнаружили, UDT не обязательно должен находиться в отдельной DLL. Важно сделать их достоянием общественности. Я просто предложил поместить их в отдельную DLL, чтобы показать, что это работает, даже когда они находятся в другом файле

    Mike Spross17 февраля 2009, 00:56
1

@Dan,

Похоже, вы пытаетесь использовать RTTI UDT. Я не думаю, что вы действительно можете получить эту информацию, не зная о 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, вы можете извлекать значения.

  • Twisted, but ingenious (I mean that as a compliment!). I think it’ll be non-trivial to access the RTTI memory? Also, it only solves part of the problem though - he also wants to log the member names. I guess you could store them too in your RTTI member. I guess you did say it was a baseline

    MarkJ14 февраля 2009, 22:34
1

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

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

Во втором примере VB не добавляет такого поведения.

В большинстве проектов мы строго следим за тем, чтобы выбрать Dim T как Test, Set T = New Test. Но в вашем случае, поскольку вы хотите преобразовать типы в классы с наименьшим количеством побочных эффектов, используйте Dim T в качестве нового теста. Это связано с тем, что параметр Dim as New заставляет переменную более точно имитировать способ работы типов.

  • Be careful with “Dim As New”. For example, if you do “Dim acct As New BankAccount” and then later want to do “If acct Is Nothing” it won’t work as expected. VB6 will auto-instantiate acct if it is Nothing, so the check for Nothing will always return False. Can get you into trouble sometimes…

    Mike Spross16 февраля 2009, 01:13
  • …However, I do agree with your point here. For a type that has been converted to a class, there won’t be any existing checks for Nothing against variables of that type, so it’s only an issue if such a check is added later.

    Mike Spross16 февраля 2009, 01:15
  • I fixed the staff that didn’t get formatted as code it should be clearer

    RS Conley16 февраля 2009, 13:03