.NET 事件不是 visible/working 用于 vb6(vba)？
.NET events not visible/working for use with vb6(vba)?
我已经写了一个 vb.net class，我想让 COM 对 VB6 可见。我有一个用 VB6 开发的旧应用程序，我正在为 .net 完全重写它，但与此同时我需要让这个 class 工作并让它与 VB6 一起使用。
向 COM 公开的所有方法似乎都可以正常工作，但我无法使事件与 VB6 一起工作。我已经在网上爬了好几个星期了，找到了很多对我有帮助的信息。问题是当我尝试 select VB6 IDE 下拉列表中的 class 时，IDE 直接创建了一个事件处理程序（在我的例子中是 sub tc_Pls_changeprice()).奇怪的是，我无法select或标记实际class，然后从事件下拉列表中选择事件。
如果我不先尝试 select class，而是直接从事件下拉列表 select 事件，我可以 select 它（但它的名称是 tc_Pls_changeprice，而不是我所期望的 Pls_changeprice）
如果我 select 它两次或更多次，IDE 会生成新的事件处理程序，而不是跳转到已经创建的事件处理程序。
当我尝试将代码放入事件处理程序时，我的 vb6 测试应用程序编译并 运行，但事件没有触发。
我附上了我的 .net 代码和我的 vb6 测试应用程序代码。
.dll 已在 ComVisible 激活的情况下编译，但未注册为 com-interop（因为我需要在其他机器上注册该 dll）。我使用 regasm /TLB /codebase 选项在主机上注册了 dll，生成的 TLB 与 DLL 一起位于与我的 vb6 源目录相同的目录中。
重复的事件处理程序：
这张图片显示事件下拉事件列表有问题，我无法首先从左侧下拉列表中 select class:
有人知道哪里出了问题吗？
这是我的 class:
.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 测试应用程序代码：
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 class 和 vb6 测试应用程序编译正常，但 TLB 的生成似乎有问题（由于我的 .net 代码中有问题）所以事件没有没开火，and/or 暴露的事件没有在 VB6 中正确注册 IDE。
这最初是在评论中，但把它放在这里是为了弄清楚答案是什么：
虽然听起来令人惊讶，但我发现 VB6 在处理一些更高级的 COM 组件/COM 互操作类型的东西时处理方法和事件名称中的下划线时有一些限制。这是几年前的事了，所以我不记得我具体击中了什么痛点。有点远景，但只是为了它，尝试重命名您的事件以避免下划线
我已经写了一个 vb.net class，我想让 COM 对 VB6 可见。我有一个用 VB6 开发的旧应用程序，我正在为 .net 完全重写它，但与此同时我需要让这个 class 工作并让它与 VB6 一起使用。
向 COM 公开的所有方法似乎都可以正常工作，但我无法使事件与 VB6 一起工作。我已经在网上爬了好几个星期了，找到了很多对我有帮助的信息。问题是当我尝试 select VB6 IDE 下拉列表中的 class 时，IDE 直接创建了一个事件处理程序（在我的例子中是 sub tc_Pls_changeprice()).奇怪的是，我无法select或标记实际class，然后从事件下拉列表中选择事件。
如果我不先尝试 select class，而是直接从事件下拉列表 select 事件，我可以 select 它（但它的名称是 tc_Pls_changeprice，而不是我所期望的 Pls_changeprice）
如果我 select 它两次或更多次，IDE 会生成新的事件处理程序，而不是跳转到已经创建的事件处理程序。
当我尝试将代码放入事件处理程序时，我的 vb6 测试应用程序编译并 运行，但事件没有触发。
我附上了我的 .net 代码和我的 vb6 测试应用程序代码。
.dll 已在 ComVisible 激活的情况下编译，但未注册为 com-interop（因为我需要在其他机器上注册该 dll）。我使用 regasm /TLB /codebase 选项在主机上注册了 dll，生成的 TLB 与 DLL 一起位于与我的 vb6 源目录相同的目录中。
重复的事件处理程序：
这张图片显示事件下拉事件列表有问题，我无法首先从左侧下拉列表中 select class:
有人知道哪里出了问题吗？
这是我的 class:
.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 测试应用程序代码：
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 class 和 vb6 测试应用程序编译正常，但 TLB 的生成似乎有问题（由于我的 .net 代码中有问题）所以事件没有没开火，and/or 暴露的事件没有在 VB6 中正确注册 IDE。
这最初是在评论中，但把它放在这里是为了弄清楚答案是什么：
虽然听起来令人惊讶，但我发现 VB6 在处理一些更高级的 COM 组件/COM 互操作类型的东西时处理方法和事件名称中的下划线时有一些限制。这是几年前的事了，所以我不记得我具体击中了什么痛点。有点远景，但只是为了它，尝试重命名您的事件以避免下划线