VB.NET 串口异步访问

Imports System
Imports System.Collections.Generic
Imports System.ComponentModel
Imports System.Data
Imports System.Drawing
Imports System.Linq
Imports System.Text
Imports System.IO.Ports
Imports System.Text.RegularExpressions




Public Class Form1


    WithEvents Comm As SerialPort = New SerialPort
    Private Builder As StringBuilder = New StringBuilder '避免在事件处理方法中反复的创建，所以定义到外面
    Private ReceiveCount As Long = 0     '接收计数
    Private SendCount As Long = 0        '发送计数


    Private Listening As Boolean = False  '是否没有执行完invoke相关操作 
    Private Closingg As Boolean = False     '是否正在关闭串口，执行Application.DoEvents，并阻止再次invoke   


    Public Delegate Sub UpdateData(ByVal mByte() As Byte)


    Public Sub ShowData(ByVal mByte() As Byte)
        Console.WriteLine(mByte)
        ReceiveCount += mByte.Length
        Builder.Clear()


        If CheckBoxHex.Checked Then
            For Each b As Byte In mByte
                Builder.Append(b.ToString("X2") + " ")
            Next


        Else


            Builder.Append(Encoding.ASCII.GetString(mByte))


        End If
        TxtGet.AppendText(Builder.ToString)
        labelGetCount.Text = "Get:" + ReceiveCount.ToString
    End Sub


    Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load


        '初始化下拉串口名称列表框
        Dim Ports() As String = SerialPort.GetPortNames
        Array.Sort(Ports)
        ComboPortName.Items.AddRange(Ports)
        ComboPortName.SelectedIndex = IIf(ComboPortName.Items.Count > 0, 0, -1)
        ComboBaudrate.SelectedIndex = ComboBaudrate.Items.IndexOf("9600")
        '初始化Serialport对象
        Comm.NewLine = vbCrLf
        Comm.RtsEnable = True


        'AddHandler Obj.Ev_Event, AddressOf EventHandler
        'RemoveHandler Obj.Ev_Event, AddressOf EventHandler
        'AddHandler Comm.DataReceived, AddressOf Comm_DataReceived


    End Sub


    Private Sub Comm_DataReceived(sender As Object, e As System.IO.Ports.SerialDataReceivedEventArgs) Handles Comm.DataReceived
        If Closingg Then Return '如果正在关闭，忽略操作，直接返回，尽快的完成串口监听线程的一次循环   


        Try
            Listening = True                    '设置标记，说明我已经开始处理数据，一会儿要使用系统UI的。
            Dim n As Long = Comm.BytesToRead    '先记录下来，避免某种原因，人为的原因，操作几次之间时间长，缓存不一致   
            Dim Buf(n - 1) As Byte              '声明一个临时数组存储当前来的串口数据 


            Comm.Read(Buf, 0, n)                '读取缓冲数据
            Builder.Clear()                     '清除字符串构造器的内容 


            Dim b As UpdateData = New UpdateData(AddressOf ShowData)
            Me.BeginInvoke(b, Buf)


        Catch ex As Exception
            Err.Clear()
        Finally
            Listening = False                    '我用完了，ui可以关闭串口了。
        End Try
    End Sub


    Private Sub ShowMsg(ByVal buffer() As Byte)
        If CheckBoxHex.Checked Then
            For Each b As Byte In Buffer
                Builder.Append(b.ToString("X2") + " ")
            Next
        Else
            Builder.Append(Encoding.ASCII.GetString(buffer))
        End If
        Me.TxtGet.AppendText(Builder.ToString())
        labelGetCount.Text = "Get:" + ReceiveCount.ToString
    End Sub


    Private Sub BtnXOpen_Click(sender As System.Object, e As System.EventArgs) Handles BtnXOpen.Click
        '根据当前串口对象，来判断操作 
        If Comm.IsOpen Then
            Closingg = True '
            While Listening
                Application.DoEvents()
            End While
            '打开时点击，则关闭串口
            Comm.Close()
            Closingg = False
        Else
            Comm.PortName = ComboPortName.Text
            Comm.BaudRate = Integer.Parse(ComboBaudrate.Text)
            Try
                Comm.Open()
            Catch ex As Exception
                '捕获到异常信息，创建一个新的comm对象，之前的不能用了。 
                Comm = New SerialPort
                '现实异常信息给客户。 
                MessageBox.Show(ex.Message)
            End Try
        End If


        '设置按钮的状态   
        BtnXOpen.Text = IIf(Comm.IsOpen, "Close", "Open")
        BtnXOpen.Enabled = Comm.IsOpen


    End Sub


    '动态的修改获取文本框是否支持自动换行。
    Private Sub CheckBoxNewLineGet_CheckedChanged(sender As System.Object, e As System.EventArgs) Handles CheckBoxNewLineGet.CheckedChanged
        TxtGet.WordWrap = CheckBoxNewLineGet.Checked
    End Sub


    Private Sub BtnXSend_Click(sender As System.Object, e As System.EventArgs) Handles BtnXSend.Click
        Dim n As Integer = 0  '定义一个变量，记录发送了几个字节 
        If checkBoxHexSend.Checked Then   '16进制发送 
            '我们不管规则了。如果写错了一些，我们允许的，只用正则得到有效的十六进制数   
            Dim Mc As MatchCollection = Regex.Matches(TxtSend.Text.Trim, "(?i)[/da-f]{2}")   '"(?i)[/da-f]{2}"
            Dim buf As List(Of Byte) = New List(Of Byte)


            '依次添加到列表中   
            For Each m As Match In Mc
                '  buf.Add(Byte.Parse(m.Value))
                buf.Add(Byte.Parse(m.Value, System.Globalization.NumberStyles.HexNumber))
            Next


            '转换列表为数组后发送  
            Comm.Write(buf.ToArray, 0, buf.Count)
            n = buf.Count
        Else                             'ascii编码直接发送 
            '包含换行符
            If checkBoxNewlineSend.Checked Then
                Comm.WriteLine(TxtSend.Text)
                n = TxtSend.Text.Length + 2
            Else
                Comm.Write(TxtSend.Text)
                n = TxtSend.Text.Length
            End If
        End If


        SendCount += n    '累加发送字节数 
        labelSendCount.Text = "Send:" + SendCount.ToString
    End Sub


    Private Sub BtnXReset_Click(sender As System.Object, e As System.EventArgs) Handles BtnXReset.Click


        '复位接受和发送的字节数计数器并更新界面。
        SendCount = 0
        ReceiveCount = 0
        labelGetCount.Text = "Get:0"
        labelSendCount.Text = "Send:0"
        Builder.Clear()


    End Sub


    Private Sub BtxClear_Click(sender As System.Object, e As System.EventArgs) Handles BtxClear.Click
        TxtGet.Text = ""
        Builder.Clear()
    End Sub
End Class