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