VB6 UDT 自检

2024-04-19

我有一种感觉,这个问题的答案将是“不可能”,但我会尝试一下...... 我的处境并不令人羡慕,需要修改旧版 VB6 应用程序并进行一些增强。转换为更智能的语言不是一个选择。 该应用程序依赖大量用户定义类型来移动数据。我想定义一个通用函数,它可以引用任何这些类型并提取其中包含的数据。
在伪代码中,这就是我正在寻找的内容:

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

似乎这个信息需要在某个地方可供 COM 使用...有任何 VB6 专家愿意尝试一下吗?

Thanks,

Dan


与其他人所说的相反,在 VB6 中可以获得 UDT 的运行时类型信息(尽管它不是内置的语言功能)。微软的TypeLib 信息对象库 http://msdn.microsoft.com/en-us/magazine/bb985086.aspx(tlbinf32.dll) 允许您在运行时以编程方式检查 COM 类型信息。如果您安装了 Visual Studio,您应该已经拥有此组件:要将其添加到现有 VB6 项目,请转到项目->参考文献并检查标有“TypeLib Information”的条目。请注意,您必须在应用程序的安装程序中分发并注册 tlbinf32.dll。

您可以在运行时使用 TypeLib 信息组件检查 UDT 实例,只要您的 UDT 已声明Public并被定义在一个Public班级。为了使 VB6 为 UDT 生成 COM 兼容的类型信息(然后可以使用 TypeLib 信息组件中的各种类来枚举),这是必需的。满足此要求的最简单方法是将所有 UDT 放入公共UserTypes将被编译成 ActiveX DLL 或 ActiveX EXE 的类。

工作示例摘要

这个例子包含三个部分:

  • Part 1:创建一个包含所有公共 UDT 声明的 ActiveX DLL 项目
  • Part 2: 创建一个例子PrintUDT演示如何枚举 UDT 实例的字段的方法
  • Part 3:创建自定义迭代器类,使您可以轻松迭代任何公共 UDT 的字段并获取字段名称和值。

工作示例

第 1 部分:ActiveX DLL

正如我已经提到的,您需要使 UDT 可供公众访问,以便使用 TypeLib 信息组件枚举它们。实现此目的的唯一方法是将 UDT 放入 ActiveX DLL 或 ActiveX EXE 项目内的公共类中。应用程序中需要访问 UDT 的其他项目将引用这个新组件。

要遵循此示例,首先创建一个新的 ActiveX DLL 项目并将其命名UDTLibrary.

接下来,重命名Class1类模块(IDE 默认添加)到UserTypes并向该类添加两个用户定义的类型,Person and 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 (under 项目->属性)设置为“(无)”并编译项目。您现在应该有一个名为UDTLibrary.dll.

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

现在是时候演示如何使用 TypeLib 对象库来实现PrintUDT method.

首先,首先创建一个新的标准 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类,并可以轻松获取 UDT 字段的名称和值。我给这个班级打电话UDTMember. The 实例化这个类的属性应该是公共不可创建.

'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,这将允许我们使用 VBFor 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 class.

请注意,为了使此类可迭代,以便For Each可以与它一起使用,您必须在Item and _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.dllUDTLibrary.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 class.

本文内容由网友自发贡献,版权归原作者所有,本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容,请联系:hwhale#tublm.com(使用前将#替换为@)

