Imports System.Data.Common Imports System.IO Imports System.IO.Ports Imports System.Threading Imports Newtonsoft.Json Public Class Form1 '创建串口对象 Private Sub TextBox1_KeyPress(sender As Object, e As KeyPressEventArgs) Handles Text_Row.KeyPress, TextBox3.KeyPress, TextBox2.KeyPress, TextBox1.KeyPress '限制TextBox1只能输入数字 e.Handled = Not $"0123456789{vbBack}".Contains(e.KeyChar) '如果要只允许输入数字， End Sub Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click inintGrid1(CInt（Text_Row.Text）, (CInt（TextBox2.Text）)） Button3_Click(Nothing, Nothing) End Sub Public Sub inintGrid1(r As Integer, c As Integer) Grid1.NewFile() Grid1.Rows = r * 3 + 1 Grid1.Cols = c * 2 + 1 Dim iWidth As Integer iWidth = （Grid1.Width - 20） / (c * 2) With Grid1 .DefaultRowHeight = 70 .Row(0).Visible = False For j = 0 To Grid1.Cols - 1 If j = 0 Then .Column(0).Visible = False .Column(j).Width = 0 Continue For End If .Column(j).Width = iWidth .Column(j).Alignment = FlexCell.AlignmentEnum.CenterCenter Next End With For i = 1 To r For j = 1 To c Grid1.Range(i * 3 - 2, j * 2 - 1, i * 3, j * 2).MergeCells = True Next Next Grid1.Range(1, 1, Grid1.Rows - 1, Grid1.Cols - 1).FontBold = True Grid1.Range(1, 1, Grid1.Rows - 1, Grid1.Cols - 1).FontSize = 72 End Sub 'Public Sub InitGrid2(r As Integer, c As Integer) ' Grid2.NewFile() ' Grid2.Rows = r * c + 1 ' Grid2.Cols = 3 'End Sub Private Sub Cbo_Port_DropDown(sender As Object, e As EventArgs) Handles Cbo_Port.DropDown Cbo_Port.Items.Clear() Cbo_Port.Items.AddRange(SerialPort.GetPortNames()) End Sub Public IsRead As Boolean = False Public listening As Boolean = False Private Sub Btn_OpenPort_Click(sender As Object, e As EventArgs) Handles Btn_OpenPort.Click If Btn_OpenPort.Text = "Disconnect" Then Btn_OpenPort.Text = "Connect" Btn_OpenPort.BackColor = Color.Transparent Cbo_Port.Enabled = True Cbo_Baud.Enabled = True Try If SerialPort1.IsOpen Then '判断是否有接收数据 'Isread = False '将串口接收关联事件取消 'RemoveHandler SerialPort1.DataReceived, AddressOf SerialPort1_DataReceived IsRead = True While (listening) Application.DoEvents() Thread.Sleep(10) End While Thread.Sleep(10) SerialPort1.DiscardInBuffer() SerialPort1.Close() IsRead = False End If Catch ex As Exception MsgBox("关闭连接失败！") End Try ' m_CommunicationFlow.m_Transmitter.CloseTransmitter() Else IsRead = False 'AddHandler SerialPort1.DataReceived, AddressOf SerialPort1_DataReceived Btn_OpenPort.Text = "Disconnect" Btn_OpenPort.BackColor = Color.Red Cbo_Port.Enabled = False Cbo_Baud.Enabled = False 'If IsNothing(m_CommunicationFlow.m_Transmitter) Then ' Tab_SerialSettings_SelectedIndexChanged(Nothing, Nothing) 'End If '设置 SerialPort1 端口名 Try If SerialPort1.IsOpen Then SerialPort1.Close() End If SerialPort1.PortName = Cbo_Port.Text SerialPort1.BaudRate = CInt(Cbo_Baud.Text) SerialPort1.Open() Catch ex As Exception MsgBox("创建连接失败！") 'setToolStripLabel2color($"sqlite创建连接失败！！！{vbCrLf }", Color.Green, RichTextBox1) Btn_OpenPort_Click(Nothing, Nothing) Return End Try 'If IsNothing(SerialPort1) Then ' Return CreateSerial(m_SerialComfig) 'End If 'If Not m_Serial.IsOpen Then ' Try ' m_Serial.Open() ' Catch ex As Exception ' Return False ' End Try 'End If 'Return True 'm_CommunicationFlow.m_Transmitter.OpenTransmitter() 'If m_CommunicationFlow.m_Transmitter.IsTransmitter AndAlso m_CommunicationFlow.m_Transmitter.GetTransmitterStatus Then 'Else ' MsgBox("创建连接失败！") ' Btn_OpenPort_Click(Nothing, Nothing) ' Return 'End If End If End Sub ''定义数据入库线程 'Private DataToSqlThread As Thread ''创建线程 'Public Sub CreateDataToSqlThread() ' DataToSqlThread = New Thread(AddressOf DataToSql) ' 'DataToSqlThread.IsBackground = True ' DataToSqlThread.Start() 'End Sub '线程方法 'Private Sub DataToSql() ' While True ' End While 'End Sub '队列变量 ' Public DataToSqlQueue As Queue(Of Dictionary(Of String, String）) '键值对对象 Public Sqldic As Dictionary(Of String， String) Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load 'Text = Application.ProductName '页面标题显示程序名称加版本号 Text = Application.ProductName & " " & Application.ProductVersion 'CheckBox1.Checked = True Cbo_Baud.SelectedIndex = 3 recvBufferli = New List(Of Byte)() Counter = 0 'DataToSqlQueue = New Queue(Of Dictionary(Of String, String))() pardic = New Dictionary(Of Integer, (Integer， Integer)) Sqldic = New Dictionary(Of String, String)() Timer1.Start() Button1.PerformClick() GetMeSeting() ClearDeviceform() ' CreateDataToSqlThread() End Sub '读取系统缓存 Public Sub GetMeSeting() My.Settings.Reload() If Not String.IsNullOrEmpty(My.Settings.SerialPortName) Then Cbo_Port.Text = My.Settings.SerialPortName ' pardic = JsonConvert.DeserializeObject(Of Dictionary(Of Integer, (Integer， Integer)))(My.Settings.m_Applicationconfig) End If If Not String.IsNullOrEmpty(My.Settings.scope) Then pardic = JsonConvert.DeserializeObject(Of Dictionary(Of Integer, (Integer， Integer)))(My.Settings.scope) End If End Sub '保存系统缓存 Public Sub SaveMeSeting() My.Settings.SerialPortName = Cbo_Port.Text My.Settings.scope = JsonConvert.SerializeObject(pardic) My.Settings.Save() End Sub Public recvBufferli As List(Of Byte) Private Sub SerialPort1_DataReceived(sender As Object, e As SerialDataReceivedEventArgs) Handles SerialPort1.DataReceived If IsRead Then Return listening = True Dim bytes As Integer = 0 Try Do bytes = SerialPort1.BytesToRead If bytes <= 0 Then Exit Sub 'If bytes + _recvOffset >= 4096 Then ' 'ShowPortReceData(_recvBuffer) ' sp.Read(_recvBuffer, _recvOffset, 4096 - _recvOffset) ' _recvOffset = 0 'Else ' sp.Read(_recvBuffer, _recvOffset, bytes) ' _recvOffset += bytes 'End If Dim buf(bytes - 1) As Byte If SerialPort1.IsOpen Then SerialPort1.Read(buf, 0, bytes) End If recvBufferli.AddRange(buf) Thread.Sleep(5) Loop While (SerialPort1.IsOpen AndAlso （SerialPort1.BytesToRead > 0)) If recvBufferli.Count > 0 Then Dim buf(recvBufferli.Count - 1) As Byte Array.Copy(recvBufferli.ToArray, 0, buf, 0, buf.Length) recvBufferli.Clear() Counter = 0 RuningLog.OutputLogsToTheControl(RichTextBox1, New RuningLogConfig($"RX:{ByteToString2(buf)}", Color.Blue), 1) '处理接收到的数据(recvBufferli.ToArray()) ProcessRecvData(buf) 'listening = False End If listening = False Catch ex As Exception MsgBox(ex.Message) listening = False RuningLog.OutputLogsToTheControl(RichTextBox1, New RuningLogConfig($"串口接收数据失败,原因:{ex.Message}", Color.Red), 1) End Try End Sub '处理接收结果 Private Sub ProcessRecvData(recvData As Byte()) '获取行数列数 Dim row As Integer = CInt(Text_Row.Text) Dim col As Integer = CInt(TextBox2.Text) row = row * col * 10 + 2 If recvData.Length = row Then If recvData(0) = &HD AndAlso recvData(1) = &HA Then ParsingCommandResponse(recvData, Grid1, RichTextBox1) End If Else RuningLog.OutputLogsToTheControl(RichTextBox1, New RuningLogConfig($"接收数据长度异常，接收长度{recvData.Length},实际长度{row}", Color.Red), 1) End If '判断数据长度是否正确 End Sub Public Counter As Integer = 0 Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick '判断串口是否发开 If SerialPort1.IsOpen Then '判断计数器是否小于10 If Counter > 20 Then '1S If Counter > 30 Then Dim buf() As Byte = HexStringToByteArray("AF 00 07 4B 03 01 FA") RuningLog.OutputLogsToTheControl(RichTextBox1, New RuningLogConfig($"TX:{ByteToString2(buf)}", Color.Green), 1) '清除发送缓存 SerialPort1.DiscardOutBuffer() SerialPort1.Write(buf, 0, buf.Length) Counter = 22 Else End If If Counter = 21 Then 'DataToSqlQueue ''数据到达次数计数变量 'Public ReleaseCounter， TriggerCounter， Triggerindex As Integer ReleaseCounter = 0 TriggerCounter = 0 Triggerindex = 0 If Sqldic.Count > 0 Then If CheckBox1.Checked Then Sqldic.Add("CreateTime", Now.ToString("yyyy-MM-dd HH:mm:ss")) InsertDeviceform(Sqldic) WriteTomysql(Sqldic) End If End If Sqldic.Clear() End If End If Counter += 1 End If End Sub Private Sub Form1_FormClosed(sender As Object, e As FormClosedEventArgs) Handles MyBase.FormClosed Timer1.Stop() If SerialPort1.IsOpen Then SerialPort1.Close() End If '判断线程是否在运行 'If Not IsNothing(DataToSqlThread) AndAlso DataToSqlThread.ThreadState = ThreadState.Running Then ' DataToSqlThread.Abort() 'End If SaveMeSeting() End Sub Public Shared Function ByteToString2(databuff() As Byte) Dim strData As String = String.Empty For i = 0 To databuff.Length - 1 strData &= $" {ByteToHex1(databuff(i)).PadLeft(2, "0"c)}" Next Return strData End Function Public Shared Function HexStringToByteArray(hex As String) As Byte() Dim bytes As New List(Of Byte) hex = hex.Replace(" ", "").Trim.ToUpper() For i As Integer = 0 To hex.Length - 1 Step 2 Dim hexByte As String = hex.Substring(i, 2) bytes.Add(Convert.ToByte(hexByte, 16)) Next Return bytes.ToArray() End Function Public Shared Function ByteToHex1(ByVal b As Byte) As String Return b.ToString("X2") End Function ' DataToSqlQueue '数据到达次数计数变量 Public ReleaseCounter， TriggerCounter， Triggerindex As Integer Delegate Sub delParsingCommandResponse(recvData As Byte(), gTable As FlexCell.Grid, gRicText As RichTextBox) Public Sub ParsingCommandResponse(recvData As Byte(), gTable As FlexCell.Grid, gRicText As RichTextBox) If gRicText.InvokeRequired Then Dim d As New delParsingCommandResponse(AddressOf ParsingCommandResponse) gRicText.Invoke(d, recvData, gTable, gRicText) Else Dim row As Integer = CInt(Text_Row.Text) Dim col As Integer = CInt(TextBox2.Text) Dim lowint As Integer = CInt(TextBox3.Text) Dim upint As Integer = CInt(TextBox1.Text) Dim s As Short Dim vstr As String ' row = row * col Dim r, c， index， val As Integer For i As Integer = 1 To row For j As Integer = 1 To col r = i * 3 - 2 c = j * 2 - 1 index = (i - 1) * col + j s = recvData(1 + (index * 10 - 3)) s = s << 8 s += recvData(1 + (index * 10 - 2)) val = s 'recvData(1 + (index * 10 - 3)) * 255 + recvData(1 + (index * 10 - 2)) With gTable.Cell(r, c) .Text = val If recvData(1 + (index * 10)) = 1 Then Console.WriteLine($"触发按键序号{index}：{val}{vbCrLf}{ ByteToString2(recvData)}") If pardic(index).Item1 <= val AndAlso val <= pardic(index).Item2 Then .BackColor = Color.Green Else .BackColor = Color.OrangeRed End If If Triggerindex = index Then setToolStripLabel2color2(index, Color.Black, RichTextBox1, Label18) If TriggerCounter = 4 Then vstr = $"key{index}_Trigger_Difference" setToolStripLabel2color2(val, Color.Black, RichTextBox1, Label17) If Sqldic.ContainsKey(vstr) Then Sqldic(vstr) = val Else Sqldic.Add(vstr, val) End If Else 'setToolStripLabel2color2("", Color.Black, RichTextBox1, Label17) ' TriggerCounter += 1 End If If TriggerCounter > 10 Then Else TriggerCounter += 1 End If Else setToolStripLabel2color2("", Color.Black, RichTextBox1, Label18) setToolStripLabel2color2("", Color.Black, RichTextBox1, Label17) Triggerindex = index TriggerCounter = 0 End If Else .BackColor = Color.White End If End With If ReleaseCounter = 6 Then vstr = $"key{index}_Release_Difference" If Sqldic.ContainsKey(vstr) Then Sqldic(vstr) = val Else Sqldic.Add(vstr, val) End If End If Next Next vstr = "ClosingRemarks" If Sqldic.ContainsKey(vstr) Then Sqldic(vstr) = ByteToString2(recvData) Else Sqldic.Add(vstr, ByteToString2(recvData)) End If If ReleaseCounter > 100 Then Else ReleaseCounter += 1 End If End If End Sub Private Sub ToolStripButton1_Click(sender As Object, e As EventArgs) Handles ToolStripButton1.Click RichTextBox1.Clear() End Sub Public pardic As Dictionary(Of Integer, (Integer， Integer)) Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click pardic.Clear() pardic.Add(1, (CInt（TextBox4.Text）, CInt（TextBox5.Text）)) pardic.Add(2, (CInt（TextBox6.Text）, CInt（TextBox7.Text）)) pardic.Add(3, (CInt（TextBox8.Text）, CInt（TextBox9.Text）)) pardic.Add(4, (CInt（TextBox10.Text）, CInt（TextBox11.Text）)) pardic.Add(5, (CInt（TextBox12.Text）, CInt（TextBox13.Text）)) pardic.Add(6, (CInt（TextBox14.Text）, CInt（TextBox15.Text）)) End Sub '创建slqit Public FileCPatrh = "C:\KeyPressTest" Public Sqlitedbpath As String = FileCPatrh & "\SQlitedb\test.db" Public SqliteTableName As String = "keypresstest" Public Function ClearDeviceform() As Boolean Dim localConn As New DbConnectionStringBuilder localConn.Add("Data Source", Sqlitedbpath) 'localConn.Add("Password", "123456") Dim LocalConnString = localConn.ToString() '判断有没有文件夹 If Not Directory.Exists(FileCPatrh & "\SQlitedb\") Then Directory.CreateDirectory(FileCPatrh & "\SQlitedb\") End If Dim selectstr As String = $"CREATE TABLE IF NOT EXISTS `{SqliteTableName}` ( `ID` INTEGER PRIMARY KEY AUTOINCREMENT, `CreateTime` TEXT NOT NULL, `key1_Release_Difference` TEXT DEFAULT NULL, `key2_Release_Difference` TEXT DEFAULT NULL, `key3_Release_Difference` TEXT DEFAULT NULL, `key4_Release_Difference` TEXT DEFAULT NULL, `key5_Release_Difference` TEXT DEFAULT NULL, `key6_Release_Difference` TEXT DEFAULT NULL, `key1_Trigger_Difference` TEXT DEFAULT NULL, `key2_Trigger_Difference` TEXT DEFAULT NULL, `key3_Trigger_Difference` TEXT DEFAULT NULL, `key4_Trigger_Difference` TEXT DEFAULT NULL, `key5_Trigger_Difference` TEXT DEFAULT NULL, `key6_Trigger_Difference` TEXT DEFAULT NULL, `ClosingRemarks` TEXT DEFAULT NULL );" Dim dt As DataTable Try Using db As New DbExecutor(DbExecutor.DbTypeEnum.Sqlite, LocalConnString) db.Open() 'Try ' 'Dim vselectstr = $"DELETE FROM {Tftp_Log};" ' 'db.ExecuteNonQuery(vselectstr) 'Catch ex As Exception 'End Try dt = db.ExecuteDataTable(selectstr) db.Close() If IsNothing(dt) Then MsgBox($"数据表创建失败！！！{vbCrLf }") Return False Else Return True End If Return True End Using Catch ex As Exception MsgBox($"数据表创建失败！！！{vbCrLf }原因:{vbCrLf }{ex.Message }") Return False End Try End Function '设置数据库状态 Delegate Sub DelegatesetToolStripLabel2color(strtext As String， bcolor As Color, gRicText As RichTextBox) Public Sub setToolStripLabel2color(strtext As String， bcolor As Color, gRicText As RichTextBox) If gRicText.InvokeRequired Then Dim d As New DelegatesetToolStripLabel2color(AddressOf setToolStripLabel2color) gRicText.Invoke(d, strtext, bcolor, gRicText) Else ToolStripLabel2.Text = strtext ToolStripLabel2.BackColor = bcolor End If End Sub Delegate Sub DelegatesetToolStripLabel2color2(strtext As String， bcolor As Color, gRicText As RichTextBox, lab As Label) Public Sub setToolStripLabel2color2(strtext As String， bcolor As Color, gRicText As RichTextBox, lab As Label) If gRicText.InvokeRequired Then Dim d As New DelegatesetToolStripLabel2color(AddressOf setToolStripLabel2color) gRicText.Invoke(d, strtext, bcolor, gRicText, lab) Else lab.Text = strtext 'ToolStripLabel2.BackColor = bcolor End If End Sub Public Function InsertDeviceform(dic As Dictionary(Of String, String)) As Boolean Dim localConn As New DbConnectionStringBuilder localConn.Add("Data Source", Sqlitedbpath) Using db As New DbExecutor(DbExecutor.DbTypeEnum.Sqlite, localConn.ToString()) Try db.Open() Dim caint = db.ExecuteNonQuery(db.CmdHelper.Insert(SqliteTableName, dic)) If caint = 0 Then 'MsgBox($"Sqlite入库失败！！！{vbCrLf }") setToolStripLabel2color($"Sqlite入库失败！！！{vbCrLf }", Color.Red, RichTextBox1) Return False End If db.Close() Catch ex As Exception 'MsgBox($"Sqlite入库失败！！！{vbCrLf }原因:{vbCrLf }{ex.Message }") setToolStripLabel2color($"Sqlite入库失败！！！{vbCrLf }原因:{vbCrLf }{ex.Message }", Color.Red, RichTextBox1) Return False End Try ' Return True End Using setToolStripLabel2color($"Sqlite入库成功！！！{vbCrLf }", Color.Green, RichTextBox1) Return True End Function Public DbConnString As String = "Server=blv-cloud-db.mysql.rds.aliyuncs.com;Port=3307;Database=keypresstest;Uid=blv_rcu;Pwd=fnadiaJDIJ7546;charset=utf8;" '写入mysql Private Function WriteTomysql(dic As Dictionary(Of String, String)) As Boolean Using db As New DbExecutor(DbExecutor.DbTypeEnum.Mysql, DbConnString) Try db.Open() Dim caint = db.ExecuteNonQuery(db.CmdHelper.Insert("Blv_keypresstest", dic)) If caint = 0 Then 'result = "Mysql入库失败！" 'MsgBox($"Mysql入库失败！！！{vbCrLf }") setToolStripLabel2color($"Mysql入库失败！！！", Color.Red, RichTextBox1) Return False End If db.Close() Catch ex As Exception 'result = $"Mysql入库失败！{ex.Message}" 'MsgBox($"Mysql入库失败！！！{vbCrLf }原因:{vbCrLf }{ex.Message }") setToolStripLabel2color($"Mysql入库失败！！！原因:{ex.Message }", Color.Red, RichTextBox1) Return False End Try ' End Using setToolStripLabel2color($"Mysql入库成功！！！{vbCrLf }", Color.Green, RichTextBox1) Return True End Function '写入到表格 'Private Sub WriteToTable(dic As Dictionary(Of String, String)) ' If Me.InvokeRequired = True Then ' Dim dd As New DelegateWriteToTable(AddressOf WriteToTable) ' Me.Invoke(dd, {dic}) ' Else ' Grid_table.AddItem("") ' Dim con As Integer = 0 ' Dim str As String = String.Empty ' For i = 1 To Grid_table.Cols - 1 ' str = Grid_table.Cell(0, i).Text ' If dic.ContainsKey(str) Then ' Grid_table.Cell(Grid_table.Rows - 1, i).Text = dic(str) ' Else ' con += 1 ' End If ' Next ' If dic.Item("测试结果") = "1" Then ' Grid_table.Range(Grid_table.Rows - 1, 1, Grid_table.Rows - 1, Grid_table.Cols - 1).ForeColor = Color.Green ' Grid_table.Range(Grid_table.Rows - 1, 1, Grid_table.Rows - 1, Grid_table.Cols - 1).FontBold = True ' Else ' Grid_table.Range(Grid_table.Rows - 1, 1, Grid_table.Rows - 1, Grid_table.Cols - 1).ForeColor = Color.Red ' Grid_table.Range(Grid_table.Rows - 1, 1, Grid_table.Rows - 1, Grid_table.Cols - 1).FontBold = True ' End If ' End If 'End Sub End Class