I have written an vb.net class which I want to make COM-visible for VB6. I have an old application which was developed in VB6, and I am in the process of rewrite it entirely for .net, but in the meantime I need to get this class working and get it usable together with VB6.
All the methods exposed to COM seems to work as they should, but I can't get the event to work with VB6. I have crawled the net for weeks now, and have found a lot of information which have helped me to the point I am now. The problem is when I try to select the class in the dropdown list inside the VB6 IDE, the IDE creates an eventhandler directly(in my case sub tc_Pls_changeprice()). What's strange is that it's not possible for me to select or mark the actual class, and then pick the event from the event dropdown list.
If I doesn't try to select the class first, but select the event directly from the event dropdownlist, I am able to select it(but the name of it is tc_Pls_changeprice, and not Pls_changeprice as I should expect)
If I select it two or more times, the IDE generates new eventhandlers rather than jump into the already created eventhandler.
When I try to put code inside the eventhandler, my vb6 testapplication compiles and run, but the event doesn't fire.
I have attached my .net code and my vb6 testapplication code.
The .dll has been compiled with ComVisible activated, but not register as com-interop(since I need to register the dll on other machines). I register the dll on the host machines with regasm /TLB /codebase option, and the TLB that is generated is located together with the DLL inside same directory as my vb6 source directory.
Duplicate eventhandlers:
This picture shows that its something wrong with the event dropdown event list, and I'm not able to first select the class from the left dropdown list:
Have anybody any ideas of what's wrong?
Here is my .net code for the class:
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:
and here is my vb6 testapplication code:
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
The .net class and the vb6 testapplication compiles as it should, but it seems to be something wrong with the generation of the TLB(due to something wrong in my .net code) so the event doesn't fire, and/or the exposed event are not correctly registered inside VB6 IDE.
InterfaceType(ComInterfaceType.InterfaceIsIDispatch)on the class implemented interface where-as you are usingInterfaceType(ComInterfaceType.InterfaceIsDual). Also it uses the default on the events interface which isInterfaceType(ComInterfaceType.InterfaceIsDual)where-as you are usingInterfaceType(ComInterfaceType.InterfaceIsIDispatch). May be worth a try. – TnTinMn