form1.vb

汽车领can总线通讯程序

            Output.Items.Add("xlCanSetChannelBitrate: " & xlGetErrorString(xlstatus))
        Else
            Output.Items.Add("xlCanSetChannelBitrate: set to 33333 BPS")
        End If

        'Set up event notification with the vxlapi
        xlstatus = xlSetNotification(portHandle, g_msgEvent, 1)


        ' xlActivateChannel
        xlstatus = xlActivateChannel(portHandle, accessMask, _
              Convert.ToUInt32(XL_BUS_TYPE_CAN), _
              Convert.ToUInt32(XL_ACTIVATE_RESET_CLOCK))
        If (xlstatus) Then
            Output.Items.Add("xlActivateChannel:" & xlGetErrorString(xlstatus))
            MessageBox.Show("xlActivateChannel:" & xlGetErrorString(xlstatus) & Chr(13) & "CANcab/CANpiggy missing?", "xlVBCANapp Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
            End
        Else
            BnActivateChannels.Text = "Deactivate"
            GroupCanMessage.Enabled = True
            GroupCanSpecial.Enabled = True
            GroupAfterOpenPort.Enabled = False
            GroupAcceptance.Enabled = False
            GroupCanSpecial.Enabled = True

            'Set up CAN Receive thread. This call establishes the function ReceiveMessage as a separate thread
            'Dim RxThread As New System.Threading.Thread(AddressOf ReceiveMessage)
            'Start the thread
            RxThread.Start()
        End If
    End Sub

#Region "Function InitDriver - Open Driver, OpenPort"
    Function InitDriver()
        Dim xlstatus As Byte
        Dim PermissionMask As UInt64

        CBoxHardwareType.Items.Clear()

        'get channels where assigned to application
        Dim appChannel, hwType, hwIndex, hwChannel As Integer
        Dim callSign As String
        hwType = XL_HWTYPE_CANCARDXL   ' default, may overwritten by xlGetApplConfig

        For appChannel = 0 To MaxAssignedChannels
            xlstatus = xlGetApplConfig(appName, appChannel, hwType, hwIndex, hwChannel, XL_BUS_TYPE_CAN)
            If (xlstatus) Then
                If appChannel < 2 Then
                    MessageBox.Show("Please assign xlVBCANapp to CAN Hardware and restart application", "xlVBCANapp Error", MessageBoxButtons.OK)
                    xlSetApplConfig(appName, appChannel, hwType, hwIndex, hwChannel, XL_BUS_TYPE_CAN)
                    xlSetApplConfig(appName, appChannel + 1, hwType, hwIndex, hwChannel, XL_BUS_TYPE_CAN)
                    xlPopupHwConfig(callSign, 1)
                    End
                Else
                    appChannel = appChannel - 1
                    Exit For
                End If
            Else
                Output.Items.Add("xlGetApplConfig: appchannel:" + Str(appChannel) + " hwType:" + Str(hwType) + " hwIndex:" + Str(hwIndex) + " hwChannel:" + Str(hwChannel))
                CBoxHardwareType.Items.Add(GetHWTypeString(hwType) & "Channel " & Str(appChannel + 1))
                'xlGetChannelMask
                ChannelMask(appChannel) = xlGetChannelMask(hwType, hwIndex, appChannel)
                ChannelMask(65) = ChannelMask(65) Or ChannelMask(appChannel) ' prepare calc of access mask
            End If
        Next
        'MaxAssignedChannels = appChannel

        accessMask = Convert.ToUInt64(ChannelMask(65))
        PermissionMask = Convert.ToUInt64(ChannelMask(65))

        xlstatus = xlOpenPort(portHandle, appName, accessMask, PermissionMask, Convert.ToUInt32(256), XL_INTERFACE_VERSION_UINT32, XL_BUS_TYPE_CAN_UINT32)
        Output.Items.Add("xlOpenPort:  PortHandle:" + portHandle.ToString)
        If (xlstatus) Then
            MessageBox.Show("xl!Error:OpenPort:" & xlGetErrorString(xlstatus) & Chr(13) & "Please check if two CANcabs/CANpiggies are connected", "xlVBCANapp Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
            End
        End If

        If (Convert.ToInt64(accessMask) = Convert.ToInt64(PermissionMask)) Then
            Output.Items.Add("OpenPort Info: permission to setup all CAN channels")
        End If

    End Function
#End Region
#Region "xlCanTransmit"
    Private Sub BnSendCANMsg_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BnSendCANMsg.Click
        Dim xlstatus As Byte

        Dim tmpSelectedChannel = CBoxHardwareType.SelectedIndex
        If tmpSelectedChannel < 0 Then tmpSelectedChannel = 0 'if nothing selected than use "Channel 1"
        Dim CANchannelMask As Long = ChannelMask(tmpSelectedChannel)

        Dim MsgNo As Integer = 0
        Dim transmitMsg(MsgNo) As s_xlEvent     ' define message structure

        transmitMsg(MsgNo).tag = XL_TRANSMIT_MSG
        transmitMsg(MsgNo).tagdata_can_msg.id = Convert.ToUInt32(Val(TBoxCanId.Text))

        Select Case CBoxCanMsgType.Text
            Case "Extended"
                Dim tmp As Int64
                tmp = Val(Hex(TBoxCanId.Text)) Or (XL_CAN_EXT_MSG_ID)
                transmitMsg(MsgNo).tagdata_can_msg.id = Convert.ToUInt32(tmp)
            Case "Standard"
                transmitMsg(MsgNo).tagdata_can_msg.id = Convert.ToUInt32(Val(TBoxCanId.Text))
        End Select

        Select Case CBox_RTRBit.SelectedItem
            Case "Dataframe"
                transmitMsg(MsgNo).tagdata_can_msg.flags = 0
                transmitMsg(MsgNo).tagdata_can_msg.data0 = Val(TBoxData0.Text)
                transmitMsg(MsgNo).tagdata_can_msg.data1 = Val(TBoxData1.Text)
                transmitMsg(MsgNo).tagdata_can_msg.data2 = Val(TBoxData2.Text)
                transmitMsg(MsgNo).tagdata_can_msg.data3 = Val(TBoxData3.Text)
                transmitMsg(MsgNo).tagdata_can_msg.data4 = Val(TBoxData4.Text)
                transmitMsg(MsgNo).tagdata_can_msg.data5 = Val(TBoxData5.Text)
                transmitMsg(MsgNo).tagdata_can_msg.data6 = Val(TBoxData6.Text)
                transmitMsg(MsgNo).tagdata_can_msg.data7 = Val(TBoxData7.Text)
                transmitMsg(MsgNo).tagdata_can_msg.dlc = Val(Tbox_CanDlc.Text)
            Case "Remoteframe"
                transmitMsg(MsgNo).tagdata_can_msg.flags = XL_CAN_MSG_FLAG_REMOTE_FRAME
                transmitMsg(MsgNo).tagdata_can_msg.data0 = 0
                transmitMsg(MsgNo).tagdata_can_msg.dlc = 0
        End Select

        'CBoxHardwareType.SelectedItem
        xlstatus = xlCanTransmit(portHandle, Convert.ToUInt64(CANchannelMask), Convert.ToUInt16(1), transmitMsg)
        If (xlstatus) Then
            Output.Items.Add(xlGetErrorString(xlstatus))
        End If
    End Sub
#End Region
#Region "Function ReceiveMessage"
    Public Sub ReceiveMessage()
        Dim dwWait = 0
        Dim xlstatus As Byte
        Dim pEventCount As UInt16 = Convert.ToUInt16(1)  'only one message supported yet, MUST init with 1!
        Dim Message As s_xlEvent     ' define message structure

        Do While (g_RXThreadRun = 1)
            'This call will block until a message comes in. Then we must go through 
            'the action of calling xlReceive to process the message. The timeout value
            RxThread.Sleep(10)
            dwWait = WaitForSingleObject(g_msgEvent, 10)

            ' receive of the message, pEventCount is a byref value - so 1 is supported here only
            xlstatus = xlReceive(portHandle, Convert.ToUInt16(1), Message)
            If (xlstatus) Then
                If Not (xlstatus = XL_ERR_QUEUE_IS_EMPTY) Then
                    Output.Items.Add(xlGetErrorString(xlstatus))
                End If

            Else
                Select Case Message.tag
                    Case XL_RECEIVE_MSG
                        Dim strMsgFlag As String = Message.timestamp.ToString & " CAN" & Str(Message.chanIndex)
                        Select Case Message.tagdata_can_msg.flags
                            Case XL_CAN_MSG_FLAG_ERROR_FRAME
                                strMsgFlag = strMsgFlag & " RX   " & " Errorframe"
                            Case (XL_CAN_MSG_FLAG_ERROR_FRAME + XL_CAN_MSG_FLAG_TX_REQUEST)
                                strMsgFlag = strMsgFlag & " TxRq " & " Errorframe"
                            Case (XL_CAN_MSG_FLAG_ERROR_FRAME + XL_CAN_MSG_FLAG_TX_COMPLETED)
                                strMsgFlag = strMsgFlag & " TX   " & " Errorframe TxCompleted"
                            Case XL_CAN_MSG_FLAG_REMOTE_FRAME
                                strMsgFlag = strMsgFlag & " RX   " & " ID  " & Message.tagdata_can_msg.id.ToString & _
                                    " DLC " & Message.tagdata_can_msg.dlc.ToString & " Remoteframe"
                            Case (XL_CAN_MSG_FLAG_REMOTE_FRAME + XL_CAN_MSG_FLAG_TX_REQUEST)
                                strMsgFlag = strMsgFlag & " TxRq " & " ID  " & Message.tagdata_can_msg.id.ToString & _
                                    " DLC " & Message.tagdata_can_msg.dlc.ToString & " Remoteframe TxRq"
                            Case (XL_CAN_MSG_FLAG_REMOTE_FRAME + XL_CAN_MSG_FLAG_TX_COMPLETED)
                                strMsgFlag = strMsgFlag & " TX   " & " ID  " & Message.tagdata_can_msg.id.ToString & _
                                    " DLC " & Message.tagdata_can_msg.dlc.ToString & " Remoteframe TxCompleted"
                            Case XL_CAN_MSG_FLAG_OVERRUN
                                strMsgFlag = strMsgFlag & " An overrun occured in the CAN controller"
                            Case XL_CAN_MSG_FLAG_NERR, XL_CAN_MSG_FLAG_WAKEUP, XL_CAN_MSG_FLAG_TX_COMPLETED, XL_CAN_MSG_FLAG_TX_REQUEST, XL_CAN_MSG_FLAG_RX
                                strMsgFlag = strMsgFlag & _
                                      " ID " & Message.tagdata_can_msg.id.ToString & _
                                      " DLC " & Message.tagdata_can_msg.dlc.ToString & _
                                      " Data " & Message.tagdata_can_msg.data0.ToString & _
                                      " " & Message.tagdata_can_msg.data1.ToString & _
                                      " " & Message.tagdata_can_msg.data2.ToString & _
                                      " " & Message.tagdata_can_msg.data3.ToString & _
                                      " " & Message.tagdata_can_msg.data4.ToString & _
                                      " " & Message.tagdata_can_msg.data5.ToString & _
                                      " " & Message.tagdata_can_msg.data6.ToString & _
                                      " " & Message.tagdata_can_msg.data7.ToString
                                Select Case Message.tagdata_can_msg.flags
                                    Case XL_CAN_MSG_FLAG_RX
                                        strMsgFlag = strMsgFlag & " RX"
                                    Case XL_CAN_MSG_FLAG_NERR
                                        strMsgFlag = strMsgFlag & " TE"
                                    Case XL_CAN_MSG_FLAG_WAKEUP
                                        strMsgFlag = strMsgFlag & " WU"
                                    Case XL_CAN_MSG_FLAG_TX_REQUEST
                                        strMsgFlag = strMsgFlag & " TxRq"
                                    Case XL_CAN_MSG_FLAG_TX_COMPLETED
                                        strMsgFlag = strMsgFlag & " TxCompleted"
                                End Select
                            Case Else
                        End Select
                        Output.Items.Add(strMsgFlag)

                    Case XL_CHIP_STATE
                        Dim strChipstate As String = " CAN " & Message.chanIndex.ToString & _
                                " RxErr:" & Message.tagdata_chipstate.rxErrorCounter.ToString & _
                                " TxErr:" & Message.tagdata_chipstate.txErrorCounter.ToString

                        Select Case Message.tagdata_chipstate.busStatus
                            Case XL_CHIPSTAT_BUSOFF
                                strChipstate = strChipstate & " bus:offline"
                            Case XL_CHIPSTAT_ERROR_PASSIVE
                                strChipstate = strChipstate & " bus:passive"
                            Case XL_CHIPSTAT_ERROR_ACTIVE, XL_CHIPSTAT_ERROR_ACTIVE0
                                strChipstate = strChipstate & " bus:active"
                            Case XL_CHIPSTAT_ERROR_WARNING
                                strChipstate = strChipstate & " bus:warning"
                        End Select
                        Output.Items.Add(Message.timestamp.ToString & strChipstate)
                    Case XL_TRANSCEIVER
                        Output.Items.Add(Message.timestamp.ToString & ": XL_TRANSCEIVER event triggered")
                    Case XL_TIMER
                        Output.Items.Add(Message.timestamp.ToString & ": XL_TIMER event triggered")
                    Case XL_SYNC_PULSE
                        Output.Items.Add(Message.timestamp.ToString & ": XL_SYNC_PULSE event triggered")
                    Case Else
                        Output.Items.Add(Message.tag.ToString)
                End Select

            End If
        Loop
    End Sub
#End Region
#Region "xlResetClock"
    Private Sub Bn_ResetClock_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Bn_ResetClock.Click
        Dim xlstatus As Byte

        xlstatus = xlResetClock(portHandle)
        If (xlstatus) Then
            Output.Items.Add(xlGetErrorString(xlstatus))
        End If
        Output.Items.Add("xlResetClock: clock reset")
    End Sub
#End Region
#Region "xlCanSetChannelMode"
    Private Sub BnTxReceipt_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BnTxReceipt.Click
        Dim xlstatus As Byte
        Dim TxReceipt, TxRqReceipt As UInt32
        ' generate receipts 0 = off, 1 = on

        Select Case BnTxReceipt.Text
            Case "Tx:off TxRq:off"
                TxReceipt = Convert.ToUInt32(1)
                TxRqReceipt = Convert.ToUInt32(0)
                BnTxReceipt.Text = "Tx:on TxRq:off"
            Case "Tx:on TxRq:off"
                TxReceipt = Convert.ToUInt32(1)
                TxRqReceipt = Convert.ToUInt32(1)
                BnTxReceipt.Text = "Tx:on TxRq:on"
            Case "Tx:on TxRq:on"
                TxReceipt = Convert.ToUInt32(0)
                TxRqReceipt = Convert.ToUInt32(1)
                BnTxReceipt.Text = "Tx:off TxRq:on"
            Case "Tx:off TxRq:on"
                TxReceipt = Convert.ToUInt32(0)
                TxRqReceipt = Convert.ToUInt32(0)
                BnTxReceipt.Text = "Tx:off TxRq:off"
        End Select

        ' xlCanSetChannelMode
        xlstatus = xlCanSetChannelMode(portHandle, accessMask, TxReceipt, TxRqReceipt)
        If (xlstatus) Then
            Output.Items.Add(xlGetErrorString(xlstatus))
        End If
    End Sub
#End Region
#Region "xlCanFlushTransmitQueue"
    Private Sub BnFlushTXQueue_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BnFlushTXQueue.Click
        Dim xlstatus As Byte
        ' xlCanFlushTransmitQueue

        xlstatus = xlCanFlushTransmitQueue(portHandle, accessMask)
        If (xlstatus) Then
            Output.Items.Add("xlCanFlushTansmitQueue:" & xlGetErrorString(xlstatus))
        End If
        Output.Items.Add("xlCanFlushTansmitQueue: flushed TX Queue")
    End Sub
#End Region
#Region "xlFlushReceiveQueue"
    Private Sub BnFlushRXQueue_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BnFlushRXQueue.Click
        Dim xlstatus As Byte
        ' xlCanFlushTransmitQueue

        xlstatus = xlFlushReceiveQueue(portHandle, accessMask)
        If (xlstatus) Then
            Output.Items.Add("xlFlushReceiveQueue:" & xlGetErrorString(xlstatus))
        End If
        Output.Items.Add("xlFlushReceiveQueue: flushed RX Queue")
    End Sub
#End Region
#Region "xlActivateChannel, xlDeactivateChannel, xlCanSetChannelBitrate"
    Private Sub BnActivateChannels_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BnActivateChannels.Click
        Dim xlstatus As Byte
        If BnActivateChannels.Text = "Activate" Then

            ' xlCanSetChannelBitrate - usable with init access only!
            Dim Bitrate As UInt32 = Convert.ToUInt32(Val(CBoxBitrate.SelectedItem))  ' could set to 15'000 - 1'000'000
            xlstatus = xlCanSetChannelBitrate(portHandle, accessMask, Bitrate)
            If (xlstatus) Then
                Output.Items.Add("xlCanSetChannelBitrate:" & xlGetErrorString(xlstatus))
            Else
                Output.Items.Add("xlCanSetChannelBitrate: set to " & CBoxBitrate.SelectedItem & " BPS")
            End If

            'xlActivateChannel
            Dim bustype As UInt32 = Convert.ToUInt32(XL_BUS_TYPE_CAN)
            Dim flags As UInt32 = Convert.ToUInt32(XL_ACTIVATE_RESET_CLOCK)

            xlstatus = xlActivateChannel(portHandle, accessMask, bustype, flags)
            If (xlstatus) Then  'error
                Output.Items.Add(xlGetErrorString(xlstatus))
            Else  'channels activated
                Output.Items.Add("xl.Channels activated")
                BnActivateChannels.Text = "Deactivate"
                GroupCanMessage.Enabled = True
                GroupCanSpecial.Enabled = True