Я написал класс vb.net, который хочу сделать COM-видимым для VB6. У меня есть старое приложение, которое было разработано в VB6, и я переписываю его полностью для .net, но в то же время мне нужно, чтобы этот класс работал и работал вместе с VB6.
Кажется, что все методы, работающие с COM, работают должным образом, но я не могу заставить событие работать с VB6. Я ползал в сети уже несколько недель и нашел много информации, которая помогла мне до такой степени, как сейчас. Проблема заключается в том, что когда я пытаюсь выбрать класс в раскрывающемся списке в среде IDE VB6, среда IDE создает обработчик событий напрямую (в моем случае sub tc_Pls_changeprice ()). Странно то, что я не могу выбрать или отметить фактический класс, а затем выбрать событие из выпадающего списка событий.
Если я не пытаюсь сначала выбрать класс, а выбираю событие непосредственно из выпадающего списка событий, я могу выбрать его (но его имя tc_Pls_changeprice, а не Pls_changeprice, как и следовало ожидать)
Если я выберу его два или более раз, в среде IDE будут создаваться новые обработчики событий, а не переходить в уже созданный обработчик событий.
Когда я пытаюсь поместить код в обработчик событий, мое приложение vb6 testapplication компилируется и запускается, но событие не запускается.
Я приложил свой код .net и мой код тестирования vb6.
.dll был скомпилирован с активированным ComVisible, но не зарегистрирован как com-interop (так как мне нужно зарегистрировать dll на других машинах). Я регистрирую dll на хост-компьютерах с параметром regasm / TLB / codebase, и сгенерированный 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:
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 и testapplication vb6 компилируются должным образом, но, похоже, что-то не так с генерацией TLB (из-за чего-то неправильного в моем коде .net), поэтому событие не запускается, и / или выставленное событие неправильно зарегистрировано в VB6 IDE.