VB6 UDT 自检 的相关文章

  • 输入框 取消

    我创建了一个输入框来输入用户名 但卡住了取消按钮 Private Sub Form Load fsUserName UCase InputBox Please Enter your name User Name dc If fsUserNa
  • AppDomain.UnhandledException 未捕获未处理的异常

    我们有一个 NET 3 5 程序集 dll 由 VB6 代理 exe 通过 COM 接口执行 VB6 代码确实调用 Ensure that no system dialog comes up when we GPF PreviousErro
  • Visual Basic 6中如何保存断点

    如何在 Visual Basic 6 中保存断点 有任何插件吗 现在我有 MZ Tools 但不幸的是它们不保存断点 我不确定第三方工具 但您始终可以使用 Debug Assert False 完成后记得将其删除
  • 从 VBScript 读取 DLL(或 VB6)文件

    我正在尝试使用 VBScript 访问 VBA 文件 或 DLL 中的函数 我有点力不从心 而且我通常不使用这两种语言 所以我会解释一下情况 以防有更好的解决方案 我有一个仪器 它有一个类似 VBScript 的内部窗口 它具有 VBScr
  • 在 Microsoft Visual Basic 6.0 中填充组合框

    我在 Microsoft Visual Basic 6 0 中有一个组合框 我必须将项目添加到组合框中 这些项目存储在 SQL 数据库中的 Column1 表中 我不确定如何让这些项目在运行时显示在组合框中 以便用户可以选择不同的选项 注
  • 用VB6生成Excel文件

    我正在寻找有关这个具体问题的建议 在 Visual Basic 6 VB6 中生成 Excel 文件 常规 XLS 而不是 XLSX 的最快方法是什么 多谢 最简单的方法是在项目中设置对 Excel COM 对象的引用 并以编程方式将所有数
  • 将用户定义的表传递给存储过程

    我有一个用户定义表 我正在将其从存储过程中传递到存储过程中 DECLARE tmpInput MyTableType Table is populated from an INPUT XML exec ValidateInputXML SE
  • 带有 VB6/asp 错误的 C# COM 对象

    我正在尝试通过 COM 公开 C 类库 以便我可以在经典的 ASP 网站中使用它 我用过 sn k regasm 和 gacutil 我现在能做的就是回显字符串 以类变量作为输入的方法对我不起作用 即我的测试方法 EchoPerson Pe
  • vb6中动态两级或多级子菜单生成

    朋友们 告诉我怎么做生成1级以上的子菜单在VB6中运行时 简单解释一下 有什么具体的控制措施吗 但我不想使用外部控件 您可以使用API 函数创建多级子菜单 Private Declare Function CreatePopupMenu L
  • 通过VB6发送电子邮件

    我想知道是否有办法通过VB6发送电子邮件 SMTP 我有一个应用程序 只需要在用户完成后发送一封简单的电子邮件 让一组人知道该应用程序已处理 有没有办法做到这一点 是的 取决于您使用的 Windows 版本 假设更高版本之一 CDO Mes
  • 存储过程超时 - 但从 SSMS 运行时正常

    我有一个存储过程 错误提示 超时已过期 涉及的代码是ADO VB6 存储过程本身没有问题 您可以在查询窗口中运行它 并且需要不到一秒钟的时间 用于获取连接等的代码也是模块化的 并在大型应用程序中使用 在一个特定数据库上 仅在这一位置发生超时
  • 为应用程序创建自定义 odbc 驱动程序

    好的 我有一个简单的数据库引擎 它是用 vb6 编写的专有产品 用于我的一个应用程序 我想为它创建一个 ODBC 驱动程序 这样我就可以将我的一些其他应用程序 需要数据库 与我的数据库引擎而不是 microsoft sql 他们当前正在使用
  • vb.net 的 file.shortpath

    我正在将我的项目从 vb6 转换为 vb net vb net中有shortpath的模拟方法吗 Dim DestinationFile As Scripting File DestinationFile ShortPath Thanks
  • 在 VB6 中的打印机上进行 Unicode 打印

    我正在尝试在打印机 实际上是 PDFCreator 上打印 Unicode 中文 字符串 但我得到的只是字符的垂直打印 我用TextOutW函数导入自gdi32 dll TextOutW dest hDC x y StrConv szTex
  • 更新 KB 2687323 后,VB6 IDE 无法加载 MSCOMCTL.OCX

    Windows 更新安装安全更新后KB2687323 http support microsoft com kb 2687323 我的 VB6 项目无法加载 显示的错误消息是 无法加载 project vbp path MSCOMCTL O
  • Visual Basic 6.0 中的无效限定符错误

    在 Visual Basic 6 0 程序中 我有一个字符串 sTemp 我想确保它不包含引号 我有这行 If sTemp Contains Then 但是当我在 sTemp 之后输入句点时 我没有从智能感知中得到任何信息 并且当我尝试编译
  • Visual Basic 6:如何使应用程序在任务栏中可见?

    我已将属性 ShowInTaskBar 设置为 true 但我的应用程序在任务栏中不可见 表单具有最小化 最大化和关闭按钮 当我单击最小化时 表单最小化为屏幕左下角的小表单 但不显示在任务栏中 你的表单是模态的吗 MyForm Show v
  • VB6 - Lua 集成

    我想知道是否有人有任何集成 Lua 和 VB6 的技巧 我正在运行一个小型在线角色扮演游戏 添加一些脚本会很棒 嗯 这是可行的 我曾经为 Lua 5 0 2 做过 但找不到文件 在您拥有的选项中 您可以 将 Lua 封装在公开 Lua AP
  • 如何将exe异常路由回VB6应用程序?

    我有一个 vb6 应用程序 它将调用 mencoder exe 它是 mplayer 的一部分 用于将某些文件转换为 flv 格式 每当我尝试转换这个 opendivx 文件时 我都会从 mencoder 收到这个奇怪的未处理异常问题 目前
  • Vista幻影目录

    我们有一个程序 安装程序会检查配置文件是否存在 如果存在 它不会复制该文件 它假设用户已修改其配置文件并希望保留这些修改 不幸的是 这是一个 Vista 之前的应用程序 它将配置文件保存在 Program Files 中 问题是 如果你在重

