VB.NET 串口访问之三

来源:岁月联盟 编辑:exp 时间:2011-10-02

程序如下:

 

 

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.Threading 

Imports System.Text.RegularExpressions 

 

'例如:AA 44 05 01 02 03 04 05 EA 

'    这里我假设的一条数据,协议如下: 

'    数据头:     AA 44 

'    数据长度:05 

'    数据正文:01 02 03 04 05 

'    校验:       EA 

'    一般数据的校验,都会采用常用的方式,CRC16,CRC32,Xor。 

 

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    

 

    Private Buffer As List(Of Byte) = New List(Of Byte)(4096) '默认分配1页内存,并始终限制不允许超过    

    Private Binary_Data_1(9) As Byte      'AA 44 05 01 02 03 04 05 EA  

 

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

 

 

    Public Sub ShowData(ByVal mByte() As Byte) 

        Console.WriteLine(mByte) 

        ReceiveCount += mByte.Length          '统计字节总数 

        Builder.Clear()                       '清除字符串构造器的内容  

        Console.WriteLine("Main1() invoke on thread{0}.", Thread.CurrentThread.ManagedThreadId) 

        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 

 

    Public Delegate Sub UpdateStr(ByVal mByte As String) 

 

    Public Sub ShowStr(ByVal mByte As String) 

        TxtGet.Text = mByte 

    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 

        BtnXReset.PerformClick() 

 

 

    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)                '读取缓冲数据 

 

            Dim Data_1_Catched As Boolean = False     '缓存记录数据是否捕获到 

            Console.WriteLine("Main0() invoke on thread{0}.", Thread.CurrentThread.ManagedThreadId) 

 

 

            Buffer.AddRange(Buf) 

 

            While Buffer.Count >= 4 

                '请不要担心使用>=,因为>=已经和>,<,=一样,是独立操作符,并不是解析成>和=2个符号    

                '查找数据头   

 

                If (Buffer(0) = &HAA And Buffer(1) = &H44) Then 

 

                    '探测缓存数据是否有一条数据的字节,如果不够,就不用费劲的做其他验证了    

                    '前面已经限定了剩余长度>=4,那我们这里一定能访问到buffer[2]这个长度   

 

                    Dim Len As Integer = Buffer(2) 

                    '数据完整判断第一步,长度是否足够    

                    'len是数据段长度,4个字节是while行注释的3部分长度    

 

                    If Buffer.Count < Len + 4 Then Exit While '数据不够的时候什么都不做,退出循环 

 

                    '这里确保数据长度足够,数据头标志找到,我们开始计算校验    

                    '2.3 校验数据,确认数据正确    

                    '异或校验,逐个字节异或得到校验码    

                    Dim CheckSum As Byte = 0 

 

                    For i As Integer = 0 To Len + 3 

                        CheckSum = CheckSum Xor Buffer(i) 

                    Next 

 

                    If CheckSum <> Buffer(Len + 3) Then 

                        Buffer.RemoveRange(0, Len + 4) 

                        Continue While 

                    End If 

                    '至此,已经被找到了一条完整数据。我们将数据直接分析,或是缓存起来一起分析    

                    '我们这里采用的办法是缓存一次,好处就是如果你某种原因,数据堆积在缓存buffer中    

                    '已经很多了,那你需要循环的找到最后一组,只分析最新数据,过往数据你已经处理不及时    

                    '了,就不要浪费更多时间了,这也是考虑到系统负载能够降低。  

 

                    '复制一条完整数据到具体的数据缓存    

                    Buffer.CopyTo(0, Binary_Data_1, 0, Len + 4) 

 

                    Data_1_Catched = True 

                    Buffer.RemoveRange(0, Len + 4) 

                Else 

                    Buffer.RemoveAt(0)  '这里是很重要的,如果数据开始不是头,则删除数据    

                End If 

            End While 

 

            If Data_1_Catched Then 

 

                '我们的数据都是定好格式的,所以当我们找到分析出的数据1,就知道固定位置一定是这些数据,我们只要显示就可以了 

 

                Dim data As String = Binary_Data_1(3).ToString("X2") + " " + Binary_Data_1(4).ToString("X2") + 

                                     Binary_Data_1(5).ToString("X2") + " " + Binary_Data_1(6).ToString("X2") + 

                                     Binary_Data_1(7).ToString("X2") 

 

                Dim a As UpdateStr = New UpdateStr(AddressOf ShowStr) 

                Me.BeginInvoke(a, data) 

 

            End If 

 

            '如果需要别的协议,只要扩展这个data_n_catched就可以了。往往我们协议多的情况下,还会包含数据编号,给来的数据进行    

            '编号,协议优化后就是: 头+编号+长度+数据+校验    

            '</协议解析>    

 

            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 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 

 

  摘自:wl58796351的专栏