Imports System.Net Imports System.Net.Sockets Imports System.Threading Imports System.IO Imports System.Text Public Class FrmRCU #Region "子窗体_功能模块" ''' ''' C43窗体 ''' Private _addC43Form As FrmC43Function ''' ''' 红外窗体 ''' Private _addInfraredForm As FrmInfraredFunction ''' ''' RF无线窗体 ''' Private _addRFWifiForm As FrmRFFunction ''' ''' 485升级窗体 ''' Private _add485UpdateForm As Frm485Update Private tpfrm3 As TabPage Private tpfrm4 As TabPage ''' ''' 初始化各子窗体 ''' Private Sub InitTabMain() 'TabFunction.SizeMode = TabSizeMode.Fixed '隐藏TabControl的表头 'TabFunction.ItemSize = New Size(0, 1) Dim tpfrm2 As New TabPage tpfrm2.Text = $"红外功能" _addInfraredForm = New FrmInfraredFunction '红外窗体 _addInfraredForm.ShowForm(tpfrm2) TabFunction.TabPages.Add(tpfrm2) #If IsAdmin Then Dim tpfrm1 As New TabPage tpfrm1.Text = $"C43功能" _addC43Form = New FrmC43Function 'C43窗体 _addC43Form.ShowForm(tpfrm1) TabFunction.TabPages.Add(tpfrm1) tpfrm3 = New TabPage tpfrm3.Text = $"RF无线功能" _addRFWifiForm = New FrmRFFunction 'RF无线窗体 _addRFWifiForm.ShowForm(tpfrm3) TabFunction.TabPages.Add(tpfrm3) tpfrm4 = New TabPage tpfrm4.Text = $"485升级" _add485UpdateForm = New Frm485Update '485升级窗体 _add485UpdateForm.ShowForm(tpfrm4) TabFunction.TabPages.Add(tpfrm4) #End If End Sub #End Region #Region "窗体操作" #Region "全局变量" ''' ''' 枚举是否连接 ''' Enum EnConnectStatus Connect DisConnect End Enum ''' ''' 连接状态,默认非连接 ''' Public _connectStatus As EnConnectStatus = EnConnectStatus.DisConnect ''' ''' 按键连接提示文本 ''' Private _btnConnectTipText As String() = {"断开连接", "打开连接"} ''' ''' 按键连接提示颜色 ''' Private _btnConnectTipColor As Color() = {Color.Red, Color.Green} ''' ''' 按键连接启用 ''' Private _btnConnectEnable As Boolean() = {False, True} ''' ''' 模式选择 ''' Private _modeItmeData() As String = {"正常模式", "进入透传", "进入监控"} ''' ''' 串口波特率 ''' Private _baudItmeData() As String = {"9600", "14400", "19200", "38400", "56000", "57600", "115200"} ''' ''' Socket网络套接字 ''' Private _socket As Socket ''' ''' UDP通讯接收线程 ''' Private _receiveThread As Thread ''' ''' 本地端口号 ''' Private _localPort As Integer ''' ''' 总接收数据字节数 ''' Public _countRXData As Integer ''' ''' 总发送数据字节数 ''' Public _countTxData As Integer ''' ''' 端口1接收数据字节数 ''' Private _countPort1RXData As Integer ''' ''' 端口2接收数据字节数 ''' Private _countPort2RXData As Integer ''' ''' 端口3接收数据字节数 ''' Private _countPort3RXData As Integer ''' ''' 发送次数标志位 ''' Public _sendTick As Short = 2 '标志位 #End Region #Region "窗体初始化" ''' ''' 窗体加载事件 ''' ''' ''' Private Sub FrmRCU_Load(sender As Object, e As EventArgs) Handles Me.Load '添加子窗体 InitTabMain() '通讯 _lastTime = Now InitLocalIP() GetSerialPort() '窗体' ShowFormTitle() UpdataCboEnabled(_connectStatus) UpdataStaueShow() BaudModeListData() SettingControls() LblLocalIp_Click(Nothing, Nothing) 'Timer3.Interval = 1000 'Timer3.Start() End Sub ''' ''' 显示窗体名称和版本信息 ''' Private Sub ShowFormTitle() Text = $"{My.Application.Info.ProductName} {My.Application.Info.Version}" End Sub ''' ''' 设置窗体 ''' Private Sub SettingControls() CboLongIP.Text = My.Settings.CBoLongIP NudRemotePort.Value = My.Settings.NumRemotePort NudLocalPort.Value = My.Settings.NumLocalPort If CboSerialPort.Items.Contains(My.Settings.CboSerialPort) Then CboSerialPort.SelectedIndex = CboSerialPort.Items.IndexOf(My.Settings.CboSerialPort) Else If CboSerialPort.Items.Count > 0 Then CboSerialPort.SelectedIndex = 0 Else CboSerialPort.SelectedIndex = -1 End If End If If CboSerialBaud.Items.Contains(My.Settings.CboSerialBaud) Then CboSerialBaud.SelectedIndex = CboSerialBaud.Items.IndexOf(My.Settings.CboSerialBaud) Else If CboSerialBaud.Items.Count > 0 Then CboSerialBaud.SelectedIndex = 0 Else CboSerialBaud.SelectedIndex = -1 End If End If If CBoBaud.Items.Contains(My.Settings.CBoBaud) Then CBoBaud.SelectedIndex = CBoBaud.Items.IndexOf(My.Settings.CBoBaud) Else If CBoBaud.Items.Count > 0 Then CBoBaud.SelectedIndex = 0 Else CBoBaud.SelectedIndex = -1 End If End If If CboMode.Items.Contains(My.Settings.CBoMode) Then CboMode.SelectedIndex = CboMode.Items.IndexOf(My.Settings.CBoMode) Else If CboMode.Items.Count > 0 Then CboMode.SelectedIndex = 0 Else CboMode.SelectedIndex = -1 End If End If End Sub ''' ''' 下拉模式选择 ''' Private Sub BaudModeListData() CboSerialBaud.Items.Clear() CboSerialBaud.Items.AddRange(_baudItmeData.ToArray) CBoBaud.Items.Clear() CBoBaud.Items.AddRange(_baudItmeData.ToArray) CboMode.Items.Clear() CboMode.Items.AddRange(_modeItmeData.ToArray) End Sub ''' ''' RF设备电动窗帘保存信息 ''' Private Sub RFCurtains() End Sub #End Region #Region "控件变化" ''' ''' 点击连接按键,控件变化 ''' ''' ''' Private Sub BtnConnect_Click(sender As Object, e As EventArgs) Handles BtnNetworkConnect.Click UpdataConnectStatus(_connectStatus) UpdataBtnConnect(_connectStatus) UpdataCboEnabled(_connectStatus) UpdataStaueShow() End Sub ''' ''' 更新下拉框是否可用 ''' ''' Private Sub UpdataCboEnabled(status As EnConnectStatus) CboLocalIp.Enabled = _btnConnectEnable(status) NudLocalPort.Enabled = _btnConnectEnable(status) BtnRead.Enabled = False = _btnConnectEnable(status) BtnSet.Enabled = False = _btnConnectEnable(status) BtnSend.Enabled = False = _btnConnectEnable(status) BtnMonitoring.Enabled = False = _btnConnectEnable(status) End Sub ''' ''' 状态栏更新显示 ''' Private Sub UpdataStaueShow() LblLocalIp1.Text = CboLocalIp.Text LblLocalIp1.ForeColor = Color.Orange LblLocalPort1.Text = NudLocalPort.Text LblLocalPort1.ForeColor = Color.Orange LblLongIP2.Text = CboLongIP.Text LblLongIP2.ForeColor = Color.Blue LblLongPort2.Text = NudRemotePort.Value LblLongPort2.ForeColor = Color.Blue RdoStatus.Text = "无连接" RdoStatus.ForeColor = Color.Red End Sub ''' ''' 更新连接状态 ''' ''' Private Sub UpdataConnectStatus(ststus As EnConnectStatus) Dim address As IPAddress = IPAddress.Any Dim ep As IPEndPoint Dim addressString As String = CboLocalIp.Text Dim port As Integer If Integer.TryParse(NudLocalPort.Text, port) = False Then MsgBox("Port输入不合法!") _connectStatus = EnConnectStatus.DisConnect Return End If If IPAddress.TryParse(addressString, address) = False Then MsgBox("IP输入不合法!") _connectStatus = EnConnectStatus.DisConnect Return End If ep = New IPEndPoint(address, port) If _connectStatus = EnConnectStatus.DisConnect Then _isReceiving = True _socket = New Socket(AddressFamily.InterNetwork, SocketType.Dgram, ProtocolType.Udp) ''加保护机制 _socket.Bind(ep) _connectStatus = EnConnectStatus.Connect _receiveThread = New Thread(New ThreadStart(AddressOf UdpRecviveData)) _receiveThread.Start() Timer1.Interval = 2000 '单位是毫秒 Timer1.Start() Else _isReceiving = False _connectStatus = EnConnectStatus.DisConnect ''加保护机制 _socket.Shutdown(SocketShutdown.Both) _socket.Close() Timer1.Stop() '_isDownloadFile = False End If End Sub ''' ''' 更新按键显示 ''' ''' Private Sub UpdataBtnConnect(status As EnConnectStatus) BtnNetworkConnect.Text = _btnConnectTipText(status) BtnNetworkConnect.ForeColor = _btnConnectTipColor(status) End Sub ''' ''' 清空记录 ''' ''' ''' Private Sub BtnClear_Click(sender As Object, e As EventArgs) Handles BtnClear.Click RtxRecord.Clear() End Sub ''' ''' 清空端口1记录 ''' ''' ''' Private Sub BtnPort1Clear_Click(sender As Object, e As EventArgs) Handles BtnPort1Clear.Click RtxCountOne.Clear() End Sub ''' ''' 清空端口2记录 ''' ''' ''' Private Sub BtnPort2Clear_Click(sender As Object, e As EventArgs) Handles BtnPort2Clear.Click RtxCountTwo.Clear() End Sub ''' ''' 清空端口3记录 ''' ''' ''' Private Sub BtnPort3Clear_Click(sender As Object, e As EventArgs) Handles BtnPort3Clear.Click RtxCountThree.Clear() End Sub ''' ''' 重置计数 ''' ''' ''' Private Sub BtnReset_Click(sender As Object, e As EventArgs) Handles BtnReset.Click _countRXData = 0 _countTxData = 0 LblRXCount.Text = 0 LblTXCount.Text = 0 LblCountPort1TX.Text = 0 LblCountPort2TX.Text = 0 LblCountPort3TX.Text = 0 LblCountPort1RX.Text = 0 LblCountPort2RX.Text = 0 LblCountPort3RX.Text = 0 End Sub ''' ''' 停止刷新布尔值 ''' Private _stopRefresh As Boolean ''' ''' 停止刷新端口数据 ''' Private Sub StopRefresh(btn As Button) If _stopRefresh = True Then _stopRefresh = False btn.Text = "停止" ElseIf _stopRefresh = False Then _stopRefresh = True btn.Text = "开启" End If End Sub ''' ''' 各端口停止刷新纪录 ''' ''' ''' Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click StopRefresh(Button1) End Sub Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click StopRefresh(Button2) End Sub Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click StopRefresh(Button3) End Sub #End Region #End Region #Region "通讯" #Region "通讯全局变量" ''' ''' 远程IP地址 ''' Private _remoteIp As String ''' ''' 远程端口号 ''' Private _remotePort As String ''' ''' 远程IP地址和端口号 ''' Private _remoteEp As New IPEndPoint(IPAddress.Any, _localPort) ''' ''' 当前时间 ''' Private _nowTime As Date ''' ''' 最后时间 ''' Private _lastTime As Date ''' ''' 时间间隔 ''' Private _timeInterbval As TimeSpan ''' ''' 接收数据偏移量 ''' Private _recvOffset As Integer ''' ''' 接收数据缓存包 ''' Private _recvBuffer(254) As Byte ''' ''' Cmd为70模式注释 ''' Private _dataCmd70ModeNote() As String = {"透传查询当前模式为:"} ''' ''' Cmd为70模式 ''' Private _dataCmd70Mode() As String = {"正常模式", "透传模式", "监控模式"} ''' ''' Cmd为70设置回复 ''' Private _dataCmd70SetReply() As String = {"设置成功", "设置失败"} ''' ''' Cmd为70的透传回复 ''' Private _dataCmd70PassthroughReply() As String = {"透传数据正确", "透传数据有误", "透传数据超时"} ''' ''' Cmd为71的透传回复 ''' Private _dataCmd71PassthroughCommand() As String = {"透传命令上报正确", "透传命令上报有误"} ''' ''' 是否显示通讯记录数据 ''' Private _isShowLog As Boolean = True ''' ''' 是否显示通讯记录提示 ''' Public _isShowTip As Boolean = True ''' ''' 是否窗体处于关闭状态 ''' Public _isClosing As Boolean = False #End Region #Region "485串口通讯" ''' ''' 选择串口通讯 ''' ''' ''' Private Sub RdoPort_CheckedChanged(sender As Object, e As EventArgs) Handles RdoPort.CheckedChanged PnlPort.Visible = True PnlPort.BringToFront() PnlUdp.Visible = False If _isReceiving Then BtnConnect_Click(Nothing, Nothing) End Sub ''' ''' 选择UDP通讯 ''' ''' ''' Private Sub RdoRadUdp_CheckedChanged(sender As Object, e As EventArgs) Handles RdoRadUdp.CheckedChanged PnlUdp.Visible = True PnlUdp.BringToFront() PnlPort.Visible = False If SerialPort.IsOpen Then BtnSerialPortConnect_Click(Nothing, Nothing) End Sub ''' ''' 串口连接按键 ''' ''' ''' Private Sub BtnSerialPortConnect_Click(sender As Object, e As EventArgs) Handles BtnSerialPortConnect.Click If String.IsNullOrWhiteSpace(CboSerialPort.Text) Then MsgBox($"请先选择有效串口!") Exit Sub End If If String.IsNullOrWhiteSpace(CboSerialBaud.Text) Then MsgBox($"请先选择有效波特率!") Exit Sub End If If SerialPort.IsOpen Then SerialPort.Close() Timer2.Stop() CloseSerialPort() Else ConfigSerialPort() Try SerialPort.Open() OpenSerialPort() Timer2.Interval = 200 '单位是毫秒 Timer2.Start() Catch ex As Exception AppendTipText($"串口打开失败,原因:{ex.Message}" & vbCrLf, Color.Red) End Try End If End Sub ''' ''' 关闭串口 ''' Private Sub CloseSerialPort() CboSerialPort.Enabled = True CboSerialBaud.Enabled = True BtnSerialPortConnect.Text = $"打开串口" BtnSerialPortConnect.ForeColor = Color.Green End Sub ''' ''' 打开串口 ''' Private Sub OpenSerialPort() CboSerialPort.Enabled = False CboSerialPort.Enabled = False BtnSerialPortConnect.Text = $"关闭串口" BtnSerialPortConnect.ForeColor = Color.Red End Sub ''' ''' 点击下拉获取可用串口 ''' ''' ''' Private Sub CboSerialPort_DropDown(sender As Object, e As EventArgs) Handles CboSerialPort.DropDown GetSerialPort() End Sub ''' ''' 获取可用串口 ''' Private Sub GetSerialPort() Dim portNames As String() = Ports.SerialPort.GetPortNames '获得可用串口 Array.Sort(portNames) CboSerialPort.Items.Clear() CboSerialPort.Items.AddRange(portNames) End Sub ''' ''' 配置串口 ''' Private Sub ConfigSerialPort() With SerialPort .PortName = CboSerialPort.Text '串口名 .BaudRate = CInt(CboSerialBaud.Text) '波特率 .DataBits = 8 '数据位 .StopBits = Ports.StopBits.One '停止位 .Parity = Ports.Parity.None '偶校验 .RtsEnable = True .ReceivedBytesThreshold = 1 End With End Sub ''' ''' 发送485串口数据 ''' ''' ''' Private Function SendPortData(dataBuff() As Byte) Dim portData As String = ByteToString(dataBuff) Dim timeData As String Dim cutTime As String _nowTime = Now _timeInterbval = _nowTime - _lastTime _lastTime = _nowTime timeData = $"{Math.Round(_timeInterbval.TotalMilliseconds, 0)}" timeData = timeData.PadRight(6) cutTime = $"{Now:HH:mm:ss:fff}" Try SerialPort.Write(dataBuff, 0, dataBuff.Length) AppendTipText("Com-TX:", Color.Green) AppendTipText("(" & cutTime & "-", Color.Black) AppendTipText(timeData, Color.BlueViolet) AppendTipText("):", Color.Black) AppendTipText(portData & vbCrLf, Color.Green) Catch ex As Exception AppendTipText($"串口发送错误!原因:{ex.Message}" & vbCrLf, Color.Red) Return False End Try Return True End Function ''' ''' 接收485串口数据 ''' ''' ''' Public Sub SerialPort_DataReceived(sender As Object, e As Ports.SerialDataReceivedEventArgs) Handles SerialPort.DataReceived Static bytes As Integer _recvOffset = 0 Try Do bytes = SerialPort.BytesToRead If bytes <= 0 Then Exit Sub If bytes + _recvOffset >= 255 Then SerialPort.Read(_recvBuffer, _recvOffset, 255 - _recvOffset) ShowPortReceData(_recvBuffer) AnalyticalData(_recvBuffer) _recvOffset = 0 Else SerialPort.Read(_recvBuffer, _recvOffset, bytes) _recvOffset += bytes End If Thread.Sleep(10) Loop While SerialPort.BytesToRead > 0 If _recvOffset > 0 Then Dim buf(_recvOffset - 1) As Byte Array.Copy(_recvBuffer, 0, buf, 0, buf.Length) ShowPortReceData(buf) AnalyticalData(_recvBuffer) End If Catch ex As Exception AppendTipText($"串口接收数据失败,原因:{ex.Message}", Color.Red) End Try End Sub ''' ''' Byte数组转字符串 ''' ''' ''' Private Function ByteToString(data() As Byte) Dim strData As String = String.Empty For i = 0 To data.Length - 1 strData &= $" {Hex(data(i)).PadLeft(2, "0"c)}" Next Return strData End Function ''' ''' 显示串口回复数据 ''' ''' Private Sub ShowPortReceData(databuff() As Byte) Dim portData As String = ByteToString(databuff) Dim timeData As String Dim cutTime As String _nowTime = Now _timeInterbval = _nowTime - _lastTime _lastTime = _nowTime timeData = $"{Math.Round(_timeInterbval.TotalMilliseconds, 0)}" timeData = timeData.PadRight(6) cutTime = $"{Now:HH:mm:ss:fff}" AppendTipText("Com-RX:", Color.Blue) AppendTipText("(" & cutTime & "-", Color.Black) AppendTipText(timeData, Color.BlueViolet) AppendTipText("):", Color.Black) AppendTipText(portData & vbCrLf, Color.Blue) End Sub ''' ''' 解析串口数据 ''' ''' ''' Private Function AnalyticalData(databuff() As Byte) If _InfraredReceProcessing = True Then AnalyInfraredProcessingData(databuff) '红外通信处理 Else AnalyRFData(databuff) 'RF无线通信处理 AnalyRS485Data(databuff) 'RS485通信处理 AnalySerialPortUpgrade(databuff) '串口升级 End If Return True End Function #Region "解析RS485数据" ''' ''' 解析RS485数据 ''' ''' ''' Private Function AnalyRS485Data(databuff() As Byte) ''RS485 If databuff(0) = &H3 Then If databuff(2) = &H29 Then Select Case databuff(6) Case &H30 DealQueryDatabuff(databuff) Case &H29 Case &H37 Case Else Return False End Select End If End If Return True End Function ''' ''' 处理查询数据 ''' ''' ''' Private Function DealQueryDatabuff(databuff() As Byte) AppendTipText($"接收成功!" & vbCrLf, Color.Green) Return True End Function ''' ''' 解析红外处理数据 ''' ''' ''' Private Function AnalyInfraredProcessingData(databuff() As Byte) As Boolean ''红外 If databuff(0) = &H55 Then If databuff(1) = &H55 Then If databuff(2) = &HEE Then Select Case databuff(5) Case &H1 '空调控制 DealAirControlDatabuff(databuff) Case &H2 '电视控制 DealTvControlDataBuff(databuff) Case &HA3 '搜索版本 DealInfraredSearchDatabuff(databuff) Case &HA6 '下发前询问 DealInfraredPrepareDatabuff(databuff) Case &HA7 '开始下发 _isInfraredreply = True DealInfraredBurnDatabuff(databuff) Case Else Return False End Select End If End If End If Return True End Function ''' ''' 处理空调控制数据 ''' ''' ''' Private Function DealAirControlDatabuff(databuff() As Byte) As Boolean Select Case databuff(8) Case &H0 AppendTipText($"操作成功! " & vbCrLf, Color.Green) Case &H1 AppendTipText($"操作成功! " & vbCrLf, Color.Green) Case Else Return False End Select Return True End Function ''' ''' 处理电视控制数据 ''' ''' ''' Private Function DealTvControlDataBuff(databuff() As Byte) As Boolean Select Case databuff(7) Case &H1 AppendTipText($"接收成功! " & vbCrLf, Color.Green) Case Else AppendTipText($"接收失败! " & vbCrLf, Color.Red) Return False End Select Return True End Function ''' ''' 处理红外搜索数据 ''' ''' ''' Private Function DealInfraredSearchDatabuff(databuff() As Byte) As Boolean Dim Ser1 As String = databuff(8).ToString Dim Ser2 As String = databuff(9).ToString Dim Ser3 As String = databuff(10).ToString AppendTipText($"红外搜索成功! ", Color.Green) AppendTipText($"搜索版本为:{Ser1}.{Ser2}.{Ser3}" & vbCrLf, Color.Green) If _addInfraredForm.IsFVer Then _addInfraredForm.Fw_Ver = databuff(8) _addInfraredForm.IsFVer = False End If Return True End Function ''' ''' 处理红外数据 ''' ''' ''' Private Function DealInfraredPrepareDatabuff(databuff() As Byte) As Boolean Select Case databuff(8) Case &H0 _isPrepare = True AppendTipText($"红外数据下发准备就绪!" & vbCrLf, Color.Green) Case &H1 AppendTipText($"红外数据下发成功!" & vbCrLf, Color.Green) Case &H2 AppendTipText($"红外数据下发失败!" & vbCrLf, Color.Red) Return False Case Else Return False End Select Return True End Function ''' ''' 烧录过程中,处理数据 ''' ''' ''' Private Function DealInfraredBurnDatabuff(databuff() As Byte) As Boolean Select Case databuff(9) Case &H1 AppendTipText($"烧录成功,当前为第{databuff(8)}包!" & vbCrLf, Color.Green) _resend = 0 Case &H2 AppendTipText($"烧录失败,当前为第{databuff(8)}包!" & vbCrLf, Color.Red) Return False Case Else Return False End Select Return True End Function #End Region #Region "解析RF数据" ''' ''' 取设备偏移值 ''' Private _skewing As Integer ''' ''' 监控模式布尔值 ''' Private _rfMonitoring As Boolean ''' ''' 处理RF单包数据 ''' ''' ''' Private Function AnalyRFDataPacket(databuff() As Byte) As Byte() ' Dim data As New List(Of Byte) 'If _rfMonitoring = True Then ' Dim len As Integer = databuff.Length - 19 ' For index = 0 To len ' data.Add(databuff(index)) ' Next 'Else ' If databuff.Length > 4 Then ' Dim len As Integer = CInt($"{databuff(4)}") + 6 ' For index = 0 To len - 1 ' data.Add(databuff(index)) ' Next ' End If 'End If Return databuff.ToArray End Function ''' ''' 处理RF数据 ''' ''' Private Sub AnalyRFData(databuff() As Byte) If databuff.Length < 6 Then Exit Sub End If '判断RF的数据 Dim data() As Byte = AnalyRFDataPacket(databuff) 'Console.WriteLine($"数据前:{ByteToString(data.ToArray)}, 1校验值{databuff(3)}") data(3) = &H0 Dim checkSum As Byte = GetSumCheckMod(data.ToArray) 'Console.WriteLine($"数据后:{ByteToString(data.ToArray)}, 2校验值{checkSum}") If databuff(3) = checkSum Then 'Console.WriteLine($"确认为RF数据") DealRFData(databuff) 'Timer3.Stop() End If 'If _isStartTimer = True Then ' Console.WriteLine($"超时未收到数据,开启定时器{Now:HH:mm:ss:fff}") ' If InvokeRequired Then ' Invoke(New Action(Sub() ' Timer3.Interval = 10000 ' Timer3.Start() ' End Sub)) ' Else ' Timer3.Interval = 10000 ' Timer3.Start() ' End If 'End If End Sub ''' ''' 解析RF数据 ''' ''' ''' Private Function DealRFData(databuff() As Byte) As Boolean Select Case databuff(5) Case &H13 '读取RF网络 DealReadDevState(databuff) Case &H15 '读取RF设备列表 DealRFDevListData(databuff) Case &H16 '16上报数据 _addRFWifiForm.ReplyData(databuff) '回复41命令 DealRFDev16ReportData(databuff) Case &H17 '设置RF网络 DealSetDevState(databuff) Case &H1A '配对RF设备列表 _addRFWifiForm.ReplyData(databuff) '回复41命令 If _pairingModel = True Then DealPairingRFDevList(databuff) End If Case &H1B _addRFWifiForm.ReplyData(databuff) '回复41命令 If _pairingModel = True Then DealRFDevWriteInfo(databuff) End If Case &H41 '41命令 Case &H51 '51上报数据 _addRFWifiForm.ReplyData(databuff) '回复41命令 DealRFDev51ReportData(databuff) Case Else End Select Return True End Function ''' ''' 解析询问设备网络状态命令_0x13 ''' ''' Private Sub DealReadDevState(databuff() As Byte) AppendTipText($"设备总数:{databuff(7)}个, 在线设备:{databuff(8)}个, 网关地址:{databuff(9)}{vbCrLf}", Color.Green) AppendTipText($"频道1:{databuff(10)}, 频道2:{databuff(11)}, 频道3:{databuff(12)}{vbCrLf}", Color.Green) AppendTipText($"读取设备网络完成!{vbCrLf}", Color.Green) _addRFWifiForm.ReadRFWifi(databuff(9)) End Sub ''' ''' 解析读取设备列表命令_0x15 ''' ''' Private Sub DealRFDevListData(databuff() As Byte) Dim data() As Byte = AnalyRFDataPacket(databuff) If databuff(6) = &H0 Then '重置所有设备列表状态 For Each dev As DeviceListInfo In _devList.Values dev.ResetState() Next For _skewing = 7 To data.Length - 3 '设置匹配的设备列表状态 Dim devType As String = DealDevType(data(_skewing)) Dim devAddr As String = DealDevAddr(data(_skewing + 1)) Dim devState As String = DealDevState(data(_skewing + 2)) Dim devName As String = DeviceListInfo.GetDevName(devType, devAddr) Console.WriteLine($"Now: 设备名称:{devName}, 设备类型:{devType}, 设备地址:{devAddr}, 设备状态:{devState}") If _devList.ContainsKey(devName) Then _devList.Item(devName).DevState = devState Else _devList.Add(devName, New DeviceListInfo(devType, devAddr, devState)) End If _skewing += 2 Next '更新表格_全部刷新 _addRFWifiForm.RefreshDeviceList() End If AppendTipText($"读取设备列表完成!{vbCrLf}", Color.Green) End Sub ''' ''' 解析设置设备网络命令_0x017 ''' ''' Private Sub DealSetDevState(databuff() As Byte) Select Case databuff(6) Case 0 AppendTipText($"设置RF网络成功!{vbCrLf}", Color.Green) Case 1 AppendTipText($"设置RF网络失败!{vbCrLf}", Color.Red) End Select End Sub ''' ''' 解析配对设备列表命令_0x1A ''' ''' Private Sub DealPairingRFDevList(databuff() As Byte) Dim data() As Byte = AnalyRFDataPacket(databuff) Dim tmpName As String = Encoding.UTF8.GetString(databuff, 6, 16).Trim '设置匹配的设备列表状态 Dim devType As String = GetDevType(tmpName) Dim devAddr As String = DealDevAddr(data(27)) Dim devName As String = DeviceListInfo.GetDevName(devType, devAddr) Console.WriteLine($"设备机型:{tmpName}, 设备类型:{devType}, 设备地址:{devAddr}, 设备名称:{devName}") If _devList.ContainsKey(devName) = False Then _devList.Add(devName, New DeviceListInfo(devType, devAddr)) End If '更新表格_局部刷新 _addRFWifiForm.RefreshPairingDeviceList(devName, devType, devAddr) For Each key As String In _devList.Keys Console.WriteLine($"缓存表:Name{_devList(key).DevName}:Type{_devList(key).DevType},Addr:{_devList(key).DevAddr},Status:{_devList(key).DevState},Count:{_devList(key).DevControlCount}") Next AppendTipText($"配对设备信息上报!{vbCrLf}", Color.Green) End Sub ''' ''' 解析RF设备写入信息 ''' ''' Private Sub DealRFDevWriteInfo(databuff As Byte()) End Sub ''' ''' 根据配对设备型号获取设备名称 ''' ''' ''' Private Function GetDevType(devName As String) As String Select Case devName Case $"RF-CR-1808" '插卡取电 devName = $"插卡取电" Case $"RF_K9S" '开关面板 devName = $"开关面板" Case $"RF-K9S-1608" '开关面板 devName = $"开关面板" Case $"RF_VC2006" '无线语音 devName = $"无线语音" Case $"RF_KP_WKA8T" '无线温控 devName = $"无线温控" Case $"RF_RL1705" '微信锁 devName = $"微信锁" Case $"RF_EC2012" '电动窗帘 devName = $"电动窗帘" Case Else devName = $"未知{devName}" End Select Return devName End Function ''' ''' 解析设备类型 ''' ''' ''' Private Function DealDevType(data As Byte) As String Dim txtType As String Select Case data Case &H5 txtType = $"插卡取电" Case &H7 txtType = $"开关面板" Case &H8 txtType = $"无线语音" Case &H9 txtType = $"无线温控" Case &HA txtType = $"微信锁" Case &HB txtType = $"电动窗帘" Case Else txtType = $"未知设备" End Select Return txtType End Function ''' ''' 解析设备地址 ''' ''' ''' Private Function DealDevAddr(data As Byte) As String Dim txtAddr As String = $"{data}" Return txtAddr End Function ''' ''' 解析设备状态 ''' ''' ''' Private Function DealDevState(data As Byte) As String Dim txtState As String Select Case data Case &H1 txtState = $"在线" Case Else txtState = $"离线" End Select Return txtState End Function ''' ''' 解析RF设备16命令上报数据 ''' ''' ''' Private Function DealRFDev16ReportData(databuff As Byte()) Dim testValue As Integer = CInt(databuff(7)) Dim addr As String = databuff(2).ToString Select Case databuff(1) Case &H5 '插卡取电 DealInsertCardReport16(databuff) If databuff(6) = &H6 Then _addRFWifiForm.RefreshCommTest($"插卡取电", addr, $"{testValue}") AppendTipText($"插卡取电--通讯测试成功率:{testValue}% {vbCrLf}", Color.Blue) End If Case &HB '电动窗帘 DealElectricCurtainReport16(databuff) If databuff(6) = &H6 Then _addRFWifiForm.RefreshCommTest($"电动窗帘", addr, $"{testValue}") AppendTipText($"电动窗帘--通讯测试成功率:{testValue}% {vbCrLf}", Color.Blue) End If Case &H7 If databuff(6) = &H6 Then _addRFWifiForm.RefreshCommTest($"开关面板", addr, $"{testValue}") AppendTipText($"开关面板--通讯测试成功率:{testValue}% {vbCrLf}", Color.Blue) End If Case &H8 If databuff(6) = &H6 Then _addRFWifiForm.RefreshCommTest($"无线语音", addr, $"{testValue}") AppendTipText($"无线语音--通讯测试成功率:{testValue}% {vbCrLf}", Color.Blue) End If Case &H9 If databuff(6) = &H6 Then _addRFWifiForm.RefreshCommTest($"无线温控", addr, $"{testValue}") AppendTipText($"无线温控--通讯测试成功率:{testValue}% {vbCrLf}", Color.Blue) End If Case &HA If databuff(6) = &H6 Then _addRFWifiForm.RefreshCommTest($"微信锁", addr, $"{testValue}") AppendTipText($"微信锁--通讯测试成功率:{testValue}% {vbCrLf}", Color.Blue) End If Case Else End Select Return True End Function ''' ''' 插卡取电上报数据16 ''' ''' Private Sub DealInsertCardReport16(databuff As Byte()) Dim devControlInfo As String = String.Empty If databuff(6) = &H19 Then If databuff(8) = &H0 Then devControlInfo = $"当前扇区地址为: {Hex(databuff(7))}, 插卡状态:卡拔出" ElseIf databuff(8) = &H1 Then devControlInfo = $"当前扇区地址为: {Hex(databuff(7))}, 插卡状态:卡插入" End If End If AppendTipText($"{devControlInfo} {vbCrLf}", Color.Green) RefreshDevControlInfo(databuff, devControlInfo) '刷新设备列表控制信息 End Sub ''' ''' 电动窗帘上报数据16 ''' ''' Private Sub DealElectricCurtainReport16(databuff As Byte()) Dim devControlInfo As String = String.Empty If databuff(6) = &H27 Then '确认为电动窗帘上报数据 If databuff(20) = &H1 Then devControlInfo = $"窗帘打开" ElseIf databuff(20) = &H2 Then devControlInfo = $"窗帘停止" ElseIf databuff(20) = &H0 Then devControlInfo = $"窗帘关闭" End If AppendTipText($"{devControlInfo} {vbCrLf}", Color.Green) RefreshDevControlInfo(databuff, devControlInfo) '刷新设备列表控制信息 End If End Sub ''' ''' 解析RF设备51命令上报数据 ''' ''' ''' Private Function DealRFDev51ReportData(databuff As Byte()) Select Case databuff(1) Case &H5 '插卡取电 DealInsertCardReport51(databuff) Case &H7 '开关面板 DealSwitchReport51(databuff) Case &H8 '无线语音 DealWirelessVoice51(databuff) Case &H9 '无线温控 DealWirelessTempControlReport51(databuff) Case &HA '微信锁 DealWeChatLockReport51(databuff) Case Else End Select Return True End Function ''' ''' 插卡取电上报数据51 ''' ''' Private Sub DealInsertCardReport51(databuff As Byte()) _addRFWifiForm.ReplyData(databuff) '回复41命令 Dim devControlInfo As String = String.Empty If databuff(7) = &H0 Then devControlInfo = $"卡拔出" ElseIf databuff(7) = &H1 Then devControlInfo = $"卡插入" End If AppendTipText($"{devControlInfo} {vbCrLf}", Color.Green) RefreshDevControlInfo(databuff, devControlInfo) '刷新设备列表控制信息 End Sub ''' ''' 开关面板上报数据51 ''' ''' Private Sub DealSwitchReport51(databuff As Byte()) Console.WriteLine($"排查开关数据:{ByteToString(databuff)}") '数组超过界限解决_避免51 00回复命令 If databuff(4) = &H1 Then Exit Sub End If Dim keyCount As Byte = databuff(7) '当前上报的按键数 Dim keyTxt As String = KeyText(databuff) Dim devControlInfo As String = $"开关按键数: {databuff(7)} 键, {keyTxt}" 'Dim devControlInfo As String = $"开关按键数: {databuff(7)} 键, 1{LigthTipInfo(keylight1)}, 2{LigthTipInfo(keylight2)}, 3{LigthTipInfo(keylight3)}, 4{LigthTipInfo(keylight4)}, 5{LigthTipInfo(keylight5)}, 6{LigthTipInfo(keylight6)}" AppendTipText($"{devControlInfo}{vbCrLf}", Color.Green) RefreshDevControlInfo(databuff, devControlInfo) '刷新设备列表控制信息 End Sub ''' ''' 键值文本 ''' Private Function KeyText(dataBuff As Byte()) As String Dim txt As String = String.Empty Dim light1 As Byte = dataBuff(8) Dim light2 As Byte = dataBuff(9) Dim light3 As Byte = dataBuff(10) '1号按键 Dim keylight1 As Byte = light1 And 3 '2号按键 Dim keylight2 As Byte = light1 >> 2 keylight2 = keylight2 And 3 '3号按键 Dim keylight3 As Byte = light1 >> 4 keylight3 = keylight3 And 3 '4号按键 Dim keylight4 As Byte = light1 >> 6 keylight4 = keylight4 And 3 '5号按键 Dim keylight5 As Byte = light2 And 3 '6号按键 Dim keylight6 As Byte = light2 >> 2 keylight6 = keylight6 And 3 '7号按键 Dim keylight7 As Byte = light2 >> 4 keylight7 = keylight7 And 3 '8号按键 Dim keylight8 As Byte = light2 >> 6 keylight8 = keylight8 And 3 '9号按键 Dim keylight9 As Byte = light3 And 3 '10号按键 Dim keylight10 As Byte = light3 >> 2 keylight10 = keylight10 And 3 If LigthTipInfo(keylight1) IsNot Nothing Then txt = $"1号按键:{LigthTipInfo(keylight1)}" ElseIf LigthTipInfo(keylight2) IsNot Nothing Then txt = $"2号按键:{LigthTipInfo(keylight2)}" ElseIf LigthTipInfo(keylight3) IsNot Nothing Then txt = $"3号按键:{LigthTipInfo(keylight3)}" ElseIf LigthTipInfo(keylight4) IsNot Nothing Then txt = $"4号按键:{LigthTipInfo(keylight4)}" ElseIf LigthTipInfo(keylight5) IsNot Nothing Then txt = $"5号按键:{LigthTipInfo(keylight5)}" ElseIf LigthTipInfo(keylight6) IsNot Nothing Then txt = $"6号按键:{LigthTipInfo(keylight6)}" ElseIf LigthTipInfo(keylight7) IsNot Nothing Then txt = $"7号按键:{LigthTipInfo(keylight7)}" ElseIf LigthTipInfo(keylight8) IsNot Nothing Then txt = $"8号按键:{LigthTipInfo(keylight8)}" ElseIf LigthTipInfo(keylight9) IsNot Nothing Then txt = $"9号按键:{LigthTipInfo(keylight9)}" ElseIf LigthTipInfo(keylight10) IsNot Nothing Then txt = $"10号按键:{LigthTipInfo(keylight10)}" End If Return txt End Function ''' ''' 按键等提示信息 ''' ''' ''' Private Function LigthTipInfo(data As Byte) As String Dim tipText As String = String.Empty Select Case data Case &H1 tipText = $"点按" Case &H2 tipText = $"松开" Case &H3 tipText = $"长按" End Select Return tipText End Function ''' ''' 无线温控上报数据51 ''' ''' Private Sub DealWirelessTempControlReport51(databuff As Byte()) '数组超过界限解决_避免51 00回复命令 If databuff(4) = &H1 Then Exit Sub End If Dim byte1 As Byte Dim byte2 As Byte Try byte1 = databuff(7) byte2 = databuff(8) Catch ex As Exception Console.WriteLine($"温控异常:{ex.Message}") End Try 'Console.WriteLine($"两个byte:{byte1} {byte2}") '室内温度 Dim indoor As Byte = byte1 And 31 'Console.WriteLine($"室内温度:{indoor}") '室外温度 Dim out1 As Byte = byte1 >> 5 Dim out2 As Byte = byte2 And 3 out2 = out2 << 3 Dim outdoor As Byte = out2 Or out1 'Console.WriteLine($"设置温度:{outdoor}") '阀门 Dim valve As Byte = byte2 >> 2 And 1 Dim txtValve As String = String.Empty If valve = &H0 Then txtValve = $"关阀" ElseIf valve = &H1 Then txtValve = $"开阀" End If 'Console.WriteLine($"阀门:{valve}{txtValve}") '风速 Dim velocity As Byte = byte2 >> 3 And 3 Dim txtVel As String = String.Empty If velocity = &H0 Then txtVel = $"自动" ElseIf velocity = &H1 Then txtVel = $"低速" ElseIf velocity = &H2 Then txtVel = $"中速" ElseIf velocity = &H3 Then txtVel = $"高速" End If 'Console.WriteLine($"风速:{velocity}{txtVel}") '模式 Dim model As Byte = byte2 >> 5 And 3 Dim txtModel As String = String.Empty If model = &H1 Then txtModel = $"制冷" ElseIf model = &H2 Then txtModel = $"制热" ElseIf model = &H3 Then txtModel = $"送风" End If Console.WriteLine($"模式:{model}{txtModel}") '开关 Dim switch As Byte = byte2 >> 7 Dim txtSwitch As String = String.Empty If switch = &H0 Then txtSwitch = $"关机" ElseIf switch = &H1 Then txtSwitch = $"开机" End If Console.WriteLine($"开关:{switch}{txtSwitch}") Dim devControlInfo As String = $"室内温度:{indoor}, 设置温度:{outdoor}, {txtValve}, {txtVel}, {txtModel}, {txtSwitch}" AppendTipText($"{devControlInfo}{vbCrLf}", Color.Green) RefreshDevControlInfo(databuff, devControlInfo) '刷新设备列表控制信息 'For Each key As String In _devList.Keys ' Console.WriteLine($"控制信息:Name{_devList(key).DevName}:Type{_devList(key).DevType}, Addr:{_devList(key).DevAddr}, Status:{_devList(key).DevState}, 控制信息:{_devList(key).DevControlInfo}") 'Next End Sub ''' ''' 微信锁上报数据51 ''' ''' Private Sub DealWeChatLockReport51(databuff As Byte()) Dim elecH As Byte = databuff(8) Dim elecL As Byte = databuff(9) Dim elec As Short elec = elecH * 256 + elecL Dim devControlInfo As String = String.Empty If databuff(7) = &H1 Then devControlInfo = $"锁状态:开锁, 电池电量:{elec} mV" ElseIf databuff(7) = &H2 Then devControlInfo = $"锁状态:关锁, 电池电量:{elec} mV" End If AppendTipText($"{devControlInfo} {vbCrLf}", Color.Green) RefreshDevControlInfo(databuff, devControlInfo) '刷新设备列表控制信息 End Sub #Region "解析无线语音数据" ''' ''' 无线语音上报数据51 ''' ''' Private Sub DealWirelessVoice51(databuff As Byte()) Select Case databuff(11) Case &H0 '场景 WirelessVoiceScenario(databuff) Case &H1 '继电器 WirelessVoiceRelay(databuff) Case &H4 '服务客需 WirelessVoiceService(databuff) Case &H5 '窗帘窗纱 WirelessVoiceCurtainScreen(databuff) Case &H7 '空调控制 WirelessVoiceAirControl(databuff) Case &H10 '调光 WirelessVoiceDimmer(databuff) Case &H15 '背景音乐 WirelessVoiceBackgroundMusic(databuff) Case &HF '继电器_电视 WirelessVoiceRelayTV(databuff) Case &H12 '灯带 WirelessVoiceLampWith(databuff) Case Else End Select End Sub ''' ''' 无线语音_场景_类型0 ''' Private Sub WirelessVoiceScenario(databuff As Byte()) Dim txt As String = String.Empty Select Case databuff(12) Case &HE If databuff(13) = &H1 Then txt = $"打开所有灯" ElseIf databuff(13) = &H2 Then txt = $"关闭所有灯" End If Case &HC txt = $"明亮模式" Case &H2 txt = $"睡眠模式" Case &HA txt = $"温馨模式" Case &H1 txt = $"会客模式" Case &H9 txt = $"观影模式" Case &H4 txt = $"休闲模式" Case &H6 txt = $"阅读模式" Case &H15 txt = $"电视模式" Case &HF txt = $"柔和模式" Case &H8 txt = $"浪漫模式" Case Else txt = $"未识别唤醒词" End Select AppendTipText($"{txt} {vbCrLf}", Color.Green) RefreshDevControlInfo(databuff, txt) '刷新设备列表控制信息 End Sub ''' ''' 无线语音_继电器_类型1 ''' ''' Private Sub WirelessVoiceRelay(databuff As Byte()) Dim txt As String = String.Empty Select Case databuff(12) Case &H14 If databuff(13) = &H1 Then txt = $"打开淋浴灯" ElseIf databuff(13) = &H2 Then txt = $"关闭淋浴灯" End If Case &H1 If databuff(13) = &H1 Then txt = $"打开卫生间灯" ElseIf databuff(13) = &H2 Then txt = $"关闭卫生间灯" End If Case &H2 If databuff(13) = &H1 Then txt = $"打开浴室灯" ElseIf databuff(13) = &H2 Then txt = $"关闭浴室灯" End If Case &H3 If databuff(13) = &H1 Then txt = $"打开镜前灯" ElseIf databuff(13) = &H2 Then txt = $"关闭镜前灯" End If Case &H4 If databuff(13) = &H1 Then txt = $"打开排风扇" ElseIf databuff(13) = &H2 Then txt = $"关闭排风扇" End If Case &H5 If databuff(13) = &H1 Then txt = $"打开廊灯" ElseIf databuff(13) = &H2 Then txt = $"关闭廊灯" End If Case &H6 If databuff(13) = &H1 Then txt = $"打开吧台灯" ElseIf databuff(13) = &H2 Then txt = $"关闭吧台灯" End If Case &HF If databuff(13) = &H1 Then txt = $"打开筒灯" ElseIf databuff(13) = &H2 Then txt = $"关闭筒灯" End If Case &H18 If databuff(13) = &H1 Then txt = $"打开阅读灯" ElseIf databuff(13) = &H2 Then txt = $"关闭阅读灯" End If Case &H8 If databuff(13) = &H1 Then txt = $"打开左阅读" ElseIf databuff(13) = &H2 Then txt = $"关闭左阅读" End If Case &H9 If databuff(13) = &H1 Then txt = $"打开右阅读" ElseIf databuff(13) = &H2 Then txt = $"关闭右阅读" End If Case &H19 If databuff(13) = &H1 Then txt = $"打开壁灯" ElseIf databuff(13) = &H2 Then txt = $"关闭壁灯" End If Case &H1B If databuff(13) = &H1 Then txt = $"打开房灯" ElseIf databuff(13) = &H2 Then txt = $"关闭房灯" End If Case &H12 If databuff(13) = &H1 Then txt = $"打开背景灯" ElseIf databuff(13) = &H2 Then txt = $"关闭背景灯" End If Case &H13 If databuff(13) = &H1 Then txt = $"打开夜灯" ElseIf databuff(13) = &H2 Then txt = $"关闭夜灯" End If Case &H16 If databuff(13) = &H1 Then txt = $"打开阳台灯" ElseIf databuff(13) = &H2 Then txt = $"关闭阳台灯" End If Case &HA If databuff(13) = &H1 Then txt = $"打开书桌灯" ElseIf databuff(13) = &H2 Then txt = $"关闭书桌灯" End If Case Else txt = $"未识别唤醒词" End Select AppendTipText($"{txt} {vbCrLf}", Color.Green) RefreshDevControlInfo(databuff, txt) '刷新设备列表控制信息 End Sub ''' ''' 无线语音_服务客需_类型4 ''' ''' Private Sub WirelessVoiceService(databuff As Byte()) Dim txt As String = String.Empty Select Case databuff(12) Case &H1 If databuff(13) = &H1 Then txt = $"打开清理" ElseIf databuff(13) = &H2 Then txt = $"关闭清理" End If Case &H2 If databuff(13) = &H1 Then txt = $"打开勿扰" ElseIf databuff(13) = &H2 Then txt = $"关闭勿扰" End If Case &H4 txt = $"我要退房" Case &H15 txt = $"送牙刷" Case &H16 txt = $"送瓶水" Case &H6 txt = $"送双拖鞋" Case &H7 txt = $"我需要护发素" Case &H8 txt = $"我需要洗发水" Case &H9 txt = $"我需要沐浴露" Case &HB txt = $"送一块香皂" Case &HC txt = $"我需要浴帽" Case &HD txt = $"送一把梳子" Case &HF txt = $"我需要吹风机" Case &H12 txt = $"送一支笔" Case &H13 txt = $"送一套充电器数据线" Case &H14 txt = $"呼叫服务员" Case Else txt = $"未识别唤醒词" End Select AppendTipText($"{txt} {vbCrLf}", Color.Green) RefreshDevControlInfo(databuff, txt) '刷新设备列表控制信息 End Sub ''' ''' 无线语音_窗帘窗纱_类型5 ''' ''' Private Sub WirelessVoiceCurtainScreen(databuff As Byte()) Dim txt As String = String.Empty Select Case databuff(12) Case &H1 If databuff(13) = &H1 Then txt = $"打开窗帘" ElseIf databuff(13) = &H2 Then txt = $"关闭窗帘" ElseIf databuff(13) = &H6 Then txt = $"窗帘停" End If Case &H2 If databuff(13) = &H1 Then txt = $"打开窗纱" ElseIf databuff(13) = &H2 Then txt = $"关闭窗纱" ElseIf databuff(13) = &H6 Then txt = $"窗纱停" End If Case &H7 If databuff(13) = &H1 Then txt = $"打开卷帘" ElseIf databuff(13) = &H2 Then txt = $"关闭卷帘" ElseIf databuff(13) = &H6 Then txt = $"卷帘停" End If Case Else txt = $"未识别唤醒词" End Select AppendTipText($"{txt} {vbCrLf}", Color.Green) RefreshDevControlInfo(databuff, txt) '刷新设备列表控制信息 End Sub ''' ''' 无线语音_空调控制_类型7 ''' ''' Private Sub WirelessVoiceAirControl(databuff As Byte()) Dim txt As String = String.Empty Select Case databuff(13) Case &H0 WirelessVoiceAirControl0x00(databuff) Case &H21 txt = $"温度调高" Case &HF txt = $"温度调低" Case &H10 txt = $"十六度" Case &H11 txt = $"十七度" Case &H12 txt = $"十八度" Case &H13 txt = $"十九度" Case &H14 txt = $"二十度" Case &H15 txt = $"二十一度" Case &H16 txt = $"二十二度" Case &H17 txt = $"二十三度" Case &H18 txt = $"二十四度" Case &H19 txt = $"二十五度" Case &H1A txt = $"二十六度" Case &H1B txt = $"二十七度" Case &H1C txt = $"二十八度" Case &H1D txt = $"二十九度" Case &H1E txt = $"三十度" Case &H22 txt = $"风速调大" Case &HE txt = $"风速调小" Case Else txt = $"未识别唤醒词" End Select AppendTipText($"{txt} {vbCrLf}", Color.Green) RefreshDevControlInfo(databuff, txt) '刷新设备列表控制信息 End Sub ''' ''' 无线语音_空调控制_类型7_0x00 ''' ''' Private Sub WirelessVoiceAirControl0x00(databuff As Byte()) Dim txt As String = String.Empty Select Case databuff(14) Case &H40 txt = $"打开空调" Case &H80 txt = $"关闭空调" Case &H4 txt = $"低风速" Case &H8 txt = $"中风速" Case &HC txt = $"高风速" Case &H0 txt = $"自动风速" Case &H10 txt = $"制冷模式" Case &H20 txt = $"制热模式" Case &H30 txt = $"送风模式" End Select AppendTipText($"{txt} {vbCrLf}", Color.Green) RefreshDevControlInfo(databuff, txt) '刷新设备列表控制信息 End Sub ''' ''' 无线语音_背景音乐_类型15 ''' ''' Private Sub WirelessVoiceBackgroundMusic(databuff As Byte()) Dim txt As String = String.Empty Select Case databuff(13) Case &H0 If databuff(14) = &H2 Then txt = $"关闭背景音乐" End If Case &H1 Select Case databuff(14) Case &H1 txt = $"打开背景音乐" Case &H2 txt = $"音乐暂停" Case &H3 txt = $"上一首" Case &H4 txt = $"下一首" Case &H5 txt = $"音量调大" Case &HA0 txt = $"音量最大" Case &H6 txt = $"音量调小" Case &H10 txt = $"音量最小" End Select Case Else txt = $"未识别唤醒词" End Select AppendTipText($"{txt} {vbCrLf}", Color.Green) RefreshDevControlInfo(databuff, txt) '刷新设备列表控制信息 End Sub ''' ''' 无线语音_调光_类型10 ''' ''' Private Sub WirelessVoiceDimmer(databuff As Byte()) Dim txt As String = String.Empty Select Case databuff(12) Case &H1F Select Case databuff(13) Case &HA txt = $"灯光调亮" Case &H1 txt = $"灯光最亮" Case &HB txt = $"灯光调暗" Case &H2 txt = $"灯光最暗" End Select Case &H18 If databuff(13) = &HB Then txt = $"阅读灯调暗" ElseIf databuff(13) = &HA Then txt = $"阅读灯调亮" End If Case Else txt = $"未识别唤醒词" End Select AppendTipText($"{txt} {vbCrLf}", Color.Green) RefreshDevControlInfo(databuff, txt) '刷新设备列表控制信息 End Sub ''' ''' 无线语音_继电器_电视_类型F ''' ''' Private Sub WirelessVoiceRelayTV(databuff As Byte()) Dim txt As String = String.Empty If databuff(13) = &H1 Then txt = $"打开电视" ElseIf databuff(13) = &H2 Then txt = $"关闭电视" End If AppendTipText($"{txt} {vbCrLf}", Color.Green) RefreshDevControlInfo(databuff, txt) '刷新设备列表控制信息 End Sub ''' ''' 无线语音_灯带_类型12 ''' ''' Private Sub WirelessVoiceLampWith(databuff As Byte()) Dim txt As String = String.Empty Select Case databuff(12) Case &H4 If databuff(13) = &H1 Then txt = $"打开灯带" ElseIf databuff(13) = &H2 Then txt = $"关闭灯带" End If Case &HA If databuff(13) = &H1 Then txt = $"打开卫生间灯带" ElseIf databuff(13) = &H2 Then txt = $"关闭卫生间灯带" End If Case Else txt = $"未识别唤醒词" End Select AppendTipText($"{txt} {vbCrLf}", Color.Green) RefreshDevControlInfo(databuff, txt) '刷新设备列表控制信息 End Sub #End Region ''' ''' 刷新设备列表控制信息 ''' ''' ''' Private Sub RefreshDevControlInfo(databuff() As Byte, Controltxt As String) Dim devType As String = DealDevType(databuff(1)) Dim devAddr As String = DealDevAddr(databuff(2)) Dim devName As String = DeviceListInfo.GetDevName(devType, devAddr) If _devList.ContainsKey(devName) Then _devList.Item(devName).DevControlInfo = Controltxt End If '更新表格_局部刷新 _addRFWifiForm.RefreshDevListControl(devType, devAddr) End Sub #End Region #Region "解析串口升级" Private Sub AnalySerialPortUpgrade(databuff() As Byte) If databuff(1) = &H11 OrElse databuff(1) = &H12 OrElse databuff(1) = &H70 OrElse databuff(1) = &H71 OrElse databuff(1) = &H72 OrElse databuff(1) = &H73 OrElse databuff(1) = &H74 OrElse databuff(1) = &H75 OrElse databuff(1) = &H76 OrElse databuff(1) = &H77 OrElse databuff(1) = &H78 OrElse databuff(1) = &H79 OrElse databuff(1) = &H90 OrElse databuff(1) = &H91 Then Select Case databuff(1) Case &H11 '搜索_App区 DealSerialPortCmd11(databuff) Case &H12 '跳转_App区 DealSerialPortCmd12(databuff) Case &H70 '写入Flash数据 DealSerialPortCmd70(databuff) Case &H71 '读出Flash数据 Case &H72 '擦除Flash DealSerialPortCmd72(databuff) Case &H73 '搜索_Boot区 DealSerialPortCmd73(databuff) Case &H74 '写入EEPROM Case &H75 '读出EEPROM Case &H76 '擦除EEPROM Case &H77 '校验Flash DealSerialPortCmd77(databuff) Case &H78 '跳转_Boot区 DealSerialPortCmd78(databuff) Case &H79 '设置参数 DealSerialPortCmd79(databuff) Case &H90 '读取特征区域数据 Case &H91 '写入特征区域 Case Else End Select End If End Sub ''' ''' 是否是C1设备 ''' Public _isDeviceC1 As Boolean ''' ''' 搜索_App区 ''' ''' Private Sub DealSerialPortCmd11(databuff() As Byte) Dim devAddr As Byte Dim data(15) As Byte If _isDeviceC1 = True Then devAddr = databuff(5) 'databuff(5) 485地址 Array.Copy(databuff, 10, data, 0, data.Length - 1) Else devAddr = databuff(4) 'databuff(4) 485地址 Array.Copy(databuff, 9, data, 0, data.Length - 1) End If '重置所有设备列表状态 For Each dev As UpdateDeviceInfo In _upgradeDevList.Values dev.UpgradeResult() Next '设置匹配的设备列表状态 Dim devPartition As String = $"App" Dim devName As String = Encoding.UTF8.GetString(data) Console.WriteLine($"缓存区-App: 设备名称:{devName}, 设备地址:{devAddr}, 设备分区:{devPartition}") If _upgradeDevList.ContainsKey(devAddr) Then _upgradeDevList.Item(devAddr).DevResult = $"准备升级..." Else _upgradeDevList.Add(devAddr, New UpdateDeviceInfo(devAddr, devPartition, devName)) End If '更新表格_全部刷新 _add485UpdateForm.SearchPartition() End Sub ''' ''' 搜索_Boot区 ''' ''' Private Sub DealSerialPortCmd73(databuff() As Byte) Dim devAddr As Byte Dim data(15) As Byte If _isDeviceC1 = True Then devAddr = databuff(5) 'databuff(5) 485地址 Array.Copy(databuff, 10, data, 0, data.Length - 1) Else devAddr = databuff(4) 'databuff(4) 485地址 Array.Copy(databuff, 9, data, 0, data.Length - 1) End If '重置所有设备列表状态 For Each dev As UpdateDeviceInfo In _upgradeDevList.Values dev.UpgradeResult() Next '设置匹配的设备列表状态 Dim devPartition As String = $"Boot" Dim devName As String = Encoding.UTF8.GetString(data) Console.WriteLine($"缓存区-Boot: 设备名称:{devName}, 设备地址:{devAddr}, 设备分区:{devPartition}") If _upgradeDevList.ContainsKey(devAddr) Then _upgradeDevList.Item(devAddr).DevResult = $"准备升级..." Else _upgradeDevList.Add(devAddr, New UpdateDeviceInfo(devAddr, devPartition, devName)) End If '更新表格_全部刷新 _add485UpdateForm.SearchPartition() End Sub ''' ''' 跳转_App区 ''' ''' Private Sub DealSerialPortCmd12(databuff() As Byte) If _isDeviceC1 = True Then Console.WriteLine($"跳转_App区-485地址: {databuff(5)}") Else Console.WriteLine($"跳转_App区-485地址: {databuff(4)}") End If End Sub ''' ''' 写入Flash数据 ''' ''' Private Sub DealSerialPortCmd70(databuff() As Byte) If _isDeviceC1 = True Then Console.WriteLine($"写入Flash数据-485地址: {databuff(5)}") Else Console.WriteLine($"写入Flash数据-485地址: {databuff(4)}") End If End Sub ''' ''' 擦除Flash ''' ''' Private Sub DealSerialPortCmd72(databuff() As Byte) If _isDeviceC1 = True Then Console.WriteLine($"擦除Flash-485地址: {databuff(5)}") Else Console.WriteLine($"擦除Flash-485地址: {databuff(4)}") End If End Sub ''' ''' 校验Flash ''' ''' Private Sub DealSerialPortCmd77(databuff() As Byte) If _isDeviceC1 = True Then Console.WriteLine($"校验Flash-485地址: {databuff(5)}") GetFlashCheckResult(databuff(5)) Else Console.WriteLine($"校验Flash-485地址: {databuff(4)}") GetFlashCheckResult(databuff(4)) End If End Sub ''' ''' 获取Flash校验结果 ''' ''' Private Sub GetFlashCheckResult(result As Byte) If result = &H1 Then '校验成功 Console.WriteLine($"校验Flash成功!") ElseIf result = &H0 Then '校验失败 Console.WriteLine($"校验Flash失败!") End If End Sub ''' ''' 跳转_Boot区 ''' ''' Private Sub DealSerialPortCmd78(databuff() As Byte) If _isDeviceC1 = True Then Console.WriteLine($"跳转_Boot区-485地址: {databuff(5)}") Else Console.WriteLine($"跳转_Boot区-485地址: {databuff(4)}") End If End Sub ''' ''' 设置参数 ''' ''' Private Sub DealSerialPortCmd79(databuff() As Byte) If _isDeviceC1 = True Then Console.WriteLine($"设置参数-485地址: {databuff(5)}") Else Console.WriteLine($"设置参数-485地址: {databuff(4)}") End If End Sub #End Region #End Region #Region "网络通讯—UDP" ''' ''' 初始化本地IP ''' Private Sub InitLocalIP() CboLocalIp.Items.Clear() CboLocalIp.Items.AddRange(GetLocalIp().ToArray) If CboLocalIp.Items.Count > 0 Then CboLocalIp.SelectedIndex = 0 End Sub ''' ''' 获取本地可用IP ''' ''' Private Function GetLocalIp() As List(Of IPAddress) Dim address() As IPAddress Dim destAddress As New List(Of IPAddress) address = Dns.GetHostEntry(Dns.GetHostName()).AddressList For Each pAddress As IPAddress In address If pAddress.AddressFamily = AddressFamily.InterNetwork Then destAddress.Add(pAddress) End If Next Return destAddress End Function ''' ''' 显示UDP接收数据 ''' ''' ''' Private Sub ShowReceiveData(ByRef dataBuff() As Byte, ByVal length As Short) Dim strData As String = String.Empty Dim timeData As String Dim cutTime As String _nowTime = Now _timeInterbval = _nowTime - _lastTime _lastTime = _nowTime timeData = $"{Math.Round(_timeInterbval.TotalMilliseconds, 0)}" timeData = timeData.PadRight(6) cutTime = $"{Now:HH:mm:ss:fff}" '显示收到的数据 For i = 0 To length - 1 strData &= $" {Hex(dataBuff(i)).PadLeft(2, "0"c)}" Next AppendTipText("UDP-RX:", Color.Blue) AppendTipText("(" & cutTime & "-", Color.Black) AppendTipText(timeData, Color.BlueViolet) AppendTipText("):", Color.Black) AppendTipText(strData & vbCrLf, Color.Blue) End Sub ''' ''' 更新发送数据 ''' ''' Private Sub UpdateSendData(sendPacket() As Byte) Dim strData As String = String.Empty Dim timeData As String Dim cutTime As String _nowTime = Now _timeInterbval = _nowTime - _lastTime _lastTime = _nowTime timeData = $"{Math.Round(_timeInterbval.TotalMilliseconds, 0)}" timeData = timeData.PadRight(6) cutTime = $"{Now:HH:mm:ss:fff}" For i = 0 To sendPacket.Length - 1 strData &= $" {Hex(sendPacket(i)).PadLeft(2, "0"c)}" Next AppendTipText("UDP-TX:", Color.Green) AppendTipText("(" & cutTime & "-", Color.Black) AppendTipText(timeData, Color.BlueViolet) AppendTipText("):", Color.Black) AppendTipText(strData & vbCrLf, Color.Green) End Sub ''' ''' UDP接收数据 ''' Private Sub UdpRecviveData() Dim ep As New IPEndPoint(IPAddress.Any, _localPort) Dim recvLength As Integer Dim recvBuffer(1024) As Byte While _connectStatus = EnConnectStatus.Connect Try recvLength = _socket.ReceiveFrom(recvBuffer, ep) _countRXData += recvLength Catch ex As Exception Console.WriteLine($"Udp Recv Error:{ex.Message}") Return End Try ReceivingDataProcessing(recvBuffer, recvLength) End While End Sub ''' ''' 发送UDP数据 ''' ''' Private Sub SendUDPData(sendPacket As Byte()) Dim portSocket As Integer 'Dim addressString As String = CboLongIP.Text Dim address As IPAddress = IPAddress.Any Dim remoteEp As New IPEndPoint(IPAddress.Any, _localPort) If Integer.TryParse(NudRemotePort.Text, portSocket) = False Then MsgBox("远程Port输入不合法!") End If If IPAddress.TryParse(CboLongIP.Text, address) = False Then MsgBox("IP输入不合法!") End If remoteEp.Address = address remoteEp.Port = portSocket _socket.SendTo(sendPacket, remoteEp) End Sub #End Region #Region "数据组包" ''' ''' 显示端口信息 ''' ''' Private Sub ShowPortData(data As Byte()) Dim rcBoxCount() As RichTextBox = {RtxCountOne, RtxCountTwo, RtxCountThree} Dim LblCountPort() As Label = {LblCountPort1TX, LblCountPort2TX, LblCountPort3TX} Dim index As Integer Dim rCIndex() As Byte = {&H1, &H2, &H3} Dim timeData As String Dim cutTime As String index = data(1) If data(1) = rCIndex(index - 1) AndAlso data(1) <= 3 Then Dim countPort As String countPort = BitConverter.ToString(data) Dim strCountPort As String = countPort.Replace("-", " ") With rcBoxCount(index - 1) timeData = $"{Math.Round(_timeInterbval.TotalMilliseconds, 0)}" cutTime = $"{Now:HH:mm:ss:fff}" If index = 1 Then AppendTipTextOne("TX:", Color.Green) AppendTipTextOne("(" & cutTime & "-", Color.Black) AppendTipTextOne(timeData, Color.BlueViolet) AppendTipTextOne("): ", Color.Black) AppendTipTextOne(strCountPort & vbCrLf, Color.Blue) ElseIf index = 2 Then AppendTipTextTwo("TX:", Color.Green) AppendTipTextTwo("(" & cutTime & "-", Color.Black) AppendTipTextTwo(timeData, Color.BlueViolet) AppendTipTextTwo("): ", Color.Black) AppendTipTextTwo(strCountPort & vbCrLf, Color.Blue) ElseIf index = 3 Then AppendTipTextThree("TX:", Color.Green) AppendTipTextThree("(" & cutTime & "-", Color.Black) AppendTipTextThree(timeData, Color.BlueViolet) AppendTipTextThree("): ", Color.Black) AppendTipTextThree(strCountPort & vbCrLf, Color.Blue) End If End With LblCountPort(index - 1).Text += data.Length End If End Sub ''' ''' SendUDPData限制 ''' 超过1024字节自动清空 ''' ''' ''' Private Sub TBoxSendSerialApp_TextChanged(sender As Object, e As EventArgs) Handles TxtSendSerialApp.TextChanged If Len(TxtSendSerialApp.Text) <= 1024 Then Else MsgBox("输入数据超出1024最大限制") Return End If End Sub ''' ''' 字节数求和 ''' ''' Private Sub CountBytesSum(sendPacket As Byte()) _countTxData += sendPacket.Length LblTXCount.Text = _countTxData End Sub ''' ''' 定时器每隔5S发送一包数据 ''' ''' ''' Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick If _sendTick >= 2 Then _sendTick = 2 'Console.WriteLine($"Send Time:{Now:HH:mm:ss}") Else _sendTick += 1 Return End If '获取发送内容Data部分 Dim serialCmd As Byte = &H1 Dim port485 As Byte = $"&H{Hex(NudSerialPort.Value)}" Dim data(1) As Byte data(0) = serialCmd data(1) = port485 Dim sendPacket() As Byte = FillSendDataPacket(data) Try If _isClosing = False Then SendUDPData(sendPacket) CountBytesSum(sendPacket) End If Catch ex As Exception Return End Try If ChkShowHeartBeat.Checked = False Then UpdateSendData(sendPacket) '更新记录 End Sub ''' ''' 读取操作 --- PC->RCU主机 ''' ''' ''' Private Sub BtnRead_Click(sender As Object, e As EventArgs) Handles BtnRead.Click _sendTick = 0 '获取发送内容Data部分 Dim serialCmd As Byte = &H1 Dim port485 As Byte = $"&H{Hex(NudSerialPort.Value)}" Dim data(1) As Byte data(0) = serialCmd data(1) = port485 '组合发送数据 Dim sendPacket() As Byte = FillSendDataPacket(data) SendUDPData(sendPacket) '发送 CountBytesSum(sendPacket) '计数 UpdateSendData(sendPacket) '更新记录 End Sub ''' ''' 设置操作 --- PC->RCU主机 ''' ''' ''' Private Sub BtnSet_Click(sender As Object, e As EventArgs) Handles BtnSet.Click _rfMonitoring = True _sendTick = 0 '获取Set发送内容Data部分 Dim serialCmd As Byte = &H2 Dim port485 As Byte = $"&H{Hex(NudSetPort.Value)}" Dim timeOut As Byte = $"&H{Hex(NudTimeOut1.Value)}" Dim setbaud As Byte Dim serialCont As Byte If CBoBaud.Text = Nothing Then MsgBox("请输入波特率!") Return Else setbaud = $"&H{Hex(CBoBaud.SelectedIndex + 1)}" End If If CboMode.Text = Nothing Then MsgBox("请输入模式!") Return Else serialCont = $"&H{Hex(CboMode.SelectedIndex + 1)}" End If Dim data(4) As Byte data(0) = serialCmd data(1) = port485 data(2) = setbaud data(3) = timeOut data(4) = serialCont Dim sendPacket() As Byte = FillSendDataPacket(data) '组合发送数据 SendUDPData(sendPacket) '发送 CountBytesSum(sendPacket) '计数 UpdateSendData(sendPacket) '更新记录 End Sub ''' ''' 监控模式 --- PC->RCU主机 ''' ''' ''' Private Sub BtnMonitoring_Click(sender As Object, e As EventArgs) Handles BtnMonitoring.Click _rfMonitoring = True _sendTick = 0 Dim serialCmd As Byte = &H2 Dim port485 As Byte = $"&H{Hex(NudMonitoring.Value)}" Dim timeOut As Byte = $"&H{Hex(NudTimeOut2.Value)}" Dim setbaud As Byte = &H1 Dim serialCont As Byte = &H3 Dim data(4) As Byte data(0) = serialCmd data(1) = port485 data(2) = setbaud data(3) = timeOut data(4) = serialCont Dim sendPacket() As Byte = FillSendDataPacket(data) '组合发送数据 SendUDPData(sendPacket) '发送 CountBytesSum(sendPacket) '计数 UpdateSendData(sendPacket) '更新记录 ShowPortData(data) '显示端口数据 End Sub ''' ''' 发送操作 --- PC->RCU主机 ''' ''' ''' Private Sub BtnSend_Click(sender As Object, e As EventArgs) Handles BtnSend.Click _sendTick = 0 '获取Set发送内容Data部分 Dim serialCmd As Byte = &H3 Dim port485 As Byte = $"&H{Hex(NudSerialAppPort.Value)}" Dim timeOut As Byte = $"&H{Hex(NudTimeOut3.Value)}" Dim serialAppN() As Byte '获取发送数据Head部分 If String.IsNullOrWhiteSpace(TxtSendSerialApp.Text) = True Then MessageBox.Show("请先输入要发送的内容!") Return Else '透传数据 serialAppN = CuttingSendData(TxtSendSerialApp.Text) End If Dim dataLen As Integer = serialAppN.Length + 3 Dim data(dataLen - 1) As Byte data(0) = serialCmd data(1) = port485 data(2) = timeOut Array.Copy(serialAppN, 0, data, 3, serialAppN.Length) Dim sendPacket() As Byte = FillSendDataPacket(data) '组合发送数据 SendUDPData(sendPacket) '发送 CountBytesSum(sendPacket) '计数 UpdateSendData(sendPacket) '更新记录 ShowPortData(data) '显示端口数据 End Sub ''' ''' 发送数据设置 ''' ''' Public Function CuttingSendData(sourceData As String) Dim newData() As String '新的字符串数据_字符串数组 Dim newArraylen As Integer '新数组长度 newData = sourceData.Split(" ") '空格为分割的标志 Console.WriteLine("分几块数据:" & newData.Length) newArraylen = newData.Length Dim hexData(newArraylen - 1) As Byte Dim tmpCnt As Integer = 0 Try For i = 0 To newData.Length - 1 If newData(i) <> "" Then hexData(tmpCnt) = $"&H{newData(i)}" 'hexData(tmpCnt) = $"&H{Hex(newData(i))}" Console.WriteLine($"要发送的数据" & hexData(tmpCnt)) tmpCnt += 1 End If Next Catch ex As Exception MsgBox("数据输入格式有误") End Try Return hexData End Function #End Region #Region "数据处理" ''' ''' 接收数据处理 ''' ''' ''' Private Sub ReceivingDataProcessing(recvBuffer() As Byte, recvLength As Integer) Dim startIndex As Integer '定义一个开始的计数值 Dim packetLength As Integer '定义包的长度 While startIndex < recvLength '判断计数值是否小于总包长 If recvBuffer(startIndex) = _fixedHead(0) AndAlso recvBuffer(startIndex + 1) = _fixedHead(1) Then ' 判断包头是否等于AA55 If recvBuffer(startIndex + 4) = _fixeSystemId(0) AndAlso '判断第4,5,6,7位是否等于固定值 recvBuffer(startIndex + 5) = _fixeSystemId(1) AndAlso recvBuffer(startIndex + 6) = _fixeSystemId(2) AndAlso recvBuffer(startIndex + 7) = _fixeSystemId(3) Then packetLength = recvBuffer(startIndex + 2) + recvBuffer(startIndex + 3) * 256 '赋值包长 If packetLength + startIndex <= recvLength Then '判断包长 + 计数值是否小于等于总包长 Dim packetData(packetLength - 1) As Byte '定义一个新数据包数组 Array.Copy(recvBuffer, startIndex, packetData, 0, packetLength) '复制数组 +5个重载 If CheckCRC16Sucess(packetData, packetData.Length) Then '判断CRC16校验是否通过 '显示数据 DealData(packetData, packetData.Length) '分部处理数据(显示文字提示) startIndex += packetData.Length '计数值更新 Else ShowReceiveData(packetData, packetData.Length) AppendTipText($"CRC16校验失败!{vbNewLine}", Color.Red) Exit While End If Else ShowReceiveData(recvBuffer, recvBuffer.Length) AppendTipText($"数据包长校验失败!{vbNewLine}", Color.Red) Exit While End If Else ShowReceiveData(recvBuffer, recvBuffer.Length) AppendTipText($"数据校验失败!{vbNewLine}", Color.Red) Exit While End If Else ShowReceiveData(recvBuffer, recvBuffer.Length) AppendTipText($"非RCU主机发送的数据!{vbNewLine}", Color.Red) Exit While End If End While End Sub ''' ''' 改变状态委托 ''' ''' 文本 ''' 文本颜色 Delegate Sub delegate_State_Change(ByRef fontTxt As String, ByVal fontCol As Color) ''' ''' 改变状态委托 ''' ''' ''' Private Sub ChangeStateDelegate(ByRef fontTxt As String, ByVal fontCol As Color) If Me.InvokeRequired = True Then Dim dd As New delegate_State_Change(AddressOf ChangeStateDelegate) Me.Invoke(dd, New Object() {fontTxt, fontCol}) Else '改变状态控件的文本与颜色 If _isClosing Then Return If _isShowTip = False Then Return If _connectStatus = EnConnectStatus.Connect Then Dim txtMode As String = RdoStatus.Text RdoStatus.Text = fontTxt RdoStatus.ForeColor = fontCol 'AppendTipText($"{fontTxt}", fontCol) Else RdoStatus.Text = $"无连接" RdoStatus.ForeColor = Color.Red End If End If End Sub ''' ''' 检验CRC16成功 ''' ''' ''' ''' Private Function CheckCRC16Sucess(dataBuff() As Byte, length As Integer) As Boolean Dim crcBytes() As Byte = GetCRC16CheckSum(dataBuff, length - 2) If crcBytes(0) <> dataBuff(length - 2) OrElse crcBytes(1) <> dataBuff(length - 1) Then Return False Return True End Function ''' ''' 获取CRC16校验和 ''' ''' 数据 ''' 数据长度 ''' Private Function GetCRC16CheckSum(dataBuff() As Byte, length As Integer) As Byte() Dim crc16 As UInteger Dim crcBytes() As Byte crc16 = &HFFFF For i = 0 To length - 1 crc16 = crc16 And &HFFFF crc16 = crc16 Xor dataBuff(i) For bit = 0 To 7 crc16 = IIf((crc16 And 1) = 0, crc16 >> 1, (crc16 >> 1) Xor &HA001) Next Next crc16 = crc16 And &HFFFF crcBytes = BitConverter.GetBytes(UShort.Parse(crc16)) Return crcBytes End Function ''' ''' 获取CRC16校验和 ''' ''' 数据 ''' Private Function GetCRC16CheckSum(buff() As Byte) As Byte() Dim crc16 As Long Dim crcBytes() As Byte crc16 = &HFFFF& For i = 0 To buff.Length - 1 crc16 &= &HFFFF& Xor buff(i) For bit = 0 To 7 crc16 = IIf(crc16 And 1, crc16 >> 1, (crc16 >> 1) Xor &HA001) Next Next crc16 &= &HFFFF& crcBytes = BitConverter.GetBytes(crc16) Return crcBytes End Function ''' ''' 处理数据 ''' ''' ''' ''' Private Function DealData(dataBuff() As Byte, length As Integer) As Boolean Select Case dataBuff(8) Case &H70 DealDataForCmd70(dataBuff) Case &H71 DealRestoreData(dataBuff) '还原数据 ParseInfraredThroughData(dataBuff) DealDataForCmd71(dataBuff) End Select Return True End Function ''' ''' 处理Cmd为70的命令 ''' ''' ''' Private Function DealDataForCmd70(dataBuff() As Byte) As Boolean Select Case dataBuff(15) Case &H1 DealingWithFunctionsOfOneState(dataBuff) If ChkShowHeartBeat.Checked = True Then If _sendTick = 0 Then ShowReceiveData(dataBuff, dataBuff.Length) DealingWithFunctionsOfOne(dataBuff) Else Return False End If ElseIf ChkShowHeartBeat.Checked = False Then ShowReceiveData(dataBuff, dataBuff.Length) DealingWithFunctionsOfOne(dataBuff) End If Case &H2 ShowReceiveData(dataBuff, dataBuff.Length) DealingWithFunctionsOfTwo(dataBuff) Case &H3 ShowReceiveData(dataBuff, dataBuff.Length) DealingWithFunctionsOfThree(dataBuff) Case Else Return False End Select Return True End Function ''' ''' 处理dataBuff(15)为1的状态 ''' ''' ''' Private Function DealingWithFunctionsOfOneState(dataBuff() As Byte) As Boolean Select Case dataBuff(16) Case &H1 ChangeStateDelegate(_dataCmd70Mode(0) & vbCrLf, Color.Green) Case &H2 ChangeStateDelegate(_dataCmd70Mode(1) & vbCrLf, Color.Green) Case &H3 ChangeStateDelegate(_dataCmd70Mode(2) & vbCrLf, Color.Green) Case Else Return False End Select Return True End Function ''' ''' 处理dataBuff(15)为1的文本注释信息 ''' ''' ''' Private Function DealingWithFunctionsOfOne(dataBuff() As Byte) As Boolean Select Case dataBuff(16) Case &H1 AppendTipText(_dataCmd70ModeNote(0), Color.Green) AppendTipText(_dataCmd70Mode(0) & vbCrLf, Color.Green) Case &H2 AppendTipText(_dataCmd70ModeNote(0), Color.Green) AppendTipText(_dataCmd70Mode(1) & vbCrLf, Color.Green) Case &H3 AppendTipText(_dataCmd70ModeNote(0), Color.Green) AppendTipText(_dataCmd70Mode(2) & vbCrLf, Color.Green) Case Else Return False End Select Return True End Function ''' ''' 处理dataBuff(15)为2的状态 ''' ''' ''' Private Function DealingWithFunctionsOfTwo(dataBuff() As Byte) As Boolean Select Case dataBuff(16) Case &H1 AppendTipText(_dataCmd70SetReply(0) & vbCrLf, Color.Green) Case &H2 AppendTipText(_dataCmd70SetReply(1) & vbCrLf, Color.Green) Case Else Return False End Select Return True End Function ''' ''' 处理dataBuff(15)为3的状态 ''' ''' ''' Private Function DealingWithFunctionsOfThree(dataBuff() As Byte) As Boolean Select Case dataBuff(16) Case &H1 AppendTipText(_dataCmd70PassthroughReply(0) & vbCrLf, Color.Green) Case &H2 AppendTipText(_dataCmd70PassthroughReply(1) & vbCrLf, Color.Green) Case &H3 AppendTipText(_dataCmd70PassthroughReply(2) & vbCrLf, Color.Green) Case Else Return False End Select Return True End Function ''' ''' 处理Cmd为71的数据 ''' ''' ''' Private Function DealDataForCmd71(dataBuff() As Byte) As Boolean ShowReceiveData(dataBuff, dataBuff.Length) DealDataForCmd71Port(dataBuff) 'ParseThroughData(dataBuff) Return True End Function ''' ''' 处理Cmd为71的端口数据_1、2、3端口 ''' ''' Private Sub DealDataForCmd71Port(databuff() As Byte) Dim strData As String = String.Empty Dim timeData As String Dim cutTime As String _nowTime = Now _timeInterbval = _nowTime - _lastTime _lastTime = _nowTime timeData = $"{Math.Round(_timeInterbval.TotalMilliseconds, 0)}" cutTime = $"{Now:HH:mm:ss:fff}" '从18位开始取,strData为设备数据 For i = 17 To databuff.Length - 3 strData &= $" {Hex(databuff(i)).PadLeft(2, "0"c)}" Next If _stopRefresh = False Then Select Case databuff(15) Case &H1 AppendTipText(_dataCmd71PassthroughCommand(0) & vbCrLf, Color.Green) AppendTipTextOne("UDP-RX:", Color.Red) AppendTipTextOne("(" & cutTime & "-", Color.Black) AppendTipTextOne(timeData, Color.BlueViolet) AppendTipTextOne("):", Color.Black) AppendTipTextOne(strData & vbCrLf, Color.Blue) _countPort1RXData += strData.Length Case &H2 AppendTipText(_dataCmd71PassthroughCommand(1) & vbCrLf, Color.Green) AppendTipTextTwo("UDP-RX:", Color.Red) AppendTipTextTwo("(" & cutTime & "-", Color.Black) AppendTipTextTwo(timeData, Color.BlueViolet) AppendTipTextTwo("):", Color.Black) AppendTipTextTwo(strData & vbCrLf, Color.Blue) _countPort2RXData += strData.Length Case &H3 AppendTipTextThree("UDP-RX:", Color.Red) AppendTipTextThree("(" & cutTime & "-", Color.Black) AppendTipTextThree(timeData, Color.BlueViolet) AppendTipTextThree("):", Color.Black) AppendTipTextThree(strData & vbCrLf, Color.Blue) _countPort3RXData += strData.Length Case Else End Select End If End Sub ''' ''' 网络数据还原成485串口数据 ''' ''' Private Sub DealRestoreData(dataBuff As Byte()) Console.WriteLine($"回复数据为:{ByteToString(dataBuff)}") Dim len As Integer = dataBuff.Length - 19 Dim restData(len - 1) As Byte Array.Copy(dataBuff, 17, restData, 0, restData.Length) Console.WriteLine($"还原数据为:{ByteToString(restData)}") AnalyRFData(restData) 'RF无线通信处理 End Sub #Region "解析红外透传数据" ''' ''' 解析红外透传数据 ''' ''' Private Function ParseInfraredThroughData(databuff() As Byte) If databuff(17) = &H55 Or databuff(18) = &H55 Or databuff(19) = &HEE Then '确认为透传红外数据 Select Case databuff(22) Case &H1 '透传空调控制 DealAirControlData(databuff) Case &H2 '透传电视控制 DealTvControlData(databuff) Case &HA3 '透传搜索版本 DealInfraredSearchData(databuff) Case &HA6 '下发前询问 DealInfraredPrepareData(databuff) Case &HA7 '开始下发 _isInfraredreply = True DealInfraredBurnData(databuff) Case Else Return False End Select End If Return True End Function ''' ''' 处理空调控制透传数据 ''' ''' ''' Private Function DealAirControlData(databuff() As Byte) As Boolean Select Case databuff(24) Case &H1 AppendTipText($"空调设备接收成功! " & vbCrLf, Color.Green) Case Else AppendTipText($"空调设备接收失败! " & vbCrLf, Color.Red) Return False End Select Return True End Function ''' ''' 处理电视控制透传数据 ''' ''' ''' Private Function DealTvControlData(databuff() As Byte) As Boolean Select Case databuff(24) Case &H1 AppendTipText($"电视设备接收成功! " & vbCrLf, Color.Green) Case Else AppendTipText($"电视设备接收失败! " & vbCrLf, Color.Red) Return False End Select Return True End Function ''' ''' 处理红外搜索透传数据 ''' ''' ''' Private Function DealInfraredSearchData(databuff() As Byte) As Boolean Dim Ser1 As String = databuff(25).ToString Dim Ser2 As String = databuff(26).ToString Dim Ser3 As String = databuff(27).ToString AppendTipText($"红外透传搜索成功! ", Color.Green) AppendTipText($"搜索版本为:{Ser1}.{Ser2}.{Ser3}" & vbCrLf, Color.Green) If _addInfraredForm.IsFVer Then _addInfraredForm.Fw_Ver = databuff(25) _addInfraredForm.IsFVer = False End If Return True End Function ''' ''' 处理下发前询问透传数据 ''' ''' ''' Private Function DealInfraredPrepareData(databuff() As Byte) Select Case databuff(25) Case &H0 _isPrepare = True AppendTipText($"红外下发准备就绪!" & vbCrLf, Color.Green) Case &H1 AppendTipText($"红外下发成功!" & vbCrLf, Color.Green) Case &H2 AppendTipText($"红外下发失败!" & vbCrLf, Color.Green) Return False Case Else Return False End Select Return False End Function ''' ''' 烧录过程中,处理透传数据 ''' ''' ''' Private Function DealInfraredBurnData(databuff() As Byte) As Boolean Select Case databuff(26) Case &H1 AppendTipText($"烧录成功,当前为透传数据第{databuff(25)}包!" & vbCrLf, Color.Green) _resend = 0 Case &H2 AppendTipText($"烧录失败,当前为透传数据第{databuff(25)}包!" & vbCrLf, Color.Red) Return False Case Else Return False End Select Return True End Function #End Region #End Region #Region "添加记录" ''' ''' 添加记录文本和颜色 ''' ''' 需要添加的记录内容 ''' 需要设置的记录颜色 Public Sub AppendTextAndSetStyle(ByVal str As String, ByVal cor As Color) Dim selStart As Integer Dim selLength As Integer selStart = RtxRecord.TextLength RtxRecord.AppendText(str) selLength = RtxRecord.TextLength - selStart RtxRecord.Select(selStart, selLength) RtxRecord.SelectionColor = cor End Sub ''' ''' 添加记录 ''' ''' ''' Public Sub AppendTipText(recordString As String, col As Color) If _isClosing Then Return If _isShowTip = False Then Return If RtxRecord.InvokeRequired Then RtxRecord.Invoke(New Action(Sub() If RtxRecord.Lines.Count >= 256 Then RtxRecord.Clear() AppendTextAndSetStyle($"{recordString}", col) RtxRecord.ScrollToCaret() LblRXCount.Text = _countRXData End Sub)) Else If RtxRecord.Lines.Count >= 256 Then RtxRecord.Clear() AppendTextAndSetStyle($"{recordString}", col) RtxRecord.ScrollToCaret() LblRXCount.Text = _countRXData End If End Sub ''' ''' 添加端口1记录文本和颜色 ''' ''' ''' Private Sub AppendTextOne(ByVal str As String, ByVal cor As Color) Dim selStart As Integer Dim selLength As Integer selStart = RtxCountOne.TextLength RtxCountOne.AppendText(str) selLength = RtxCountOne.TextLength - selStart RtxCountOne.Select(selStart, selLength) RtxCountOne.SelectionColor = cor End Sub ''' ''' 添加端口1记录 ''' ''' ''' Private Sub AppendTipTextOne(recordString As String, col As Color) If _isClosing Then Return If _isShowTip = False Then Return If RtxCountOne.InvokeRequired Then RtxCountOne.Invoke(New Action(Sub() If RtxCountOne.Lines.Count >= 256 Then RtxCountOne.Clear() AppendTextOne($"{recordString}", col) RtxCountOne.ScrollToCaret() LblCountPort1RX.Text = _countPort1RXData End Sub)) Else If RtxCountOne.Lines.Count >= 256 Then RtxCountOne.Clear() AppendTextOne($"{recordString}", col) RtxCountOne.ScrollToCaret() LblCountPort1RX.Text = _countPort1RXData End If End Sub ''' ''' 添加端口2记录文本和颜色 ''' ''' ''' Private Sub AppendTextTwo(ByVal str As String, ByVal cor As Color) Dim selStart As Integer Dim selLength As Integer selStart = RtxCountTwo.TextLength RtxCountTwo.AppendText(str) selLength = RtxCountTwo.TextLength - selStart RtxCountTwo.Select(selStart, selLength) RtxCountTwo.SelectionColor = cor End Sub ''' ''' 添加端口2记录 ''' ''' ''' Private Sub AppendTipTextTwo(recordString As String, col As Color) If _isClosing Then Return If _isShowTip = False Then Return If RtxCountTwo.InvokeRequired Then RtxCountTwo.Invoke(New Action(Sub() If RtxCountTwo.Lines.Count >= 256 Then RtxCountTwo.Clear() AppendTextTwo($"{recordString}", col) RtxCountTwo.ScrollToCaret() LblCountPort2RX.Text = _countPort2RXData End Sub)) Else If RtxCountTwo.Lines.Count >= 256 Then RtxCountTwo.Clear() AppendTextTwo($"{recordString}", col) RtxCountTwo.ScrollToCaret() LblCountPort2RX.Text = _countPort2RXData End If End Sub ''' ''' 添加端口3记录文本和颜色 ''' ''' ''' Private Sub AppendTextThree(ByVal str As String, ByVal cor As Color) Dim selStart As Integer Dim selLength As Integer selStart = RtxCountThree.TextLength RtxCountThree.AppendText(str) selLength = RtxCountThree.TextLength - selStart RtxCountThree.Select(selStart, selLength) RtxCountThree.SelectionColor = cor End Sub ''' ''' 添加端口3记录 ''' ''' ''' Private Sub AppendTipTextThree(recordString As String, col As Color) If _isClosing Then Return If _isShowTip = False Then Return If RtxCountThree.InvokeRequired Then RtxCountThree.Invoke(New Action(Sub() If RtxCountThree.Lines.Count >= 256 Then RtxCountThree.Clear() AppendTextThree($"{recordString}", col) RtxCountThree.ScrollToCaret() LblCountPort3RX.Text = _countPort3RXData End Sub)) Else If RtxCountThree.Lines.Count >= 256 Then RtxCountThree.Clear() AppendTextThree($"{recordString}", col) RtxCountThree.ScrollToCaret() LblCountPort3RX.Text = _countPort3RXData End If End Sub #End Region #Region "发送接口" ''' ''' 发送数据 ''' ''' 串口数据 Public Sub SendData(dataBuff() As Byte) 'todo:最终版本 _isSendByUdp = CheckNetWorkDisConnect() SendDataMode(dataBuff) 'If CheckNetWorkDisConnect() = True Then ' Dim data() As Byte = PassthroughData(dataBuff) ' _isSendByUdp = True ' Dim sendPacket() As Byte = FillSendDataPacket(data) '透传数据 ' SendDataMode(sendPacket) 'Else ' _isSendByUdp = False ' SendDataMode(dataBuff) '串口数据 'End If End Sub ''' ''' 检查网络连接 ''' ''' Private Function CheckNetWorkDisConnect() As Boolean If _connectStatus = EnConnectStatus.DisConnect Then 'AppendTipText("数据发送失败! 原因:未打开网络!!!" & vbCrLf, Color.Red) Return False End If Return True End Function ''' ''' 以哪种方式发送 ''' ''' Private Sub SendDataMode(databuff() As Byte) If _isSendByUdp Then SendUDPData(databuff) CountBytesSum(databuff) '计数 UpdateSendData(databuff) '更新记录 Else If SerialPort.IsOpen = False Then 'AppendTipText("数据发送失败! 原因:未打开串口!!!" & vbCrLf, Color.Red) Exit Sub End If SendPortData(databuff) CountBytesSum(databuff) '计数 ' ShowPortReceData(databuff) '更新记录 End If End Sub #Region "红外" ' Enum RedPacket ' STX = 0 ' Len = 3 ' CmdType = 4 ' DevType = 5 ' DevAddr = 6 ' Param = 7 ' Crc ' End Enum ' ''' ' ''' 红外组包函数 ' ''' ' ''' ' ''' ' ''' ' ''' ' ''' ' Private Function FillPacket4(cmdType As Byte, devType As Byte, devAddr As Byte, param() As Byte) As Byte() ' Dim packetData(9 + param.Length - 1) As Byte ' packetData(RedPacket.STX) = &H55 ' packetData(RedPacket.STX + 1) = &H55 ' packetData(RedPacket.STX + 2) = &HEE ' packetData(RedPacket.Len) = $"&H{Hex(packetData.Length - 3)}" ' packetData(RedPacket.CmdType) = cmdType ' packetData(RedPacket.DevType) = devType ' packetData(RedPacket.DevAddr) = devAddr ' Array.Copy(param, 0, packetData, RedPacket.Param, param.Length) ' 'Dim packetcrc() As Byte = FillPacketFileCRC(packetData.ToArray) ' 'Array.Copy(packetcrc, 0, packetData, packetData.Length - 2, packetcrc.Length) ' Return packetData ' End Function #End Region #Region "C43" ' Enum C43Packet ' Addr ' Cmd ' Param ' End Enum ' Private Function FillPacket3(addr As Byte, cmd As Byte, param() As Byte) As Byte() ' Dim sendPacket(2 + param.Length - 1) As Byte ' sendPacket(C43Packet.Addr) = addr ' sendPacket(C43Packet.Cmd) = cmd ' Array.Copy(param, 0, sendPacket, C43Packet.Param, param.Length) ' Return sendPacket ' End Function #End Region #End Region #End Region #Region "功能" '各窗体文件内 #End Region #Region "关闭窗体" ''' 关闭窗口事件 Private Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) Handles MyBase.FormClosing _clickCount = 0 _isClosing = True If _connectStatus = EnConnectStatus.Connect Then _connectStatus = EnConnectStatus.DisConnect _socket.Shutdown(SocketShutdown.Both) _socket.Close() SerialPort.Close() End If Timer3.Stop() My.Settings.CBoLongIP = CboLongIP.Text My.Settings.NumRemotePort = NudRemotePort.Value My.Settings.NumLocalPort = NudLocalPort.Value My.Settings.CBoBaud = CBoBaud.Text My.Settings.CBoMode = CboMode.Text My.Settings.CboSerialBaud = CboSerialBaud.Text My.Settings.Save() DeleteFiles() End Sub Public cntit As Integer = 0 Private Sub LblLocalIp_Click(sender As Object, e As EventArgs) Handles LblLocalIp.Click If cntit = 5 Then tpfrm3.Parent = TabFunction tpfrm4.Parent = TabFunction cntit = 0 Else tpfrm3.Parent = Nothing tpfrm4.Parent = Nothing End If cntit = cntit + 1 End Sub #End Region End Class