微信公众号搜"智元新知"关注
微信扫一扫可直接关注哦！

VB.NET 串口访问之三

分类：VB作者：编程之家

程序如下：

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

原文地址：https://www.jb51.cc/vb/260859.html

版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。

相关推荐

VB Format函数
Format[$] ( expr [ , fmt ] ) format 返回变体型 format$ 强制返回为文本 -------------------------------- 数字类型的格式化 --------------------------------     固定格式参数：     General Number 普通数字，如可以用来去掉千位分隔号     format$("100,1
vb6/ASP FORMAT MM/DD/YYYY
VB6或者ASP 格式化时间为 MM/dd/yyyy 格式，竟然没有好的办法， Format 或者FormatDateTime 竟然结果和系统设置的区域语言的日期和时间格式相关。意思是尽管你用诸如 Format(Now, "MM/dd/yyyy")，如果系统的设置格式区域语言的日期和时间格式分隔符是"-",那他还会显示为 MM-dd-yyyy     只有拼凑： <%response.write
VB.net 捕获项目全局异常
在项目中添加如下代码：新建窗口来显示异常信息。 Namespace My ‘全局错误处理，新的解决方案直接添加本ApplicationEvents.vb 到工程即可 ‘添加后还需要一个From用来显示错误。如果到这步还不会则需要先打好基础啦 ‘======================================================== ‘以下事件
实现用VB.Net/(C#)开发K/3 BOS 插件的真正可行方法
转了这一篇文章，原来一直想用C#做k3的插件开发，vb没有C#用的爽呀，这篇文章写与2011年，看来我以前没有认真去找这个方法呀。 https://blog.csdn.net/chzjxgd/article/details/6176325 金蝶K3 BOS的插件官方是用VB6编写的，如果  能用.Net下的语言工具开发BOS插件是一件很愉快的事情，其中缘由不言而喻，而本文则是个人首创，实现在了用V
vb，wps，excel 分裂
Sub 分列() ‘以空格为分隔符，连续空格只算1个。对所选中的单元格进行处理 Dim m As Range, tmpStr As String, s As String Dim x As Integer, y As Integer, subStr As String If MsgBox("确定要分列处理吗？请确定分列的数据会覆盖它后面的单元格！", _
VB文件 hash 查看器
  窗体代码 1 Private Sub Text1_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single) 2 Dim path As String, hash As String 3 For Each fil
VB.NET MYSQL DataGridView 增删改查INSERT,SELECT,UPDATE,DELETE
  Imports MySql.Data.MySqlClient Public Class Form1 ‘ GLOBAL DECLARATIONS Dim conString As String = "Server=localhost;Database=net2;Uid=root;Pwd=123456;" Dim con As New MySqlConnection
VB.NET 使用ADODB連接資料庫滙出到EXCEL
‘導入命名空間 Imports ADODB Imports Microsoft.Office.Interop   Private Sub A1() Dim Sql As String Dim Cnn As New ADODB.Connection Dim Rs As New ADODB.Recordset Dim S As String   S = "Provider=OraOLEDB.Oracl
vb.net 多线程運用 ping
Imports System.IO Imports System.Threading Imports System.Diagnostics Public Class Form1 Dim A(254) As String    Function ping(ByVal IP As Integer) As String Dim IPAddress As String IPAddress = "10.0.
VB等待进程结束
VB运行EXE程序，并等待其运行结束 参考：https://blog.csdn.net/useway/article/details/5494084 Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long Pr
苹果市值2025年有望达4万亿美元
pythonJavaScriptjavaHTMLPHPreactjsC#AndroidCSSNode.jssqlrpython-3.xMysqLjQueryc++pandasFlutterangularIOSdjangolinuxswifttypescript路由器JSON路由器设置无线路由器h3c华三华三路由器设置华三路由器电脑软件教程arraysdocker软件图文教程Cvue.jslaravelspring-boot