随机推荐

  • 在 Outlook 2007 C# 中获取安全发件人列表

    我已经在 C NET 4 0 中创建了 Outlook 2007 加载项 我想读取 C 代码中的安全发件人列表 if oBoxItem is Outlook MailItem Outlook MailItem miEmail Outlook
  • 如何防止c#中对象的实例化

    我需要的是检查传递给构造函数的参数 并防止特定对象的实例化 以防它们被视为无效 我发现可以抛出异常 因此对象引用将按预期以 null 结束 例如 仅当传递给构造函数的整数为非负数时 才会实例化此类 class MyClass public
  • Bootstrap 3 并排容器

    我正在尝试制作一个网页 其中内容的左半部分尊重引导程序 container最大宽度大小 而我的右侧可以一直到页面的末尾 作为 container fluid会工作 像这样的图片 到目前为止 我已经尝试了几种方法 目前我正在使用以下代码 di
  • 如何从 for 循环构建和填充 pandas 数据框? [复制]

    这个问题在这里已经有答案了 这是我正在运行的代码的一个简单示例 我希望将结果放入 pandas 数据帧中 除非有更好的选择 for p in game players passing print p p team p passing att
  • AAD 团体声称某些用户的 JWT 令牌缺失

    我在 AAD 上遇到一些奇怪的行为 用户成功登录后 我们的 API 调用中某些用户收到未经授权的消息 结果发现 JWT 中的声明丢失了 一些用户获得 groups 声明 他所属的所有 groupId 的数组 一些用户获得 hasgroups
  • 如何在命令行中查看 git 存储库中的所有标签[重复]

    这个问题在这里已经有答案了 有类似 git show标签 之类的东西吗 git tag列出存储库中使用的标签 git tag l如果你使用 l您可以通过选项传递搜索模式来过滤掉标签
  • 在 django 中通过变量模型名称访问模型

    我有两个相同的模型 比如说 django 中的 X 和 Y 如下所示 class X models Model con models CharField max length 100 a models ForeignField FOO cl
  • Node/Busboy:获取文件大小

    我使用 Busboy 模块通过下面的 CoffeeScript 代码来解析多部分请求 有时 问题出在 数据 处理程序上 该处理程序针对包含一个文件的请求多次调用 这意味着我需要对每个尺寸进行求和才能得出整个尺寸 此外 文件 处理程序中的文件
  • 如何在 Haskell 中创建通道列表(或数组),如 Go

    我试图将 Haskell 与 Go 进行比较以获得一些并发示例 以下代码是 Go 中使用 Goroutines 和通道的简单映射缩减示例 以下 Go 代码计算平方和 1 2 2 2 3 2 1024 2 为了测试Go和Haskell的性能
  • 网络适​​配器无法在 SQL Developer 中建立连接

    我使用包含 1000 个条目的 SQL 开发人员列表创建了一个数据库 并且创建成功 连接也成功了 但今天当我尝试连接时出现错误 IO Error The Network Adapter could not establish the con
  • 通过python3计算uniswap 3.0池(对)地址

    我遇到了一个关于如何计算的问题 新的 uniswap 版本 3 池 早期版本称为pair 地址基于1 https github com Uniswap v3 sdk blob aeb1b09 src utils computePoolAdd
  • 如何跨 NodeJs 应用程序和模块正确重用与 Mongodb 的连接

    我一直在阅读和阅读 但仍然对跨整个 NodeJs 应用程序共享相同数据库 MongoDb 连接的最佳方式感到困惑 据我了解 连接应该在应用程序启动时打开并在模块之间重用 我目前认为最好的方法是server js 一切开始的主文件 连接到数据
  • 当我执行 npm install [重复] 时,Node js 添加不需要的模块

    这个问题在这里已经有答案了 我正在尝试在我的 Mac 上启动节点服务 当我在节点服务所在的文件夹中运行 npm install 时 它正在安装 package json 中未提及的模块 有一些我不期望的额外模块 以及一些我期望的模块丢失了
  • 在perl中串行处理XML数据

    我想知道在我的情况下 哪种 XML 解析器最适合 Perl 我读了很多书并尝试过XML LibXML and XML SAX 第一个使用了太多内存 第二个对我来说似乎没有那么快 即使在关闭纯 Perl 解析器之后 我的需求相当具体 我通过以
  • 如何对函数的返回值进行单元测试 - Angular (Jasmine/Karma)

    我想知道是否有一种方法可以正确测试 Angular 中函数的返回值 我想本质上测试一个测试的返回值是否正确 并编写另一个测试来测试相反的场景 Ts 组件 get if this object undefined return true el
  • 如何在 MVC 中通过 JQuery 调用 HttpHandler

    我以前没有在 MVC 中使用过 httpHandlers 但是我想在我的应用程序中停止会话超时 我在这里找到了解决方案 http www dotnetcurry com ShowArticle aspx ID 453 http www do
  • .net 中 Tuple(T1)/Singleton 的用途是什么?

    net 4 中的元组类型之一是单元素元组 http msdn microsoft com en us library dd384265 aspx 我只是想知道这个结构的目的是什么 我看到的唯一用途是在使用时8 Tuple http msdn
  • 使用 RecursiveDirectoryIterator 在顶部按最新日期对文件进行排序

    现在默认情况下它按字母表显示 我不希望这样 我想使用以下方式对文件进行排序递归目录迭代器最新文件位于顶部 按降序排列 还使用if 条件比较日期并获取该日期的文件
  • 设置预定义的节点样式?

    在过去的 15 分钟里 我一直在谷歌上搜索 试图找到这个问题的答案 但我似乎无法弄清楚 我的任务是为我在工作中开发的一些应用程序构建一些小流程图 他们不需要任何花哨的东西 因为他们将在 vizio 中将其转换为他们喜欢的格式 他们甚至说我们
  • VB6 UDT 自检

    我有一种感觉 这个问题的答案将是 不可能 但我会尝试一下 我的处境并不令人羡慕 需要修改旧版 VB6 应用程序并进行一些增强 转换为更智能的语言不是一个选择 该应用程序依赖大量用户定义类型来移动数据 我想定义一个通用函数 它可以引用任何这些