首页 > 解决方案 > .NET 事件不可见/无法与 vb6(vba) 一起使用?

问题描述

我已经编写了一个 vb.net 类,我想让 COM 对 VB6 可见。我有一个用 VB6 开发的旧应用程序,我正在为.net 完全重写它,但同时我需要让这个类工作并让它与 VB6 一起使用。

暴露给 COM 的所有方法似乎都可以正常工作,但我无法让该事件与 VB6 一起工作。我已经在网上爬了几个星期,并且发现了很多信息,这些信息对我有帮助。问题是当我尝试在 VB6 IDE 的下拉列表中选择类时,IDE 直接创建了一个事件处理程序(在我的情况下为 sub tc_Pls_changeprice())。奇怪的是,我无法选择或标记实际的班级,然后从事件下拉列表中选择事件。

如果我不尝试先选择课程,而是直接从事件下拉列表中选择事件,我可以选择它(但它的名称是 tc_Pls_changeprice,而不是我应该期望的 Pls_changeprice)

如果我选择它两次或更多次,IDE 会生成新的事件处理程序,而不是跳转到已经创建的事件处理程序。

当我尝试将代码放入事件处理程序时,我的 vb6 测试应用程序编译并运行,但事件没有触发。

我附上了我的 .net 代码和我的 vb6 testapplication 代码。

.dll 已编译ComVisible激活,但未注册为 com-interop(因为我需要在其他机器上注册 dll)。我使用 regasm /TLB /codebase 选项在主机上注册 dll,生成的 TLB 与 DLL 位于与我的 vb6 源目录相同的目录中。

重复的事件处理程序:

在此处输入图像描述

此图显示事件下拉事件列表有问题,我无法先从左侧下拉列表中选择类:

在此处输入图像描述

有人知道出了什么问题吗?

这是我的 .net 课程代码:

Imports System.IO.Ports
Imports System.Timers

<Guid("ABEF0C71-17CE-4d38-BEFD-71770E7D50B4")>
<InterfaceType(ComInterfaceType.InterfaceIsDual)>
<ComVisible(True)>
Public Interface Itaxcomm
    <DispId(1)> Property commport As String
    <DispId(2)> ReadOnly Property taxstatus As String
    <DispId(3)> Function open() As Integer
    <DispId(4)> Function close() As Integer

    <DispId(5)> Sub testevent()

    <DispId(6)> Sub Reset()
    <DispId(7)> Sub ChangepriceOK()
    <DispId(8)> Sub Triggerstartbutton()
    <DispId(9)> Sub TaxState()

End Interface

