VB6 UDTs的自检

17

我觉得这个问题的答案可能是“不可能”,但我想试一试...... 我不得不修改一个遗留的VB6应用程序并进行一些增强。转换为更智能的语言不是一个选项。 该应用程序依赖于大量的用户定义类型来传递数据。我希望定义一个通用函数,可以接受任何这些类型的引用并提取其中包含的数据。
以下是伪代码,描述了我的要求:

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

看起来这些信息在某个地方需要对COM可用...有没有VB6大师愿意尝试一下?

谢谢,

Dan


这个用户定义的类型是一个类/类型吗? - shahkalpesh
抱歉,发布后我才意识到该函数的名称是PrintUDT。因此,它应该是一种类型(类似于结构体)。对吗? - shahkalpesh
有没有一种方法可以枚举VB6类模块中的所有属性? - StayOnTarget
3个回答

40
与其他人所说的不同,VB6中可以获取UDT的运行时类型信息(虽然这不是内置的语言特性)。微软的TypeLib Information Object Library(tlbinf32.dll)允许您在运行时以编程方式检查COM类型信息。如果您安装了Visual Studio,则应该已经拥有此组件:要将其添加到现有的VB6项目中,请转到项目->引用,并选中标记为“TypeLib Information”的条目。请注意,您将需要在应用程序的安装程序中分发和注册tlbinf32.dll。
只要您的UDT声明为Public并在Public类中定义,就可以在运行时使用TypeLib Information组件检查UDT实例。这是必要的,以便使VB6为您的UDT生成与COM兼容的类型信息(然后可以使用TypeLib Information组件中的各种类枚举它们)。满足此要求的最简单方法是将所有UDT放入一个名为UserTypes的公共类中,该类将被编译为ActiveX DLL或ActiveX EXE。
一个工作示例的摘要:
此示例包含三个部分:
  • 第一部分:创建一个ActiveX DLL项目,其中包含所有公共UDT声明。
  • 第二部分:创建一个示例PrintUDT方法,以演示如何枚举UDT实例的字段。
  • 第三部分:创建一个自定义迭代器类,允许您轻松地遍历任何公共UDT的字段,并获取字段名称和值。

工作示例

第一部分:ActiveX DLL

如我所提到的,您需要使您的UDT在公共接口中可访问,以便使用TypeLib信息组件枚举它们。唯一的方法是将您的UDT放入ActiveX DLL或ActiveX EXE项目中的公共类中。然后,应用程序中需要访问您的UDT的其他项目将引用此新组件。

要按照此示例进行操作,请首先创建一个新的ActiveX DLL项目,并将其命名为UDTLibrary

接下来,将Class1类模块(这是IDE默认添加的)重命名为UserTypes并向该类中添加两个用户定义类型:PersonAnimal

' 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类的Instancing属性更改为"2-PublicNotCreatable"。没有任何理由让任何人直接实例化UserTypes类,因为它只是作为我们UDT的公共容器。

最后,确保项目启动对象(在项目->属性下)设置为"(无)"并编译该项目。现在应该有一个名为UDTLibrary.dll的新文件。

第2部分:枚举UDT类型信息

现在是展示如何使用TypeLib对象库实现PrintUDT方法的时候了。

首先,创建一个新的标准EXE项目,并随意命名。添加对在第1部分中创建的UDTLibrary.dll文件的引用。由于我只想演示这个工作原理,我们将使用立即窗口来测试编写的代码。

创建一个新模块,命名为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方法和一个简单的测试方法

第三部分:使其面向对象

上述示例提供了如何使用TypeLib信息对象库枚举UDT字段的“快速而不精确”的演示。在实际情况中,我可能会创建一个UDTMemberIterator类,允许您更轻松地迭代UDT字段,以及一个模块中的实用函数,为给定的UDT实例创建一个UDTMemberIterator。这将允许您在代码中执行类似于您在问题中发布的伪代码的操作:

Dim member As UDTMember 'UDTMember wraps a TLI.MemberInfo instance'

For Each member In UDTMemberIteratorFor(someUDT)
   Debug.Print member.Name & " : " & member.Value
Next

实际上,这并不太难,我们可以重复使用第二部分中创建的PrintUDT例程中的大部分代码。

首先,创建一个新的ActiveX项目,并将其命名为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 在本节中的第一个代码示例中),它将为 UDT 实例创建一个 UDTMemberIterator,然后我们可以使用 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的引用,并在新模块中尝试以下代码:

'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 类。


1
当然,这是建立在您使用具有类型信息的UDT(即在“公共模块”中声明的UDT,如单独编译的DLL、OCX等)的前提下的假设。 - Bob
代码也需要一些清理。GetWrappedmembersForUDT尤其粗糙。 - Bob
哇,完全忘记了答案在一定数量的修订后自动切换到维基模式... - Mike Spross
刚刚完成了“快速而粗糙”的实现版本。一切都运行得很顺利!就像MarkJ说的那样,如果可能的话,我会给+2分。不过,这个解决方案也可能意外地延长VB6中该组件的存在... - Dan
@Mike Spross,非常出色和详细的回答!您似乎是VB6大师。也许您可以帮我解决这个问题:https://dev59.com/wJffa4cB1Zd3GeqP3By6。到目前为止,我在这方面没有取得太多进展,尽管我提供了赏金。您能试试吗? - AllSolutions
显示剩余5条评论

2

@丹,

看起来你正在尝试使用UDT的RTTI。我认为你在不知道UDT的情况下无法真正获取该信息。 为了让你开始尝试:

理解UDTs
由于没有这种反射能力,我会为我的UDT创建自己的RTTI。

为了给你一个基准,请尝试这个:

Type test
    RTTI as String
    a as Long
    b as Long 
    c as Long
    d as Integer
end type

你可以编写一个实用程序,打开每个源文件并将RTTI与类型名称添加到UDT中。最好将所有UDT放在一个公共文件中。
RTTI可能是这样的:
"String:Long:Long:Long:Integer"
使用UDT的内存,您可以提取值。

1
扭曲但巧妙(我的意思是夸奖!)。我认为访问RTTI内存不是一件易事?此外,它仅解决了问题的一部分 - 他还想记录成员名称。我猜您也可以将它们存储在RTTI成员中。我想您确实说过这是基线。 - MarkJ

2
如果您将所有类型更改为类,则有多种选择。从类型更改为类的最大陷阱是您必须使用新关键字。每次声明类型变量时都要添加new关键字。
然后,您可以使用variant关键字或CallByName函数。VB6没有任何反射类型,但是您可以创建有效字段列表并测试它们是否存在,例如:
类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允许您使用字符串来调用类的字段和方法。
当您声明Dim as New时,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,以便任何时候访问成员时都会检查T是否为“nothing”。如果是,则会自动创建Test类的新实例,然后分配变量。
在第二个示例中,VB不添加此行为。
在大多数项目中,我们严格确保使用Dim T as Test,Set T = New Test。但在您的情况下,由于您想将类型转换为类,并且希望副作用最小化,因此使用Dim T as New Test是正确的做法。这是因为Dim as New会使变量更接近类型的工作方式。

小心使用“Dim As New”。例如,如果您执行“Dim acct As New BankAccount”,然后稍后想要执行“If acct Is Nothing”,它将无法按预期工作。VB6会自动实例化acct,如果它是Nothing,因此检查Nothing将始终返回False。有时可能会让您陷入麻烦... - Mike Spross
然而,我在这里同意你的观点。对于已转换为类的类型,不会有任何现有的检查来检查该类型的变量是否为Nothing,因此只有在稍后添加这样的检查时才会出现问题。 - Mike Spross
我修复了未被格式化为代码的文本,现在应该更清晰了。 - RS Conley

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接