自我检查的维生素b6Udt

StackOverflow https://stackoverflow.com/questions/547903

题

我有一种感觉，这个问题的答案将是"不可能"，但我会给它一个镜头...我的不值得羡慕的地位，修改了遗产维生素b6应用程序有一些改进。转换到一个聪明的语言不是一个选项。该应用程序依赖于一个大型的集合用户的定义类型的移动数据。我想定一个共同的功能，可以采取的一个参考任何这些类型和中提取数据。
在伪码，这是我在寻找什么:

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

这似乎是这一信息需要可COM的地方...任何维生素b6大师出有照顾到采取了一枪?

谢谢，

Dan

有帮助吗？

解决方案

相反的是，其他人已经说过，它是可能得到的运行时间类型的信息UDT的维生素b6在(尽管它不是一个建立在语言特征)。微软的 类型库的信息对象的图书馆 (tlbinf32.dll)用于通过程序检查COM类型的信息在运行时间。你应该已经有这种成分，如果你有些工作室安装：添加到现有的维生素b6项目，去 项目->文献 和检查进入标记"类型库的信息。" 注意，你将要分发和登记tlbinf32.dll 在应用程序的设置程序。

你可以检查UDT实例中使用的类型库的信息成分在运行时间，只要你UDT的声明 Public 和定义内 Public 类。这是必要的，以便使维生素b6产生COM兼容类型的信息对你UDT的(然后可以列举的各类的类型库的信息成分)。最简单的方法来满足这一要求将是把所有你的UDT的成一个公开 UserTypes 类，将被编制成一件DLL件或EXE。

摘要的工作实例

这个例子包含三个部分：

  • 第1部分:创建一件DLL项目，该项目将包含所有的公共UDT声明
  • 第2部分:创建一个例子 PrintUDT 方法说明如何可以列举的领域UDT实例
  • 第3部分:创建一个自定义的迭代的类可以让你轻松循环领域的任何公共UDT，并得到现场的名称和价值观。

工作实例

第1部分：这件DLL

正如我已经提到的，你需要让你UDT的公共访问，以便一一列举他们使用的类型库的信息组成部分。唯一的方式完成这个是把你的UDT的入公共类内部一件DLL件或EXE项目。其他项目，在应用程序，需要访问你的UDT的随后将参照这个新的组成部分。

跟着这个例子，开始通过创建一个新的插件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的

接下来，改变 实例 酒店的 UserTypes 类为"2-PublicNotCreatable".没有任何理由对任何人实例 UserTypes 类直接，因为它只是作为一个公共的容器，为我们的UDT。

最后，确保 Project Startup Object (下 项目>性)设定为"(无)"以及编制该项目。你现在应该有一个新的文件被称为 UDTLibrary.dll.

第2部分：列举了UDT类型的信息

现在是时候展示我们如何可以使用对象类型库图书馆，以实现一个 PrintUDT 法。

第一，开始通过创建一个新的标准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部分：使它向对象

上述例子提供了一个"快速"示范如何使用的类型库信息的对象库，以列举的领域的一个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部分。

第一，创建一个新的插件项目，并将它命名为 UDTTypeInformation 或者类似的东西。

接下来，确保启动对象为新项目设定为"(无)".

要做的第一件事就是创建一个简单的包装类隐藏的详细信息 TLI.MemberInfo 类的调用代码，使它容易得到UDT的领域的名称和价值。我称为这类的 UDTMember.的 实例 属于这一类应该 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 (我们将确定一个实用的方法之后，将创造实例代表呼吁代码)。

编辑： (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 实用功能。

最后，汇编的项目，并创建一个新的项目，以测试它。

在你的测试projet，添加一个参考新创建的 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 类。

其他提示

@丹，

它看起来像你试图用UDT的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可以提取的值的存储器。

如果你改变你所有的类型类。你有选择。从类型一类变化的一大缺陷是，你必须使用新的keyworld。每次有一个类型变量的声明添加新。

然后，可以使用所述变体关键字或CallByName。 VB6没有anytype类型反射的，但你可以进行有效的字段列表和测试，看看他们是否存在例如：

Test类具有以下

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 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是否什么。如果是它会自动创建测试类的新实例，然后分配变量。

在第二个例子中VB不添加此行为。

在大多数项目中，我们严格确保我们黯淡下去T作为测试，设置T =新的测试。但是，在你的情况，因为你想要的类型转换与使用暗淡T侧效果最少Classes作为新的测试是要走的路。这是因为，作为暗淡新原因模仿类型方式可变更密切合作。

许可以下： CC-BY-SA 和 归因
不隶属于 StackOverflow
scroll top