<Guid("A68C5882-21B2-4827-AA0F-A8D6538D1AE3")>
    <InterfaceType(ComInterfaceType.InterfaceIsIDispatch)>
    <ComVisible(True)>
    Public Interface ItaxcommEvents
    <DispId(10)> Sub Pls_changeprice()
    End Interface


    <ComVisible(True)>
    <ClassInterface(ClassInterfaceType.None)>
    <ComDefaultInterface(GetType(Itaxcomm))>
    <ComSourceInterfaces(GetType(ItaxcommEvents))>
    <Guid("0F998406-B0CF-440a-8A78-262015480C90")>
    <ProgId("Taxcomm.taxcomm")>
    Public Class taxcomm
    Implements Itaxcomm
    Public Status As String
    <ComVisible(False)>
    Public Delegate Sub pls_changepricedelegate()
    Public Event Pls_changeprice As pls_changepricedelegate
    Private _comport As String
    Private _taxmode As String
    Private rxByte(4096) As Byte
    Private WithEvents statetimer As New Timer
    Private WithEvents sp As New SerialPort

        Private Property Itaxcomm_commport As String Implements Itaxcomm.commport

            Get
                Return _comport

            End Get

            Set(ByVal value As String)
                _comport = value

            End Set
        End Property

        Private ReadOnly Property Itaxcomm_taxstatus As String Implements Itaxcomm.taxstatus

            Get
                Return _taxmode


            End Get


        End Property

        Private Sub sp_DataReceived(sender As Object, e As SerialDataReceivedEventArgs) Handles sp.DataReceived
            Dim s As String = ""
            If sp.BytesToRead < 7 Then Exit Sub

            sp.Read(rxByte, 0, 7)
            For i = 0 To 20
                s = s + (rxByte(i).ToString) & " "
            Next i

        If rxByte(0) = &H48 And rxByte(6) = &H54 And rxByte(5) = (rxByte(0) Xor rxByte(1) Xor rxByte(2) Xor rxByte(3) Xor rxByte(4)) Then
                Select Case rxByte(3)
                    Case 0
                        Select Case rxByte(4)
                            Case 0              ''Normal_mode(with tax)
                                _taxmode = 1
                            Case 1              ''!Normal_mode(Ex tax)
                                _taxmode = 0
                        End Select

                    Case 1
                        Select Case rxByte(4)
                            Case 0              ''Pls_changeprice
                                RaiseEvent Pls_changeprice()

                            Case 1
                        End Select
                    Case 253
                        Select Case rxByte(4)
                            Case 0              ''Buffer overflow
                                Status = "Tax rx:Buffer overflow"

                        End Select

                    Case 255
                        Select Case rxByte(4)
                            Case 0

                            Case 1              ''Command unknown
                                Status = "Tax rx:Command unknown"


                            Case 2             ''ERROR_CRC
                                Status = "Tax rx:ERROR or CRC error"

                        End Select
                End Select

            End If
        End Sub
        Private Sub TestEvent() Implements Itaxcomm.testevent
            RaiseEvent Pls_changeprice()

        End Sub
        Private Sub sp_Disposed(sender As Object, e As EventArgs) Handles sp.Disposed

        End Sub

        Private Sub sp_ErrorReceived(sender As Object, e As SerialErrorReceivedEventArgs) Handles sp.ErrorReceived
            Status = "TAX commerror:" & e.ToString
        End Sub

        Private Sub Taxstate() Implements Itaxcomm.TaxState
            Dim txarray = New Byte() {&H16, &H6, &H63, &H1, &H72, &H54}
            sptx(txarray)
        End Sub
        Public Sub Triggerstartbutton() Implements Itaxcomm.Triggerstartbutton
            Dim txarray = New Byte() {&H16, &H6, &H63, &H4, &H77, &H54}
            sptx(txarray)
        End Sub
        Public Sub ChangepriceOK() Implements Itaxcomm.ChangepriceOK
            Dim txarray = New Byte() {&H16, &H6, &H63, &H2, &H71, &H54}
            sptx(txarray)
        End Sub

        Public Sub Reset() Implements Itaxcomm.Reset

            Dim txarray = New Byte() {&H16, &H6, &H63, &H3, &H70, &H54}
            sptx(txarray)
        End Sub

        Private Sub statetimer_Elapsed(sender As Object, e As ElapsedEventArgs) Handles statetimer.Elapsed
            If sp.IsOpen Then Taxstate()
        End Sub
        Private Sub sptx(a() As Byte)
            Do Until sp.BytesToWrite = 0

            Loop
            sp.Write(a, 0, a.Count)
        End Sub

        Public Function open() As Integer Implements Itaxcomm.open
            Try

                sp.BaudRate = 9600
                sp.DataBits = 8
                sp.Handshake = IO.Ports.Handshake.None
                sp.Parity = IO.Ports.Parity.None
                sp.RtsEnable = True
                sp.ReceivedBytesThreshold = 1

                sp.StopBits = IO.Ports.StopBits.One

                If _comport <> "" And Not sp.IsOpen Then
                    sp.PortName = _comport
                    sp.Open()
                    statetimer.Interval = 1000
                    statetimer.Enabled = True
                    Return 0

                Else
                    Return 1
                End If


            Catch ex As Exception
                Status = "Serialport open:" & Err.Description
                Return 1
            End Try
        End Function

        Public Function close() As Integer Implements Itaxcomm.close
            Try
                If sp.IsOpen Then sp.Close()
                statetimer.Enabled = False

                Return 0
            Catch ex As Exception
                Status = "Serialport close:" & Err.Description
                Return 1

            End Try
        End Function
        Public Sub New()
            MyBase.New()
        End Sub
    End Class:

这是我的 vb6 testapplication 代码:

Option Explicit

Private WithEvents tc As taxcomm.taxcomm

Private Sub Command1_Click()
On Error GoTo errhandler

tc.Triggerstartbutton
Exit Sub
errhandler:
Text1.Text = Err.Number & Err.Description

End Sub

Private Sub Command2_Click()
On Error GoTo errhandler
tc.Reset
Exit Sub
errhandler:
Text1.Text = Err.Number & Err.Description

End Sub

Private Sub Command3_Click()
tc.testevent

End Sub

Private Sub Form_Load()
On Error GoTo errhandler

Set tc = CreateObject("Taxcomm.taxcomm")

tc.commport = "COM5"
If tc.Open = 0 Then
    MsgBox "Active"

Else
    MsgBox "Not active"
    tc.Close

End If
Exit Sub
errhandler:
MsgBox Err.Number & " " & Err.Description
Resume Next

End Sub


Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
tc.Close

End Sub

Private Sub Form_Terminate()
tc.Close

End Sub


Private Sub tc_Pls_changeprice()
MsgBox "test"
End Sub

Private Sub Timer1_Timer()
On Error GoTo errhandler

Text1.Text = tc.taxstatus
Exit Sub
errhandler:
Text1.Text = Err.Number & Err.Description

tc.Close

End Sub

.net 类和 vb6 测试应用程序按应有的方式编译,但 TLB 的生成似乎有问题(由于我的 .net 代码中有问题),因此事件不会触发,和/或暴露事件未在 VB6 IDE 中正确注册。

标签: vb.netcomvb6

解决方案


这最初是在评论中,但把它放在这里是为了明确答案是什么:

听起来可能令人惊讶,但我发现 VB6 在处理一些更高级的 COM 组件/COM 互操作类型的东西时,在处理方法和事件名称中的下划线时存在一些限制。这是几年前的事了,所以我不记得我具体遇到了什么痛点。有点长镜头,但只是为了它,尝试重命名你的事件以避免下划线


推荐阅读