Files
Desktop_InfraredTransmission/RCU-10/RCU/FrmRCU.vb

3679 lines
115 KiB
VB.net
Raw Normal View History

2025-12-11 10:59:57 +08:00
Imports System.Net
Imports System.Net.Sockets
Imports System.Threading
Imports System.IO
Imports System.Text
Public Class FrmRCU
#Region "子窗体_功能模块"
''' <summary>
''' C43窗体
''' </summary>
Private _addC43Form As FrmC43Function
''' <summary>
''' 红外窗体
''' </summary>
Private _addInfraredForm As FrmInfraredFunction
''' <summary>
''' RF无线窗体
''' </summary>
Private _addRFWifiForm As FrmRFFunction
''' <summary>
''' 485升级窗体
''' </summary>
Private _add485UpdateForm As Frm485Update
Private tpfrm3 As TabPage
Private tpfrm4 As TabPage
''' <summary>
''' 初始化各子窗体
''' </summary>
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 "全局变量"
''' <summary>
''' 枚举是否连接
''' </summary>
Enum EnConnectStatus
Connect
DisConnect
End Enum
''' <summary>
''' 连接状态,默认非连接
''' </summary>
Public _connectStatus As EnConnectStatus = EnConnectStatus.DisConnect
''' <summary>
''' 按键连接提示文本
''' </summary>
Private _btnConnectTipText As String() = {"断开连接", "打开连接"}
''' <summary>
''' 按键连接提示颜色
''' </summary>
Private _btnConnectTipColor As Color() = {Color.Red, Color.Green}
''' <summary>
''' 按键连接启用
''' </summary>
Private _btnConnectEnable As Boolean() = {False, True}
''' <summary>
''' 模式选择
''' </summary>
Private _modeItmeData() As String = {"正常模式", "进入透传", "进入监控"}
''' <summary>
''' 串口波特率
''' </summary>
Private _baudItmeData() As String = {"9600", "14400", "19200", "38400", "56000", "57600", "115200"}
''' <summary>
''' Socket网络套接字
''' </summary>
Private _socket As Socket
''' <summary>
''' UDP通讯接收线程
''' </summary>
Private _receiveThread As Thread
''' <summary>
''' 本地端口号
''' </summary>
Private _localPort As Integer
''' <summary>
''' 总接收数据字节数
''' </summary>
Public _countRXData As Integer
''' <summary>
''' 总发送数据字节数
''' </summary>
Public _countTxData As Integer
''' <summary>
''' 端口1接收数据字节数
''' </summary>
Private _countPort1RXData As Integer
''' <summary>
''' 端口2接收数据字节数
''' </summary>
Private _countPort2RXData As Integer
''' <summary>
''' 端口3接收数据字节数
''' </summary>
Private _countPort3RXData As Integer
''' <summary>
''' 发送次数标志位
''' </summary>
Public _sendTick As Short = 2 '标志位
#End Region
#Region "窗体初始化"
''' <summary>
''' 窗体加载事件
''' </summary>
''' <param name="sender"></param>
''' <param name="e"></param>
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
''' <summary>
''' 显示窗体名称和版本信息
''' </summary>
Private Sub ShowFormTitle()
Text = $"{My.Application.Info.ProductName} {My.Application.Info.Version}"
End Sub
''' <summary>
''' 设置窗体
''' </summary>
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
''' <summary>
''' 下拉模式选择
''' </summary>
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
''' <summary>
''' RF设备电动窗帘保存信息
''' </summary>
Private Sub RFCurtains()
End Sub
#End Region
#Region "控件变化"
''' <summary>
''' 点击连接按键,控件变化
''' </summary>
''' <param name="sender"></param>
''' <param name="e"></param>
Private Sub BtnConnect_Click(sender As Object, e As EventArgs) Handles BtnNetworkConnect.Click
UpdataConnectStatus(_connectStatus)
UpdataBtnConnect(_connectStatus)
UpdataCboEnabled(_connectStatus)
UpdataStaueShow()
End Sub
''' <summary>
''' 更新下拉框是否可用
''' </summary>
''' <param name="status"></param>
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
''' <summary>
''' 状态栏更新显示
''' </summary>
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
''' <summary>
''' 更新连接状态
''' </summary>
''' <param name="ststus"></param>
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
''' <summary>
''' 更新按键显示
''' </summary>
''' <param name="status"></param>
Private Sub UpdataBtnConnect(status As EnConnectStatus)
BtnNetworkConnect.Text = _btnConnectTipText(status)
BtnNetworkConnect.ForeColor = _btnConnectTipColor(status)
End Sub
''' <summary>
''' 清空记录
''' </summary>
''' <param name="sender"></param>
''' <param name="e"></param>
Private Sub BtnClear_Click(sender As Object, e As EventArgs) Handles BtnClear.Click
RtxRecord.Clear()
End Sub
''' <summary>
''' 清空端口1记录
''' </summary>
''' <param name="sender"></param>
''' <param name="e"></param>
Private Sub BtnPort1Clear_Click(sender As Object, e As EventArgs) Handles BtnPort1Clear.Click
RtxCountOne.Clear()
End Sub
''' <summary>
''' 清空端口2记录
''' </summary>
''' <param name="sender"></param>
''' <param name="e"></param>
Private Sub BtnPort2Clear_Click(sender As Object, e As EventArgs) Handles BtnPort2Clear.Click
RtxCountTwo.Clear()
End Sub
''' <summary>
''' 清空端口3记录
''' </summary>
''' <param name="sender"></param>
''' <param name="e"></param>
Private Sub BtnPort3Clear_Click(sender As Object, e As EventArgs) Handles BtnPort3Clear.Click
RtxCountThree.Clear()
End Sub
''' <summary>
''' 重置计数
''' </summary>
''' <param name="sender"></param>
''' <param name="e"></param>
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
''' <summary>
''' 停止刷新布尔值
''' </summary>
Private _stopRefresh As Boolean
''' <summary>
''' 停止刷新端口数据
''' </summary>
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
''' <summary>
''' 各端口停止刷新纪录
''' </summary>
''' <param name="sender"></param>
''' <param name="e"></param>
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 "通讯全局变量"
''' <summary>
''' 远程IP地址
''' </summary>
Private _remoteIp As String
''' <summary>
''' 远程端口号
''' </summary>
Private _remotePort As String
''' <summary>
''' 远程IP地址和端口号
''' </summary>
Private _remoteEp As New IPEndPoint(IPAddress.Any, _localPort)
''' <summary>
''' 当前时间
''' </summary>
Private _nowTime As Date
''' <summary>
''' 最后时间
''' </summary>
Private _lastTime As Date
''' <summary>
''' 时间间隔
''' </summary>
Private _timeInterbval As TimeSpan
''' <summary>
''' 接收数据偏移量
''' </summary>
Private _recvOffset As Integer
''' <summary>
''' 接收数据缓存包
''' </summary>
Private _recvBuffer(254) As Byte
''' <summary>
''' Cmd为70模式注释
''' </summary>
Private _dataCmd70ModeNote() As String = {"透传查询当前模式为:"}
''' <summary>
''' Cmd为70模式
''' </summary>
Private _dataCmd70Mode() As String = {"正常模式", "透传模式", "监控模式"}
''' <summary>
''' Cmd为70设置回复
''' </summary>
Private _dataCmd70SetReply() As String = {"设置成功", "设置失败"}
''' <summary>
''' Cmd为70的透传回复
''' </summary>
Private _dataCmd70PassthroughReply() As String = {"透传数据正确", "透传数据有误", "透传数据超时"}
''' <summary>
''' Cmd为71的透传回复
''' </summary>
Private _dataCmd71PassthroughCommand() As String = {"透传命令上报正确", "透传命令上报有误"}
''' <summary>
''' 是否显示通讯记录数据
''' </summary>
Private _isShowLog As Boolean = True
''' <summary>
''' 是否显示通讯记录提示
''' </summary>
Public _isShowTip As Boolean = True
''' <summary>
''' 是否窗体处于关闭状态
''' </summary>
Public _isClosing As Boolean = False
#End Region
#Region "485串口通讯"
''' <summary>
''' 选择串口通讯
''' </summary>
''' <param name="sender"></param>
''' <param name="e"></param>
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
''' <summary>
''' 选择UDP通讯
''' </summary>
''' <param name="sender"></param>
''' <param name="e"></param>
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
''' <summary>
''' 串口连接按键
''' </summary>
''' <param name="sender"></param>
''' <param name="e"></param>
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
''' <summary>
''' 关闭串口
''' </summary>
Private Sub CloseSerialPort()
CboSerialPort.Enabled = True
CboSerialBaud.Enabled = True
BtnSerialPortConnect.Text = $"打开串口"
BtnSerialPortConnect.ForeColor = Color.Green
End Sub
''' <summary>
''' 打开串口
''' </summary>
Private Sub OpenSerialPort()
CboSerialPort.Enabled = False
CboSerialPort.Enabled = False
BtnSerialPortConnect.Text = $"关闭串口"
BtnSerialPortConnect.ForeColor = Color.Red
End Sub
''' <summary>
''' 点击下拉获取可用串口
''' </summary>
''' <param name="sender"></param>
''' <param name="e"></param>
Private Sub CboSerialPort_DropDown(sender As Object, e As EventArgs) Handles CboSerialPort.DropDown
GetSerialPort()
End Sub
''' <summary>
''' 获取可用串口
''' </summary>
Private Sub GetSerialPort()
Dim portNames As String() = Ports.SerialPort.GetPortNames '获得可用串口
Array.Sort(portNames)
CboSerialPort.Items.Clear()
CboSerialPort.Items.AddRange(portNames)
End Sub
''' <summary>
''' 配置串口
''' </summary>
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
''' <summary>
''' 发送485串口数据
''' </summary>
''' <param name="dataBuff"></param>
''' <returns></returns>
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
''' <summary>
''' 接收485串口数据
''' </summary>
''' <param name="sender"></param>
''' <param name="e"></param>
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
''' <summary>
''' Byte数组转字符串
''' </summary>
''' <param name="data"></param>
''' <returns></returns>
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
''' <summary>
''' 显示串口回复数据
''' </summary>
''' <param name="databuff"></param>
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
''' <summary>
''' 解析串口数据
''' </summary>
''' <param name="databuff"></param>
''' <returns></returns>
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数据"
''' <summary>
''' 解析RS485数据
''' </summary>
''' <param name="databuff"></param>
''' <returns></returns>
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
''' <summary>
''' 处理查询数据
''' </summary>
''' <param name="databuff"></param>
''' <returns></returns>
Private Function DealQueryDatabuff(databuff() As Byte)
AppendTipText($"接收成功!" & vbCrLf, Color.Green)
Return True
End Function
''' <summary>
''' 解析红外处理数据
''' </summary>
''' <param name="databuff"></param>
''' <returns></returns>
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
''' <summary>
''' 处理空调控制数据
''' </summary>
''' <param name="databuff"></param>
''' <returns></returns>
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
''' <summary>
''' 处理电视控制数据
''' </summary>
''' <param name="databuff"></param>
''' <returns></returns>
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
''' <summary>
''' 处理红外搜索数据
''' </summary>
''' <param name="databuff"></param>
''' <returns></returns>
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
''' <summary>
''' 处理红外数据
''' </summary>
''' <param name="databuff"></param>
''' <returns></returns>
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
''' <summary>
''' 烧录过程中,处理数据
''' </summary>
''' <param name="databuff"></param>
''' <returns></returns>
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数据"
''' <summary>
''' 取设备偏移值
''' </summary>
Private _skewing As Integer
''' <summary>
''' 监控模式布尔值
''' </summary>
Private _rfMonitoring As Boolean
''' <summary>
''' 处理RF单包数据
''' </summary>
''' <param name="databuff"></param>
''' <returns></returns>
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
''' <summary>
''' 处理RF数据
''' </summary>
''' <param name="databuff"></param>
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
''' <summary>
''' 解析RF数据
''' </summary>
''' <param name="databuff"></param>
''' <returns></returns>
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
''' <summary>
''' 解析询问设备网络状态命令_0x13
''' </summary>
''' <param name="databuff"></param>
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
''' <summary>
''' 解析读取设备列表命令_0x15
''' </summary>
''' <param name="databuff"></param>
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
''' <summary>
''' 解析设置设备网络命令_0x017
''' </summary>
''' <param name="databuff"></param>
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
''' <summary>
''' 解析配对设备列表命令_0x1A
''' </summary>
''' <param name="databuff"></param>
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
''' <summary>
''' 解析RF设备写入信息
''' </summary>
''' <param name="databuff"></param>
Private Sub DealRFDevWriteInfo(databuff As Byte())
End Sub
''' <summary>
''' 根据配对设备型号获取设备名称
''' </summary>
''' <param name="devName"></param>
''' <returns></returns>
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
''' <summary>
''' 解析设备类型
''' </summary>
''' <param name="data"></param>
''' <returns></returns>
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
''' <summary>
''' 解析设备地址
''' </summary>
''' <param name="data"></param>
''' <returns></returns>
Private Function DealDevAddr(data As Byte) As String
Dim txtAddr As String = $"{data}"
Return txtAddr
End Function
''' <summary>
''' 解析设备状态
''' </summary>
''' <param name="data"></param>
''' <returns></returns>
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
''' <summary>
''' 解析RF设备16命令上报数据
''' </summary>
''' <param name="databuff"></param>
''' <returns></returns>
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
''' <summary>
''' 插卡取电上报数据16
''' </summary>
''' <param name="databuff"></param>
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
''' <summary>
''' 电动窗帘上报数据16
''' </summary>
''' <param name="databuff"></param>
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
''' <summary>
''' 解析RF设备51命令上报数据
''' </summary>
''' <param name="databuff"></param>
''' <returns></returns>
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
''' <summary>
''' 插卡取电上报数据51
''' </summary>
''' <param name="databuff"></param>
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
''' <summary>
''' 开关面板上报数据51
''' </summary>
''' <param name="databuff"></param>
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
''' <summary>
''' 键值文本
''' </summary>
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
''' <summary>
''' 按键等提示信息
''' </summary>
''' <param name="data"></param>
''' <returns></returns>
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
''' <summary>
''' 无线温控上报数据51
''' </summary>
''' <param name="databuff"></param>
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
''' <summary>
''' 微信锁上报数据51
''' </summary>
''' <param name="databuff"></param>
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 "解析无线语音数据"
''' <summary>
''' 无线语音上报数据51
''' </summary>
''' <param name="databuff"></param>
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
''' <summary>
''' 无线语音_场景_类型0
''' </summary>
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
''' <summary>
''' 无线语音_继电器_类型1
''' </summary>
''' <param name="databuff"></param>
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
''' <summary>
''' 无线语音_服务客需_类型4
''' </summary>
''' <param name="databuff"></param>
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
''' <summary>
''' 无线语音_窗帘窗纱_类型5
''' </summary>
''' <param name="databuff"></param>
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
''' <summary>
''' 无线语音_空调控制_类型7
''' </summary>
''' <param name="databuff"></param>
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
''' <summary>
''' 无线语音_空调控制_类型7_0x00
''' </summary>
''' <param name="databuff"></param>
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
''' <summary>
''' 无线语音_背景音乐_类型15
''' </summary>
''' <param name="databuff"></param>
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
''' <summary>
''' 无线语音_调光_类型10
''' </summary>
''' <param name="databuff"></param>
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
''' <summary>
''' 无线语音_继电器_电视_类型F
''' </summary>
''' <param name="databuff"></param>
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
''' <summary>
''' 无线语音_灯带_类型12
''' </summary>
''' <param name="databuff"></param>
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
''' <summary>
''' 刷新设备列表控制信息
''' </summary>
''' <param name="databuff"></param>
''' <param name="Controltxt"></param>
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
''' <summary>
''' 是否是C1设备
''' </summary>
Public _isDeviceC1 As Boolean
''' <summary>
''' 搜索_App区
''' </summary>
''' <param name="databuff"></param>
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
''' <summary>
''' 搜索_Boot区
''' </summary>
''' <param name="databuff"></param>
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
''' <summary>
''' 跳转_App区
''' </summary>
''' <param name="databuff"></param>
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
''' <summary>
''' 写入Flash数据
''' </summary>
''' <param name="databuff"></param>
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
''' <summary>
''' 擦除Flash
''' </summary>
''' <param name="databuff"></param>
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
''' <summary>
''' 校验Flash
''' </summary>
''' <param name="databuff"></param>
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
''' <summary>
''' 获取Flash校验结果
''' </summary>
''' <param name="result"></param>
Private Sub GetFlashCheckResult(result As Byte)
If result = &H1 Then '校验成功
Console.WriteLine($"校验Flash成功!")
ElseIf result = &H0 Then '校验失败
Console.WriteLine($"校验Flash失败!")
End If
End Sub
''' <summary>
''' 跳转_Boot区
''' </summary>
''' <param name="databuff"></param>
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
''' <summary>
''' 设置参数
''' </summary>
''' <param name="databuff"></param>
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"
''' <summary>
''' 初始化本地IP
''' </summary>
Private Sub InitLocalIP()
CboLocalIp.Items.Clear()
CboLocalIp.Items.AddRange(GetLocalIp().ToArray)
If CboLocalIp.Items.Count > 0 Then CboLocalIp.SelectedIndex = 0
End Sub
''' <summary>
''' 获取本地可用IP
''' </summary>
''' <returns></returns>
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
''' <summary>
''' 显示UDP接收数据
''' </summary>
''' <param name="dataBuff"></param>
''' <param name="length"></param>
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
''' <summary>
''' 更新发送数据
''' </summary>
''' <param name="sendPacket"></param>
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
''' <summary>
''' UDP接收数据
''' </summary>
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
''' <summary>
''' 发送UDP数据
''' </summary>
''' <param name="sendPacket"></param>
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 "数据组包"
''' <summary>
''' 显示端口信息
''' </summary>
''' <param name="data"></param>
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
''' <summary>
''' SendUDPData限制
''' 超过1024字节自动清空
''' </summary>
''' <param name="sender"></param>
''' <param name="e"></param>
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
''' <summary>
''' 字节数求和
''' </summary>
''' <param name="sendPacket"></param>
Private Sub CountBytesSum(sendPacket As Byte())
_countTxData += sendPacket.Length
LblTXCount.Text = _countTxData
End Sub
''' <summary>
''' 定时器每隔5S发送一包数据
''' </summary>
''' <param name="sender"></param>
''' <param name="e"></param>
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
''' <summary>
''' 读取操作 --- PC->RCU主机
''' </summary>
''' <param name="sender"></param>
''' <param name="e"></param>
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
''' <summary>
''' 设置操作 --- PC->RCU主机
''' </summary>
''' <param name="sender"></param>
''' <param name="e"></param>
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
''' <summary>
''' 监控模式 --- PC->RCU主机
''' </summary>
''' <param name="sender"></param>
''' <param name="e"></param>
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
''' <summary>
''' 发送操作 --- PC->RCU主机
''' </summary>
''' <param name="sender"></param>
''' <param name="e"></param>
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
''' <summary>
''' 发送数据设置
''' </summary>
''' <returns></returns>
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 "数据处理"
''' <summary>
''' 接收数据处理
''' </summary>
''' <param name="recvBuffer"></param>
''' <param name="recvLength"></param>
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
''' <summary>
''' 改变状态委托
''' </summary>
''' <param name="fontTxt">文本</param>
''' <param name="fontCol">文本颜色</param>
Delegate Sub delegate_State_Change(ByRef fontTxt As String, ByVal fontCol As Color)
''' <summary>
''' 改变状态委托
''' </summary>
''' <param name="fontTxt"></param>
''' <param name="fontCol"></param>
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
''' <summary>
''' 检验CRC16成功
''' </summary>
''' <param name="dataBuff"></param>
''' <param name="length"></param>
''' <returns></returns>
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
''' <summary>
''' 获取CRC16校验和
''' </summary>
''' <param name="dataBuff">数据</param>
''' <param name="length">数据长度</param>
''' <returns></returns>
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
''' <summary>
''' 获取CRC16校验和
''' </summary>
''' <param name="buff">数据</param>
''' <returns></returns>
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
''' <summary>
''' 处理数据
''' </summary>
''' <param name="dataBuff"></param>
''' <param name="length"></param>
''' <returns></returns>
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
''' <summary>
''' 处理Cmd为70的命令
''' </summary>
''' <param name="dataBuff"></param>
''' <returns></returns>
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
''' <summary>
''' 处理dataBuff(15)为1的状态
''' </summary>
''' <param name="dataBuff"></param>
''' <returns></returns>
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
''' <summary>
''' 处理dataBuff(15)为1的文本注释信息
''' </summary>
''' <param name="dataBuff"></param>
''' <returns></returns>
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
''' <summary>
''' 处理dataBuff(15)为2的状态
''' </summary>
''' <param name="dataBuff"></param>
''' <returns></returns>
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
''' <summary>
''' 处理dataBuff(15)为3的状态
''' </summary>
''' <param name="dataBuff"></param>
''' <returns></returns>
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
''' <summary>
''' 处理Cmd为71的数据
''' </summary>
''' <param name="dataBuff"></param>
''' <returns></returns>
Private Function DealDataForCmd71(dataBuff() As Byte) As Boolean
ShowReceiveData(dataBuff, dataBuff.Length)
DealDataForCmd71Port(dataBuff)
'ParseThroughData(dataBuff)
Return True
End Function
''' <summary>
''' 处理Cmd为71的端口数据_1、2、3端口
''' </summary>
''' <param name="databuff"></param>
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
''' <summary>
''' 网络数据还原成485串口数据
''' </summary>
''' <param name="dataBuff"></param>
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 "解析红外透传数据"
''' <summary>
''' 解析红外透传数据
''' </summary>
''' <param name="databuff"></param>
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
''' <summary>
''' 处理空调控制透传数据
''' </summary>
''' <param name="databuff"></param>
''' <returns></returns>
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
''' <summary>
''' 处理电视控制透传数据
''' </summary>
''' <param name="databuff"></param>
''' <returns></returns>
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
''' <summary>
''' 处理红外搜索透传数据
''' </summary>
''' <param name="databuff"></param>
''' <returns></returns>
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
''' <summary>
''' 处理下发前询问透传数据
''' </summary>
''' <param name="databuff"></param>
''' <returns></returns>
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
''' <summary>
''' 烧录过程中,处理透传数据
''' </summary>
''' <param name="databuff"></param>
''' <returns></returns>
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 "添加记录"
''' <summary>
''' 添加记录文本和颜色
''' </summary>
''' <param name="str">需要添加的记录内容</param>
''' <param name="cor">需要设置的记录颜色</param>
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
''' <summary>
''' 添加记录
''' </summary>
''' <param name="recordString"></param>
''' <param name="col"></param>
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
''' <summary>
''' 添加端口1记录文本和颜色
''' </summary>
''' <param name="str"></param>
''' <param name="cor"></param>
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
''' <summary>
''' 添加端口1记录
''' </summary>
''' <param name="recordString"></param>
''' <param name="col"></param>
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
''' <summary>
''' 添加端口2记录文本和颜色
''' </summary>
''' <param name="str"></param>
''' <param name="cor"></param>
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
''' <summary>
''' 添加端口2记录
''' </summary>
''' <param name="recordString"></param>
''' <param name="col"></param>
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
''' <summary>
''' 添加端口3记录文本和颜色
''' </summary>
''' <param name="str"></param>
''' <param name="cor"></param>
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
''' <summary>
''' 添加端口3记录
''' </summary>
''' <param name="recordString"></param>
''' <param name="col"></param>
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 "发送接口"
''' <summary>
''' 发送数据
''' </summary>
''' <param name="dataBuff">串口数据</param>
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
''' <summary>
''' 检查网络连接
''' </summary>
''' <returns></returns>
Private Function CheckNetWorkDisConnect() As Boolean
If _connectStatus = EnConnectStatus.DisConnect Then
'AppendTipText("数据发送失败! 原因:未打开网络!!!" & vbCrLf, Color.Red)
Return False
End If
Return True
End Function
''' <summary>
''' 以哪种方式发送
''' </summary>
''' <param name="databuff"></param>
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
' ''' <summary>
' ''' 红外组包函数
' ''' </summary>
' ''' <param name="cmdType"></param>
' ''' <param name="devType"></param>
' ''' <param name="devAddr"></param>
' ''' <param name="param"></param>
' ''' <returns></returns>
' 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 "关闭窗体"
''' <summary> 关闭窗口事件 </summary>
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