Imports System.IO Imports System.Threading Public Class FrmInfraredFunction Implements IModuleForm #Region "窗体" ''' ''' 窗体加载函数 ''' ''' ''' Private Sub FrmInfraredFunction_Load(sender As Object, e As EventArgs) Handles Me.Load TabPage2.Parent = Nothing TextBox2.Visible = False TextBox3.Visible = False Label2.Visible = False Label1.Visible = False '红外 InfraredAirFormInit() InitSQLDataTable() 'TabPage2.Parent = TabControl3 #If IsAdmin = False Then TabPage2.Parent = Nothing #End If End Sub ''' ''' 显示窗体接口 ''' ''' Public Fw_Ver As Integer Public IsFVer As Boolean 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 DealInfraredSearchDatabuff(databuff() As Byte) As Boolean If IsFVer Then Fw_Ver = databuff(8) IsFVer = False End If Return True End Function Public Sub ShowForm(parentControl As Control) Implements IModuleForm.ShowForm FormBorderStyle = FormBorderStyle.None TopLevel = False Dock = DockStyle.Fill Parent = parentControl Show() End Sub ''' ''' 发送函数 ''' ''' Public Sub SendData(sendPacket() As Byte) If InvokeRequired Then Invoke(New Action(Sub() FrmRCU.SendData(sendPacket) End Sub)) Else FrmRCU.SendData(sendPacket) End If 'FrmRCU.SendData(sendPacket) '方法1 End Sub #End Region #Region "红外功能配置" #Region "红外全局变量" ''' ''' 空调开关 ''' Private _isAirSwitch As Boolean ''' ''' 是否空调下载 ''' Private _isDownload As Boolean ''' ''' 是否下载红外文件 ''' Private _isDownInfraredFile As Boolean ''' ''' 红外文件下载线程 ''' Private _upDownInfraredFileThread As Thread ''' ''' 红外电视下载线程 ''' Private _upDownInfraredTvThread As Thread ''' ''' 控件变化 ''' Private _change As Boolean ''' ''' 电视开关 ''' Private _isTvSwitch As Boolean ''' ''' 是否电视下载 ''' Private _isTvDownload As Boolean ''' ''' 回复超时 ''' Private ReadOnly _relayTimeout As Integer = 5000 #End Region #Region "红外空调下发" ''' ''' 红外下发空调初始化窗体信息 ''' Private Sub InfraredAirFormInit() LblDegreeValue.ForeColor = Color.Gold LblDegree.ForeColor = Color.Gold BtnAirSwitch.ForeColor = Color.Green BtnAirSwitch.Text = "开" LblAirHigh.ForeColor = Color.DimGray LblAirCentre.ForeColor = Color.DimGray LblAirLow.ForeColor = Color.DimGray 'LblAuto.ForeColor = Color.DimGray LblAuto.Visible = False LblAirCold.ForeColor = Color.DimGray LblAirHot.ForeColor = Color.DimGray LblAirSupply.ForeColor = Color.DimGray BtnAirAdd.ForeColor = Color.Gray BtnAirMinus.ForeColor = Color.Gray BtnAirVelocity.ForeColor = Color.Gray BtnAirModel.ForeColor = Color.Gray BtnAirAdd.Enabled = False BtnAirMinus.Enabled = False BtnAirVelocity.Enabled = False BtnAirModel.Enabled = False End Sub ''' ''' 空调软件搜索 ''' ''' ''' Private Sub BtnInfraredSearch_Click(sender As Object, e As EventArgs) Handles BtnInfraredSearch.Click _InfraredReceProcessing = True Dim content As Byte = &H1 Dim addr As Byte = $"&H{Hex(NudAirAddress.Value)}" Dim sendPacket As Byte() = FillInfraredSearchPacket(content, addr) _port485 = $"&H{Hex(FrmRCU.NudSerialAppPort.Value)}" _timeouts = $"&H{Hex(FrmRCU.NudTimeOut3.Value)}" sendPacket = FillPacket(sendPacket) '组包 SendData(sendPacket) '发送数据 End Sub ''' ''' 空调固件搜索 ''' ''' ''' Private Sub BtnAirFirmwareSearch_Click(sender As Object, e As EventArgs) Handles BtnAirFirmwareSearch.Click _InfraredReceProcessing = True Dim content As Byte = &H0 Dim addr As Byte = $"&H{Hex(NudAirAddress.Value)}" Dim sendPacket As Byte() = FillInfraredSearchPacket(content, addr) _port485 = $"&H{Hex(FrmRCU.NudSerialAppPort.Value)}" _timeouts = $"&H{Hex(FrmRCU.NudTimeOut3.Value)}" sendPacket = FillPacket(sendPacket) '组包 SendData(sendPacket) '发送数据 End Sub ''' ''' 导出 ''' ''' ''' Private Sub BtnAKeyToRead_Click(sender As Object, e As EventArgs) Handles BtnAKeyToRead.Click _InfraredReceProcessing = True Dim sendPacket As Byte() Dim content As Byte = &H1 Dim addr As Byte = $"&H{Hex(NudAirAddress.Value)}" _port485 = $"&H{Hex(FrmRCU.NudSerialAppPort.Value)}" _timeouts = $"&H{Hex(FrmRCU.NudTimeOut3.Value)}" If _isRead = False Then _isRead = True BtnAKeyToRead.Text = "停止导出" BtnAirBurn.Text = "开始烧录" For index = 1 To 19 If _isRead = True Then sendPacket = FillAKeyToReadPacket(index, content, addr) sendPacket = FillPacket(sendPacket) '组包 SendData(sendPacket) '发送数据 Console.WriteLine($"一键导出-第{index}数据：{ByteToString(sendPacket)}") WaitInfraredForRelay() 'Todo:2、自主选择保存 AppendTipText($"导出第{index}包数据成功!" & vbCrLf, Color.Blue) ChangePrgValue(index, 19, 1) Else PrgAirBurn.Value = 0 AppendTipText($"停止导出!" & vbCrLf, Color.Blue) Exit For End If Next Else _isRead = False BtnAKeyToRead.Text = "导出" BtnAirBurn.Text = "开始烧录" Exit Sub End If _isRead = False BtnAKeyToRead.Text = "导出" AppendTipText($"一键导出完成!" & vbCrLf, Color.Green) PrgAirBurn.Value = 0 End Sub ''' ''' 空调导入dat配置文件信息 ''' ''' ''' Private Sub BtnAirImport_Click(sender As Object, e As EventArgs) Handles BtnAirImport.Click If OpenFileDialog1.ShowDialog() = DialogResult.OK Then TBoAirImport.Text = OpenFileDialog1.FileName CBoAirBrand.Text = Nothing CBoAirType.Text = Nothing CboVersion.Text = Nothing End If End Sub ''' ''' 烧录dat配置文件信息 ''' ''' ''' Private Sub BtnAirBurn_Click(sender As Object, e As EventArgs) Handles BtnAirBurn.Click '询问是否可以红外下发，成功，开始下发，失败，则停止下发————由收到状态控制 IsFVer = True Fw_Ver = -1 BtnAirFirmwareSearch.PerformClick() Dim task As Task = task.Run(Async Function() ' 非阻塞等待3秒 Await Task.Delay(3000) BtnAirBuThread() End Function) End Sub Public Sub BtnAirBuThread() If InvokeRequired Then Dim s As Action = AddressOf BtnAirBurnThread Me.Invoke(s) Else BtnAirBurnThread() End If End Sub Public Sub BtnAirBurnThread() If IsFVer Then IsFVer = False MsgBox("询问版本失败！！烧录停止！") Return End If Dim ofwver As Integer = -1 Integer.TryParse(Label6.Text, ofwver) If Fw_Ver = -1 OrElse ofwver = -1 Then MsgBox($"获取版本异常！！烧录停止！所需最低固件版本{ofwver}，红外目前版本{Fw_Ver}") Return End If If Not ComparativeVersion(ofwver, Fw_Ver) Then If MsgBox($"强制烧录可能导致无法常工作{vbCrLf }最低固件版本{ofwver}，红外目前版本{Fw_Ver}{vbCrLf }是否强制烧录？", MsgBoxStyle.OkCancel) = MsgBoxResult.Ok Then Else Return End If End If _InfraredReceProcessing = True '红外回复 If TBoAirImport.Text = Nothing Then ' MsgBox("文件为空，请选择要烧录的文件!") Exit Sub End If _isDownload = True Dim content As Byte = &H1 Dim addr As Byte = $"&H{Hex(NudAirAddress.Value)}" Dim dataFile() As Byte = OpenAirDATFile() If dataFile Is Nothing Then MsgBox("文件错误，请重新选择文件!") Exit Sub End If EnquiryToDownload(content, addr, dataFile) AppendTipText($"询问RCU主机是否可以下发..." & vbCrLf, Color.Green) BtnAirBurn.Text = $"停止烧录" If ReplyToDownload() = True Then DownloadTheData() Else BtnAirBurn.Text = $"开始烧录" Exit Sub End If End Sub ''' ''' 发送询问指令 ''' Private Sub EnquiryToDownload(content As Byte, addr As Byte, dataFile() As Byte) '询问是否可以红外下发 Dim sendPacket As Byte() = WhetherIssuedPacket(content, addr, dataFile) _port485 = $"&H{Hex(FrmRCU.NudSerialAppPort.Value)}" _timeouts = $"&H{Hex(FrmRCU.NudTimeOut3.Value)}" sendPacket = FillPacket(sendPacket) '组包 SendData(sendPacket) '发送数据 Console.WriteLine($"[{content}]询问下发数据：{ByteToString(sendPacket)}") End Sub ''' ''' 等待回复可以下载 ''' ''' Private Function ReplyToDownload() As Boolean PauseWait(10) AppendTipText($"等待回复..." & vbCrLf, Color.Green) WaitInfraredForRelay() AppendTipText($"RCU主机已回复，正在处理..." & vbCrLf, Color.Green) PauseWait(10) If _isPrepare = False Then AppendTipText($"当前RCU主机未准备好升级" & vbCrLf, Color.Green) _isDownInfraredFile = False Return False End If Return True End Function ''' ''' 空调下载数据 ''' Private Sub DownloadTheData() If _isPrepare = True Then AppendTipText($"当前RCU主机已准备就绪" & vbCrLf, Color.Green) '开始下发 PrgAirBurn.Value = 0 If _isDownInfraredFile = False Then _upDownInfraredFileThread = New Thread(AddressOf DownRCUFileToInfrared) _upDownInfraredFileThread.Start() _isDownInfraredFile = True BtnAirBurn.Text = $"停止烧录" Else If MsgBox("当前处于红外烧录状态,确定结束烧录?", MsgBoxStyle.YesNo, $"Tip") = MsgBoxResult.Yes Then _upDownInfraredFileThread.Abort() _isDownInfraredFile = False _isPrepare = False BtnAirBurn.Text = $"开始烧录" PrgAirBurn.Value = 0 AppendTipText($"已终止下载，下载失败！" & vbCrLf, Color.Red) End If End If End If End Sub ''' ''' 进度条委托 ''' ''' Delegate Sub delegate_PrgAirBurn_Value(ByRef Value As Integer, switch As Integer) ''' ''' 进度条委托 ''' ''' Private Sub ChangePrgAirBurnValue(ByRef value As Integer, switch As Integer) If Me.InvokeRequired = True Then Dim changeval As New delegate_PrgAirBurn_Value(AddressOf ChangePrgAirBurnValue) Me.Invoke(changeval, New Object() {value, switch}) Else PrgAirBurn.Value = value Select Case switch Case 0 BtnAirBurn.Text = "停止烧录" Case 1 BtnAirBurn.Text = "开始烧录" Case Else Exit Sub End Select End If End Sub ''' ''' 进度条委托 ''' ''' Delegate Sub delegate_PrgTvBurn_Value(ByRef Value As Integer, switch As Integer) ''' ''' 进度条委托 ''' ''' Private Sub ChangePrgTVBurnValue(ByRef value As Integer, switch As Integer) If Me.InvokeRequired = True Then Dim changeval As New delegate_PrgTvBurn_Value(AddressOf ChangePrgTVBurnValue) Me.Invoke(changeval, New Object() {value, switch}) Else ProgressBar1.Value = value Select Case switch Case 0 BtnTVBurn.Text = "停止烧录" Case 1 BtnTVBurn.Text = "开始烧录" Case Else Exit Sub End Select End If End Sub ''' ''' CRC16校验 ''' ''' Private Function FillPacketFileCRC(dataFile() As Byte) Dim fillCRC As Byte() fillCRC = GetCRC16CheckSum(dataFile, dataFile.Length) Return fillCRC End Function ''' ''' 红外协议组包头 ''' Private Function AirPackageHead() As Byte() Dim packetHead(2) As Byte packetHead(0) = &H55 packetHead(1) = &H55 packetHead(2) = &HEE Return packetHead End Function ''' ''' 填充红外开关包_控制按键通用 ''' ''' Private Function FillInfraredSearchPacket(content As Byte, addr As Byte) Dim dataPacket As New List(Of Byte) dataPacket.AddRange(AirPackageHead()) dataPacket.AddRange(FillInfraredSearchData(content, addr)) Return dataPacket.ToArray End Function ''' ''' 填充红外搜索数据 ''' ''' Private Function FillInfraredSearchData(content As Byte, Addr As Byte) As Byte() Dim packetLen As Byte Dim packetType As Byte = &H4 Dim packetCmd As Byte = &HA3 Dim packetAddress As Byte = Addr Dim packetRegister As Byte = content Dim dataPacket As New List(Of Byte) dataPacket.Add(packetType) dataPacket.Add(packetCmd) dataPacket.Add(packetAddress) dataPacket.Add(packetRegister) packetLen = $"&H{Hex(dataPacket.ToArray.Length + 3)}" Dim data As New List(Of Byte) data.Add(packetLen) data.AddRange(dataPacket) Dim packetcrc() As Byte = FillPacketFileCRC(data.ToArray) data.AddRange(packetcrc) Return data.ToArray End Function ''' ''' 询问是否可以红外下发 ''' ''' Private Function WhetherIssuedPacket(content As Byte, addr As Byte, dataFile() As Byte) Dim dataPacket As New List(Of Byte) dataPacket.AddRange(AirPackageHead()) dataPacket.AddRange(WhetherIssued(content, addr, dataFile)) Return dataPacket.ToArray End Function ''' ''' 红外下发前询问 ''' ''' Private Function WhetherIssued(content As Byte, addr As Byte, dataFile() As Byte) As Byte() Dim packetLen As Byte Dim packetType As Byte = &H4 Dim packetCmd As Byte = &HA6 Dim packetAddress As Byte = addr Dim packetRegister As Byte = content Dim packetOperation As Byte = &H1 Dim packetfileCrc() As Byte = FillPacketFileCRC(dataFile) Dim packetCount As Byte = $"&H{Hex(GetBlocks(dataFile))}" Dim dataPacket As New List(Of Byte) dataPacket.Add(packetType) dataPacket.Add(packetCmd) dataPacket.Add(packetAddress) dataPacket.Add(packetRegister) dataPacket.Add(packetOperation) dataPacket.AddRange(packetfileCrc) dataPacket.Add(packetCount) packetLen = $"&H{Hex(dataPacket.ToArray.Length + 3)}" Dim data As New List(Of Byte) data.Add(packetLen) data.AddRange(dataPacket) Dim packetcrc() As Byte = FillPacketFileCRC(data.ToArray) data.AddRange(packetcrc) 'Console.WriteLine($"询问下发数据：{ByteToString(dataPacket.ToArray)}") Return data.ToArray End Function ''' ''' 读取选中文件_空调 ''' ''' 文件格式为(dat) Private Function OpenAirDATFile() As Byte() Dim filename As String = TBoAirImport.Text If filename.IndexOf("空调") = -1 Then Exit Function End If Dim dataFile() As Byte = ReadFileToBytes(filename) Return dataFile End Function ''' ''' 读取选中文件_电视 ''' ''' 文件格式为(dat) Private Function OpenTvDATFile() As Byte() Dim filename As String = TextBox1.Text If filename.IndexOf("电视") = -1 Then Exit Function End If Dim dataFile() As Byte = ReadFileToBytes(filename) Return dataFile End Function ''' ''' RCU红外下发数据 ''' Private Sub DownRCUFileToInfrared() Dim dataFile() As Byte = OpenAirDATFile() If dataFile Is Nothing Then MsgBox("文件错误，请重新选择文件!") Exit Sub End If 'AppendTipText($"文件为：{ByteToString(dataFile)}" & vbCrLf, Color.Blue) Dim blockCount As Integer = GetBlocks(dataFile) Dim burnPackage() As Byte ChangePrgAirBurnValue(1, 0) Dim packageNumber As Integer For packageNumber = 1 To blockCount _isInfraredreply = False burnPackage = FillBurnPackage(dataFile, packageNumber, blockCount) AppendTipText($"开始发送第{packageNumber}包数据..." & vbCrLf, Color.Blue) burnPackage = FillPacket(burnPackage) '组包 SendData(burnPackage) Console.WriteLine($"第{packageNumber}包:{ByteToString(burnPackage)}") ChangePrgValue(packageNumber, blockCount, 0) WaitInfraredForRelay() If _isInfraredreply = True Then '判断是回复 If packageNumber = blockCount Then _isDownInfraredFile = False AppendTipText($"空调烧录完成!" & vbCrLf, Color.Blue) MsgBox($"空调烧录完成!") ChangePrgAirBurnValue(0, 1) _upDownInfraredFileThread.Abort() Return End If Else _resend += 1 If _resend <= 3 Then AppendTipText($"开始重发次数：{_resend}次" & vbCrLf, Color.Blue) packageNumber -= 1 Else AppendTipText($"已超出最大重发次数！" & vbCrLf, Color.Red) AppendTipText($"下载失败！" & vbCrLf, Color.Red) ChangePrgAirBurnValue(0, 1) _change = True _resend = 0 _isPrepare = False _isDownInfraredFile = False _upDownInfraredFileThread.Abort() Return End If End If Next End Sub ''' ''' 进度条变化 ''' Private Sub ChangePrgValue(packageNumber As Integer, blockCount As Integer, swith As Integer) If packageNumber > blockCount * 0 AndAlso packageNumber < blockCount * 0.1 Then ChangePrgAirBurnValue(5, swith) ElseIf packageNumber > blockCount * 0.1 AndAlso packageNumber < blockCount * 0.2 Then ChangePrgAirBurnValue(10, swith) ElseIf packageNumber > blockCount * 0.2 AndAlso packageNumber < blockCount * 0.3 Then ChangePrgAirBurnValue(20, swith) ElseIf packageNumber > blockCount * 0.3 AndAlso packageNumber < blockCount * 0.4 Then ChangePrgAirBurnValue(30, swith) ElseIf packageNumber > blockCount * 0.4 AndAlso packageNumber < blockCount * 0.5 Then ChangePrgAirBurnValue(40, swith) ElseIf packageNumber > blockCount * 0.5 AndAlso packageNumber < blockCount * 0.6 Then ChangePrgAirBurnValue(50, swith) ElseIf packageNumber > blockCount * 0.6 AndAlso packageNumber < blockCount * 0.7 Then ChangePrgAirBurnValue(60, swith) ElseIf packageNumber > blockCount * 0.7 AndAlso packageNumber < blockCount * 0.8 Then ChangePrgAirBurnValue(70, swith) ElseIf packageNumber > blockCount * 0.8 AndAlso packageNumber < blockCount * 0.9 Then ChangePrgAirBurnValue(80, swith) ElseIf packageNumber > blockCount * 0.9 AndAlso packageNumber < blockCount Then ChangePrgAirBurnValue(90, swith) ElseIf packageNumber = blockCount Then ChangePrgAirBurnValue(100, swith) End If 'For index = packageNumber To blockCount * 100% 'Next End Sub ''' ''' 进度条变化 ''' Private Sub ChangeTvPrgValue(packageNumber As Integer, blockCount As Integer, swith As Integer) If packageNumber > blockCount * 0 AndAlso packageNumber < blockCount * 0.1 Then ChangePrgTVBurnValue(10, swith) ElseIf packageNumber > blockCount * 0.9 AndAlso packageNumber < blockCount Then ChangePrgTVBurnValue(90, swith) ElseIf packageNumber = blockCount Then ChangePrgTVBurnValue(100, swith) End If End Sub ''' ''' 填充烧录包数据 ''' ''' ''' ''' ''' Private Function FillBurnPackage(padData() As Byte, blockIndex As Integer， blockCount As Integer) As Byte() Dim dataLen As Byte Dim packetType As Byte = &H4 Dim packetCmd As Byte = &HA7 Dim packetAddress As Byte = $"&H{Hex(NudAirAddress.Value)}" Dim packetRegister As Byte = &H1 Dim packetfileCrc() As Byte Dim data As New List(Of Byte) data.Add(packetType) data.Add(packetCmd) data.Add(packetAddress) data.Add(packetRegister) data.Add(blockIndex) data.AddRange(FillBurnOnePackage(padData, blockIndex, blockCount)) dataLen = $"&H{Hex(data.ToArray.Length + 3)}" Dim list As New List(Of Byte) list.Add(dataLen) list.AddRange(data) packetfileCrc = FillPacketFileCRC(list.ToArray) Dim dataList As New List(Of Byte) dataList.AddRange(AirPackageHead) dataList.AddRange(list) dataList.AddRange(packetfileCrc) Return dataList.ToArray End Function ''' ''' 填充烧录单包数据 ''' ''' ''' ''' ''' Private Function FillBurnOnePackage(padData() As Byte, blockIndex As Integer， blockCount As Integer) As Byte() Dim blockPacket As New List(Of Byte) If blockIndex = blockCount Then For index = 128 * (blockIndex - 1) To padData.Length - 1 blockPacket.Add(padData(index)) Next Else For index = 128 * (blockIndex - 1) To 128 * blockIndex - 1 blockPacket.Add(padData(index)) Next End If Return blockPacket.ToArray End Function ''' ''' 等待红外数据回复 ''' Private Sub WaitInfraredForRelay() Dim tick As Integer Dim startTick As Integer = My.Computer.Clock.TickCount _isInfraredreply = False While _isInfraredreply = False AndAlso tick <= _relayTimeout Thread.Sleep(100) tick = My.Computer.Clock.TickCount - startTick Application.DoEvents() End While End Sub ''' ''' 空调开关按键 ''' ''' ''' Private Sub BtnAirSwitch_Click(sender As Object, e As EventArgs) Handles BtnAirSwitch.Click _InfraredReceProcessing = True If BtnAirSwitch.Text = "开" Then _isAirSwitch = False AirControlState() AirControl() ElseIf BtnAirSwitch.Text = "关" Then _isAirSwitch = True AirControl() AirControlState() End If End Sub ''' ''' 空调开关控制状态 ''' Private Sub AirControlState() If BtnAirSwitch.Text = "开" Then BtnAirSwitch.Text = "关" BtnAirSwitch.ForeColor = Color.Red BtnAirAdd.Enabled = True BtnAirMinus.Enabled = True BtnAirVelocity.Enabled = True BtnAirModel.Enabled = True BtnAirAdd.ForeColor = Color.Green BtnAirMinus.ForeColor = Color.Green BtnAirVelocity.ForeColor = Color.Green BtnAirModel.ForeColor = Color.Green LblAirHigh.ForeColor = Color.Green LblAirCentre.ForeColor = Color.Red LblAirLow.ForeColor = Color.Red ' LblAuto.ForeColor = Color.Red LblAirCold.ForeColor = Color.Green LblAirHot.ForeColor = Color.Red LblAirSupply.ForeColor = Color.Red ElseIf BtnAirSwitch.Text = "关" Then BtnAirSwitch.Text = "开" BtnAirSwitch.ForeColor = Color.Green BtnAirAdd.Enabled = False BtnAirMinus.Enabled = False BtnAirVelocity.Enabled = False BtnAirModel.Enabled = False LblAirHigh.ForeColor = Color.DimGray LblAirCentre.ForeColor = Color.DimGray LblAirLow.ForeColor = Color.DimGray 'LblAuto.ForeColor = Color.DimGray LblAirCold.ForeColor = Color.DimGray LblAirHot.ForeColor = Color.DimGray LblAirSupply.ForeColor = Color.DimGray End If End Sub ''' ''' 空调温度值增加 ''' ''' ''' Private Sub BtnAirAdd_Click(sender As Object, e As EventArgs) Handles BtnAirAdd.Click If LblDegreeValue.Text >= "16" AndAlso LblDegreeValue.Text < "32" Then LblDegreeValue.Text = CStr(CInt(LblDegreeValue.Text) + 1) End If AirControl() End Sub ''' ''' 空调温度值减少 ''' ''' ''' Private Sub BtnAirMinus_Click(sender As Object, e As EventArgs) Handles BtnAirMinus.Click If LblDegreeValue.Text > "16" AndAlso LblDegreeValue.Text <= "32" Then LblDegreeValue.Text = CStr(CInt(LblDegreeValue.Text) - 1) End If AirControl() End Sub ''' ''' 空调风速按键 ''' ''' ''' Private Sub BtnAirVelocity_Click(sender As Object, e As EventArgs) Handles BtnAirVelocity.Click If LblAirHigh.ForeColor = Color.Green Then LblAirHigh.ForeColor = Color.Red LblAirCentre.ForeColor = Color.Green LblAirLow.ForeColor = Color.Red 'LblAuto.ForeColor = Color.Red ElseIf LblAirCentre.ForeColor = Color.Green Then LblAirHigh.ForeColor = Color.Red LblAirCentre.ForeColor = Color.Red LblAirLow.ForeColor = Color.Green 'LblAuto.ForeColor = Color.Red ElseIf LblAirLow.ForeColor = Color.Green Then LblAirHigh.ForeColor = Color.Red LblAirCentre.ForeColor = Color.Red 'LblAirLow.ForeColor = Color.Red LblAirHigh.ForeColor = Color.Green 'LblAuto.ForeColor = Color.Green 'ElseIf LblAuto.ForeColor = Color.Green Then ' LblAirHigh.ForeColor = Color.Green ' LblAirCentre.ForeColor = Color.Red ' LblAirLow.ForeColor = Color.Red ' LblAuto.ForeColor = Color.Red End If AirControl() End Sub ''' ''' 空调模式按键 ''' ''' ''' Private Sub BtnAirModel_Click(sender As Object, e As EventArgs) Handles BtnAirModel.Click If LblAirCold.ForeColor = Color.Green Then LblAirCold.ForeColor = Color.Red LblAirHot.ForeColor = Color.Green LblAirSupply.ForeColor = Color.Red ElseIf LblAirHot.ForeColor = Color.Green Then LblAirCold.ForeColor = Color.Red LblAirHot.ForeColor = Color.Red LblAirSupply.ForeColor = Color.Green ElseIf LblAirSupply.ForeColor = Color.Green Then LblAirCold.ForeColor = Color.Green LblAirHot.ForeColor = Color.Red LblAirSupply.ForeColor = Color.Red End If AirControl() End Sub ''' ''' 空调控制 ''' Private Sub AirControl() _InfraredReceProcessing = True _port485 = $"&H{Hex(FrmRCU.NudSerialAppPort.Value)}" _timeouts = $"&H{Hex(FrmRCU.NudTimeOut3.Value)}" Dim sendPacket() As Byte = FillAirControlPacket() sendPacket = FillPacket(sendPacket) '组包 SendData(sendPacket) '发送数据 End Sub ''' ''' 填充空调控制包 ''' ''' Private Function FillAirControlPacket() Dim packetHead() As Byte = AirPackageHead() Dim packetData() As Byte = FillAirControlData() Dim packetcrc() As Byte = FillPacketFileCRC(packetData.ToArray) Dim dataPacket As New List(Of Byte) dataPacket.AddRange(packetHead) dataPacket.AddRange(packetData) dataPacket.AddRange(packetcrc) Return dataPacket.ToArray End Function ''' ''' 填充空调控制数据 ''' ''' Private Function FillAirControlData() Dim dataLen As Byte Dim packetType As Byte = &H4 Dim deviceType As Byte = &H1 Dim packetAddress As Byte = $"&H{Hex(NudAirAddress.Value)}" Dim packetTemp As Byte = $"&H{Hex(LblDegreeValue.Text)}" Dim switch As Byte = AirSwitch() Dim airvel As Byte = AirVelocity() Dim airMode As Byte = AirModel() Dim data As New List(Of Byte) data.Add(packetType) data.Add(deviceType) data.Add(packetAddress) data.Add(packetTemp) data.Add(switch) data.Add(airvel) data.Add(airMode) dataLen = $"&H{Hex(data.ToArray.Length + 3)}" Dim dataPacket As New List(Of Byte) dataPacket.Add(dataLen) dataPacket.AddRange(data) Return dataPacket.ToArray End Function ''' ''' 获取空调开关 ''' ''' Private Function AirSwitch() As Byte Dim switch As Byte If _isAirSwitch = False Then switch = &H1 Else switch = &H0 End If Return switch End Function ''' ''' 获取空调风速 ''' ''' Private Function AirVelocity() As Byte Dim airVel As Byte If LblAirHigh.ForeColor = Color.Green Then airVel = &H3 ElseIf LblAirCentre.ForeColor = Color.Green Then airVel = &H2 ElseIf LblAirLow.ForeColor = Color.Green Then airVel = &H1 'ElseIf LblAuto.ForeColor = Color.Green Then ' airVel = &H0 End If Return airVel End Function ''' ''' 获取空调模式 ''' ''' Private Function AirModel() As Byte Dim airmode As Byte If LblAirCold.ForeColor = Color.Green Then airmode = &H0 ElseIf LblAirHot.ForeColor = Color.Green Then airmode = &H1 ElseIf LblAirSupply.ForeColor = Color.Green Then airmode = &H2 End If Return airmode End Function ''' ''' 组一键读取的包 ''' ''' Private Function FillAKeyToReadPacket(index As Integer, content As Byte, addr As Byte) As Byte() Dim packetHead() As Byte = AirPackageHead() Dim packetData() As Byte = FillAKeyToReadData(index, content, addr) Dim packetcrc() As Byte = FillPacketFileCRC(packetData.ToArray) Dim dataPacket As New List(Of Byte) dataPacket.AddRange(packetHead) dataPacket.AddRange(packetData) dataPacket.AddRange(packetcrc) Return dataPacket.ToArray End Function ''' ''' 组一键读取的数据包 ''' ''' ''' ''' Private Function FillAKeyToReadData(index As Integer, content As Byte, addr As Byte) As Byte() Dim dataLen As Byte Dim packetType As Byte = &H4 Dim deviceType As Byte = &HA8 Dim packetAddress As Byte = addr Dim packetTemp As Byte = content Dim data As New List(Of Byte) data.Add(packetType) data.Add(deviceType) data.Add(packetAddress) data.Add(packetTemp) data.Add($"&H{Hex(index)}") dataLen = $"&H{Hex(data.ToArray.Length + 3)}" Dim dataPacket As New List(Of Byte) dataPacket.Add(dataLen) dataPacket.AddRange(data) Return dataPacket.ToArray End Function #End Region #Region "红外电视下发" ''' ''' 电视静音 ''' ''' ''' Private Sub BtnTVMute_Click(sender As Object, e As EventArgs) Handles BtnTVMute.Click _InfraredReceProcessing = True Dim content As Byte = &H1 Dim sendPacket As Byte() = FillTVCommPackage(content) _port485 = $"&H{Hex(FrmRCU.NudSerialAppPort.Value)}" _timeouts = $"&H{Hex(FrmRCU.NudTimeOut3.Value)}" sendPacket = FillPacket(sendPacket) '组包 SendData(sendPacket) '发送数据 End Sub ''' ''' 电视开关 ''' ''' ''' Private Sub BtnTVSwitch_Click(sender As Object, e As EventArgs) Handles BtnTVSwitch.Click If _isTvSwitch = False Then _isTvSwitch = True BtnTVSwitch.ForeColor = Color.Red BtnTVSwitch.Text = "关" Else _isTvSwitch = False BtnTVSwitch.ForeColor = Color.Green BtnTVSwitch.Text = "开" End If _InfraredReceProcessing = True Dim content As Byte = &H2 Dim sendPacket As Byte() = FillTVCommPackage(content) _port485 = $"&H{Hex(FrmRCU.NudSerialAppPort.Value)}" _timeouts = $"&H{Hex(FrmRCU.NudTimeOut3.Value)}" sendPacket = FillPacket(sendPacket) '组包 SendData(sendPacket) '发送数据 End Sub ''' ''' 电视音量加键 ''' ''' ''' Private Sub BtnTVVolumeAdd_Click(sender As Object, e As EventArgs) Handles BtnTVVolumeAdd.Click _InfraredReceProcessing = True Dim content As Byte = &H3 Dim sendPacket As Byte() = FillTVCommPackage(content) _port485 = $"&H{Hex(FrmRCU.NudSerialAppPort.Value)}" _timeouts = $"&H{Hex(FrmRCU.NudTimeOut3.Value)}" sendPacket = FillPacket(sendPacket) '组包 SendData(sendPacket) '发送数据 End Sub ''' ''' 电视音量减键 ''' ''' ''' Private Sub BtnTVVolumeMinus_Click(sender As Object, e As EventArgs) Handles BtnTVVolumeMinus.Click _InfraredReceProcessing = True Dim content As Byte = &H4 Dim sendPacket As Byte() = FillTVCommPackage(content) _port485 = $"&H{Hex(FrmRCU.NudSerialAppPort.Value)}" _timeouts = $"&H{Hex(FrmRCU.NudTimeOut3.Value)}" sendPacket = FillPacket(sendPacket) '组包 SendData(sendPacket) '发送数据 End Sub ''' ''' 频道加键 ''' ''' ''' Private Sub BtnTVChannelAdd_Click(sender As Object, e As EventArgs) Handles BtnTVChannelAdd.Click _InfraredReceProcessing = True Dim content As Byte = &H5 Dim sendPacket As Byte() = FillTVCommPackage(content) _port485 = $"&H{Hex(FrmRCU.NudSerialAppPort.Value)}" _timeouts = $"&H{Hex(FrmRCU.NudTimeOut3.Value)}" sendPacket = FillPacket(sendPacket) '组包 SendData(sendPacket) '发送数据 End Sub ''' ''' 频道减键 ''' ''' ''' Private Sub BtnTVChannelMinus_Click(sender As Object, e As EventArgs) Handles BtnTVChannelMinus.Click _InfraredReceProcessing = True Dim content As Byte = &H6 Dim sendPacket As Byte() = FillTVCommPackage(content) _port485 = $"&H{Hex(FrmRCU.NudSerialAppPort.Value)}" _timeouts = $"&H{Hex(FrmRCU.NudTimeOut3.Value)}" sendPacket = FillPacket(sendPacket) '组包 SendData(sendPacket) '发送数据 End Sub ''' ''' 电视上键 ''' ''' ''' Private Sub BtnTVGetOn_Click(sender As Object, e As EventArgs) Handles BtnTVGetOn.Click _InfraredReceProcessing = True Dim content As Byte = &H7 Dim sendPacket As Byte() = FillTVCommPackage(content) _port485 = $"&H{Hex(FrmRCU.NudSerialAppPort.Value)}" _timeouts = $"&H{Hex(FrmRCU.NudTimeOut3.Value)}" sendPacket = FillPacket(sendPacket) '组包 SendData(sendPacket) '发送数据 End Sub ''' ''' 电视下键 ''' ''' ''' Private Sub BtnTVBelow_Click(sender As Object, e As EventArgs) Handles BtnTVBelow.Click _InfraredReceProcessing = True Dim content As Byte = &H8 Dim sendPacket As Byte() = FillTVCommPackage(content) _port485 = $"&H{Hex(FrmRCU.NudSerialAppPort.Value)}" _timeouts = $"&H{Hex(FrmRCU.NudTimeOut3.Value)}" sendPacket = FillPacket(sendPacket) '组包 SendData(sendPacket) '发送数据 End Sub ''' ''' 电视左键 ''' ''' ''' Private Sub BtnTVLeft_Click(sender As Object, e As EventArgs) Handles BtnTVLeft.Click _InfraredReceProcessing = True Dim content As Byte = &H9 Dim sendPacket As Byte() = FillTVCommPackage(content) _port485 = $"&H{Hex(FrmRCU.NudSerialAppPort.Value)}" _timeouts = $"&H{Hex(FrmRCU.NudTimeOut3.Value)}" sendPacket = FillPacket(sendPacket) '组包 SendData(sendPacket) '发送数据 End Sub ''' ''' 电视右键 ''' ''' ''' Private Sub BtnTVRight_Click(sender As Object, e As EventArgs) Handles BtnTVRight.Click _InfraredReceProcessing = True Dim content As Byte = &HA Dim sendPacket As Byte() = FillTVCommPackage(content) _port485 = $"&H{Hex(FrmRCU.NudSerialAppPort.Value)}" _timeouts = $"&H{Hex(FrmRCU.NudTimeOut3.Value)}" sendPacket = FillPacket(sendPacket) '组包 SendData(sendPacket) '发送数据 End Sub ''' ''' 电视OK键 ''' ''' ''' Private Sub BtnTVOK_Click(sender As Object, e As EventArgs) Handles BtnTVOK.Click _InfraredReceProcessing = True Dim content As Byte = &HB Dim sendPacket As Byte() = FillTVCommPackage(content) _port485 = $"&H{Hex(FrmRCU.NudSerialAppPort.Value)}" _timeouts = $"&H{Hex(FrmRCU.NudTimeOut3.Value)}" sendPacket = FillPacket(sendPacket) '组包 SendData(sendPacket) '发送数据 End Sub ''' ''' 电视首页 ''' ''' ''' Private Sub BtnTVHomePage_Click(sender As Object, e As EventArgs) Handles BtnTVHomePage.Click _InfraredReceProcessing = True Dim content As Byte = &HC Dim sendPacket As Byte() = FillTVCommPackage(content) _port485 = $"&H{Hex(FrmRCU.NudSerialAppPort.Value)}" _timeouts = $"&H{Hex(FrmRCU.NudTimeOut3.Value)}" sendPacket = FillPacket(sendPacket) '组包 SendData(sendPacket) '发送数据 End Sub ''' ''' 电视菜单 ''' ''' ''' Private Sub BtnTVMenu_Click(sender As Object, e As EventArgs) Handles BtnTVMenu.Click _InfraredReceProcessing = True Dim content As Byte = &HD Dim sendPacket As Byte() = FillTVCommPackage(content) _port485 = $"&H{Hex(FrmRCU.NudSerialAppPort.Value)}" _timeouts = $"&H{Hex(FrmRCU.NudTimeOut3.Value)}" sendPacket = FillPacket(sendPacket) '组包 SendData(sendPacket) '发送数据 End Sub ''' ''' 电视信源 ''' ''' ''' Private Sub BtnTVSource_Click(sender As Object, e As EventArgs) Handles BtnTVSource.Click _InfraredReceProcessing = True Dim content As Byte = &HE Dim sendPacket As Byte() = FillTVCommPackage(content) _port485 = $"&H{Hex(FrmRCU.NudSerialAppPort.Value)}" _timeouts = $"&H{Hex(FrmRCU.NudTimeOut3.Value)}" sendPacket = FillPacket(sendPacket) '组包 SendData(sendPacket) '发送数据 End Sub ''' ''' 电视返回 ''' ''' ''' Private Sub BtnTVGetBack_Click(sender As Object, e As EventArgs) Handles BtnTVGetBack.Click _InfraredReceProcessing = True Dim content As Byte = &HF Dim sendPacket As Byte() = FillTVCommPackage(content) _port485 = $"&H{Hex(FrmRCU.NudSerialAppPort.Value)}" _timeouts = $"&H{Hex(FrmRCU.NudTimeOut3.Value)}" sendPacket = FillPacket(sendPacket) '组包 SendData(sendPacket) '发送数据 End Sub ''' ''' 电视一键读取 ''' ''' ''' Private Sub BtnTVAKeyToRead_Click(sender As Object, e As EventArgs) Handles BtnTVAKeyToRead.Click _InfraredReceProcessing = True ProgressBar1.Value = 0 Dim sendPacket As Byte() Dim content As Byte = &H2 Dim addr As Byte = $"&H{Hex(NudTVAddress.Value)}" _port485 = $"&H{Hex(FrmRCU.NudSerialAppPort.Value)}" _timeouts = $"&H{Hex(FrmRCU.NudTimeOut3.Value)}" If _isRead = False Then _isRead = True BtnTVAKeyToRead.Text = "停止导出" sendPacket = FillAKeyToReadPacket(1, content, addr) sendPacket = FillPacket(sendPacket) '组包 SendData(sendPacket) '发送数据 Console.WriteLine($"一键导出-电视包数据：{ByteToString(sendPacket)}") WaitInfraredForRelay() AppendTipText($"导出电视包数据成功!" & vbCrLf, Color.Green) ProgressBar1.Value = 100 Else _isRead = False BtnTVAKeyToRead.Text = "导出" Exit Sub End If _isRead = False BtnTVAKeyToRead.Text = "导出" AppendTipText($"一键导出完成!" & vbCrLf, Color.Green) End Sub ''' ''' 电视搜索 ''' ''' ''' Private Sub BtnTVSearch_Click(sender As Object, e As EventArgs) Handles BtnTVSearch.Click _InfraredReceProcessing = True Dim content As Byte = &H2 Dim addr As Byte = $"&H{Hex(NudTVAddress.Value)}" Dim sendPacket As Byte() = FillInfraredSearchPacket(content, addr) _port485 = $"&H{Hex(FrmRCU.NudSerialAppPort.Value)}" _timeouts = $"&H{Hex(FrmRCU.NudTimeOut3.Value)}" sendPacket = FillPacket(sendPacket) '组包 SendData(sendPacket) '发送数据 End Sub ''' ''' 电视固件搜索 ''' ''' ''' Private Sub BtnTVFirmwareSearch_Click(sender As Object, e As EventArgs) Handles BtnTVFirmwareSearch.Click _InfraredReceProcessing = True Dim content As Byte = &H0 Dim addr As Byte = $"&H{Hex(NudTVAddress.Value)}" Dim sendPacket As Byte() = FillInfraredSearchPacket(content, addr) _port485 = $"&H{Hex(FrmRCU.NudSerialAppPort.Value)}" _timeouts = $"&H{Hex(FrmRCU.NudTimeOut3.Value)}" sendPacket = FillPacket(sendPacket) '组包 SendData(sendPacket) '发送数据 End Sub ''' ''' 电视导入 ''' ''' ''' Private Sub BtnTVImport_Click(sender As Object, e As EventArgs) Handles BtnTVImport.Click If OpenFileDialog1.ShowDialog() = DialogResult.OK Then TextBox1.Text = OpenFileDialog1.FileName CBoTVBrand.Text = Nothing CBoTVModel.Text = Nothing CBoTVVersion.Text = Nothing End If End Sub Private Function ComparativeVersion(newver As Integer, oldver As Integer) As Boolean If (newver <= oldver) Then Return True End If Return False End Function ''' ''' 电视烧录 ''' ''' ''' Private Sub BtnTVBurn_Click(sender As Object, e As EventArgs) Handles BtnTVBurn.Click IsFVer = True Fw_Ver = -1 BtnTVFirmwareSearch.PerformClick() Dim task As Task = Task.Run(Async Function() ' 非阻塞等待3秒 Await Task.Delay(3000) TVBThread() End Function) End Sub Public Sub TVBThread() If InvokeRequired Then Dim s As Action = AddressOf BtnTVBurnThread Me.Invoke(s) Else BtnTVBurnThread() End If End Sub Public Sub BtnTVBurnThread() If IsFVer Then IsFVer = False MsgBox("询问版本失败！！烧录停止！") Return End If Dim ofwver As Integer = -1 Integer.TryParse(Label5.Text, ofwver) If Fw_Ver = -1 OrElse ofwver = -1 Then MsgBox($"获取版本异常！！烧录停止！所需最低固件版本{ofwver}，红外目前版本{Fw_Ver}") Return End If If Not ComparativeVersion(ofwver, Fw_Ver) Then If MsgBox($"强制烧录可能导致无法常工作{vbCrLf }最低固件版本{ofwver}，红外目前版本{Fw_Ver}{vbCrLf }是否强制烧录？", MsgBoxStyle.OkCancel) = MsgBoxResult.Ok Then Else Return End If End If _InfraredReceProcessing = True ProgressBar1.Value = 0 If TextBox1.Text = Nothing Then ' MsgBox("文件为空，请选择要烧录的文件!") Exit Sub End If _isTvDownload = True Dim content As Byte = &H2 Dim addr As Byte = $"&H{Hex(NudTVAddress.Value)}" Dim dataFile() As Byte = OpenTvDATFile() If dataFile Is Nothing Then MsgBox("文件错误，请重新选择文件!") Exit Sub End If EnquiryToDownload(content, addr, dataFile) AppendTipText($"询问RCU主机是否可以下发电视..." & vbCrLf, Color.Green) BtnTVBurn.Text = $"停止烧录" If ReplyToDownload() = True Then DownloadTheTvData() Else BtnTVBurn.Text = $"开始烧录" Exit Sub End If End Sub ''' ''' 填充电视通讯包 ''' Private Function FillTVCommPackage(content As Byte) Dim dataPacket As New List(Of Byte) dataPacket.AddRange(AirPackageHead()) dataPacket.AddRange(FillTVDataPackage(content)) Return dataPacket.ToArray End Function ''' ''' 填充电视数据包 ''' ''' ''' Private Function FillTVDataPackage(content As Byte) Dim dataLen As Byte Dim packetType As Byte = &H4 Dim deviceType As Byte = &H2 Dim packetAddress As Byte = $"&H{Hex(NudTVAddress.Value)}" Dim packetTemp As Byte = content Dim data As New List(Of Byte) data.Add(packetType) data.Add(deviceType) data.Add(packetAddress) data.Add(packetTemp) dataLen = $"&H{Hex(data.ToArray.Length + 3)}" Dim dataPacket As New List(Of Byte) dataPacket.Add(dataLen) dataPacket.AddRange(data) Dim packetfileCrc() As Byte packetfileCrc = FillPacketFileCRC(dataPacket.ToArray) Dim dataList As New List(Of Byte) dataList.AddRange(dataPacket) dataList.AddRange(packetfileCrc) Return dataList.ToArray End Function ''' ''' 下载电视数据 ''' Private Sub DownloadTheTvData() If _isPrepare = True Then AppendTipText($"当前RCU主机已准备就绪" & vbCrLf, Color.Green) '开始下发 ProgressBar1.Value = 0 If _isDownInfraredFile = False Then _upDownInfraredTvThread = New Thread(AddressOf DownRCUTvFileToInfrared) _upDownInfraredTvThread.Start() _isDownInfraredFile = True BtnTVBurn.Text = $"停止烧录" Else If MsgBox("当前处于红外烧录状态,确定结束烧录?", MsgBoxStyle.YesNo, $"Tip") = MsgBoxResult.Yes Then _upDownInfraredTvThread.Abort() _isDownInfraredFile = False _isPrepare = False BtnTVBurn.Text = $"开始烧录" ProgressBar1.Value = 0 AppendTipText($"已终止下载，下载失败！" & vbCrLf, Color.Red) End If End If End If End Sub ''' ''' RCU红外下发电视数据 ''' Private Sub DownRCUTvFileToInfrared() Dim dataFile() As Byte = OpenTvDATFile() If dataFile Is Nothing Then MsgBox("文件错误，请重新选择文件!") Exit Sub End If Console.WriteLine($"电视文件为：{ByteToString(dataFile)}") Dim blockCount As Integer = GetBlocks(dataFile) Dim burnPackage() As Byte ChangePrgTVBurnValue(5, 0) Dim packageNumber As Integer For packageNumber = 1 To blockCount _isInfraredreply = False burnPackage = FillTvBurnPackage(dataFile, packageNumber, blockCount) AppendTipText($"开始发送第{packageNumber}包数据..." & vbCrLf, Color.Blue) burnPackage = FillPacket(burnPackage) '组包 SendData(burnPackage) '发送数据 Console.WriteLine($"第{packageNumber}包:{ByteToString(burnPackage)}") ChangeTvPrgValue(packageNumber, blockCount, 0) WaitInfraredForRelay() If _isInfraredreply = True Then '判断是回复 If packageNumber = blockCount Then _isDownInfraredFile = False ChangePrgTVBurnValue(100, 1) AppendTipText($"电视烧录完成!" & vbCrLf, Color.Blue) MsgBox($"电视烧录完成!") _upDownInfraredTvThread.Abort() Return End If Else _resend += 1 If _resend <= 3 Then AppendTipText($"开始重发次数：{_resend}次" & vbCrLf, Color.Blue) packageNumber -= 1 Else AppendTipText($"已超出最大重发次数！" & vbCrLf, Color.Red) AppendTipText($"下载失败！" & vbCrLf, Color.Red) ChangePrgTVBurnValue(0, 1) _change = True _resend = 0 _isPrepare = False _isDownInfraredFile = False Return End If End If Next End Sub ''' ''' 填充烧录包数据 ''' ''' ''' ''' ''' Private Function FillTvBurnPackage(padData() As Byte, blockIndex As Integer， blockCount As Integer) As Byte() Dim dataLen As Byte Dim packetType As Byte = &H4 Dim packetCmd As Byte = &HA7 Dim packetAddress As Byte = $"&H{Hex(NudTVAddress.Value)}" Dim packetRegister As Byte = &H2 Dim packetfileCrc() As Byte Dim data As New List(Of Byte) data.Add(packetType) data.Add(packetCmd) data.Add(packetAddress) data.Add(packetRegister) data.Add(blockIndex) data.AddRange(FillBurnOnePackage(padData, blockIndex, blockCount)) dataLen = $"&H{Hex(data.ToArray.Length + 3)}" Dim list As New List(Of Byte) list.Add(dataLen) list.AddRange(data) packetfileCrc = FillPacketFileCRC(list.ToArray) Dim dataList As New List(Of Byte) dataList.AddRange(AirPackageHead) dataList.AddRange(list) dataList.AddRange(packetfileCrc) Return dataList.ToArray End Function #End Region #Region "录入读取---数据库" ''' ''' 密码窗体 ''' Private _frmPass As FrmPassword ''' ''' 下载文件路径 ''' Private _downFile As String = $"{Application.StartupPath}\DownFile" ''' ''' 初始化数据表信息——数据库RCU表 ''' Private Sub InitSQLDataTable() GrdSqlData.DisplayRowNumber = True GrdSqlData.ExtendLastCol = True GrdSqlData.Cols = 9 '设置表格界限 GrdSqlData.Rows = 3 With GrdSqlData.Cell(0, 1) .Text = "产品类型" .BackColor = Color.LightGray .ForeColor = Color.Blue .Font = New Font("Arial", 8, FontStyle.Bold) End With With GrdSqlData.Cell(0, 2) .Text = "产品厂商" .BackColor = Color.LightGray .ForeColor = Color.Blue .Font = New Font("Arial", 8, FontStyle.Bold) End With With GrdSqlData.Cell(0, 3) .Text = "产品型号" .BackColor = Color.LightGray .ForeColor = Color.Blue .Font = New Font("Arial", 8, FontStyle.Bold) End With With GrdSqlData.Cell(0, 4) .Text = "版本信息" .BackColor = Color.LightGray .ForeColor = Color.Blue .Font = New Font("Arial", 8, FontStyle.Bold) End With With GrdSqlData.Cell(0, 5) .Text = "创建时间" .BackColor = Color.LightGray .ForeColor = Color.Blue .Font = New Font("Arial", 8, FontStyle.Bold) End With With GrdSqlData.Cell(0, 6) .Text = "数据校验" .BackColor = Color.LightGray .ForeColor = Color.Blue .Font = New Font("Arial", 8, FontStyle.Bold) End With With GrdSqlData.Cell(0, 7) .Text = "备注" .BackColor = Color.LightGray .ForeColor = Color.Blue .Font = New Font("Arial", 8, FontStyle.Bold) End With With GrdSqlData.Cell(0, 8) .Text = "固件版本" .BackColor = Color.LightGray .ForeColor = Color.Blue .Font = New Font("Arial", 8, FontStyle.Bold) End With End Sub ''' ''' 选择文件 ''' ''' ''' Private Sub BtnSelectFile_Click(sender As Object, e As EventArgs) Handles BtnSelectFile.Click GetFileInfo() End Sub ''' ''' 获取选择文件信息 ''' Private Sub GetFileInfo() TboPacketName.Text = Nothing TboxType.Text = Nothing TboxBrand.Text = Nothing TboxModel.Text = Nothing TboxVersion.Text = Nothing Dim fileName As String = SelectFileHandling() If fileName Is Nothing Then MsgBox($"文件为空! 请重新选择文件") Exit Sub End If Console.WriteLine($"选择文件名：{fileName}") Dim result As New List(Of String) Dim tmpString() As String = fileName.Split(New Char() {"_"c}, StringSplitOptions.RemoveEmptyEntries) result.AddRange(tmpString) Dim type As String = result(0) Dim brand As String = result(1) Dim model As String = result(2) Dim temVer As String = result(3) Dim results As New List(Of String) Dim tmpVerString() As String = temVer.Split(New Char() {"."c}, StringSplitOptions.RemoveEmptyEntries) results.AddRange(tmpVerString) Dim version As String = results(0) Console.WriteLine($"类型：{type} 厂商：{brand} 型号：{model} 版本：{version}") TboxType.Text = type TboxBrand.Text = brand TboxModel.Text = model TboxVersion.Text = version End Sub ''' ''' 选择文件处理 ''' ''' Private Function SelectFileHandling() As String Dim fileName As String Using fileDialog As New OpenFileDialog If fileDialog.ShowDialog() <> DialogResult.OK Then Exit Function fileName = fileDialog.SafeFileName TboPacketName.Text = fileDialog.FileName End Using Return fileName End Function ''' ''' 数据录入 ''' ''' ''' Private Sub BtnEntry_Click(sender As Object, e As EventArgs) Handles BtnEntry.Click If WriteProtect() = False Then MsgBox($"录入信息不完整，请填写完整信息!") Exit Sub End If ConnectingToDatabase() RefreshDataTable() End Sub ''' ''' 录入数据 ''' Private Sub ConnectingToDatabase() Dim types As String = TboxType.Text Dim brand As String = TboxBrand.Text Dim model As String = TboxModel.Text Dim version As String = TboxVersion.Text Dim packet As String = $"{types}_{brand}_{model}_{version}.dat" Dim filePaths As String = TboPacketName.Text Dim fileData() As Byte = IO.File.ReadAllBytes(filePaths) Dim md5 As String = GetFileMd5(filePaths) Dim remark As String = TboRemark.Text Dim FW_Ver As String = TextBox4.Text Try Dim connString As String = ConnSQLString() Using db As New DbExecutor(RemoteDbType, connString) db.Open() Dim dbName As String = RemoteDbName Dim tableName As String = "TBL_RCU_InfraredPacket" Dim colName As String Dim colNames As New List(Of String) colName = "Type" colNames.Add(colName) db.AddDbParameter(DbType.AnsiString, colName, types) colName = "Brand" colNames.Add(colName) db.AddDbParameter(DbType.AnsiString, colName, brand) colName = "Model" colNames.Add(colName) db.AddDbParameter(DbType.AnsiString, colName, model) colName = "Version" colNames.Add(colName) db.AddDbParameter(DbType.AnsiString, colName, version) colName = "CreateDate" colNames.Add(colName) db.AddDbParameter(DbType.DateTime, colName, $"{Now:yyyy-MM-dd HH:mm:ss}") colName = "PacketName" colNames.Add(colName) db.AddDbParameter(DbType.AnsiString, colName, packet) colName = "PacketData" colNames.Add(colName) db.AddDbParameter(DbType.Binary, colName, fileData) colName = "PacketMD5" colNames.Add(colName) db.AddDbParameter(DbType.AnsiString, colName, md5) colName = "Remark" colNames.Add(colName) db.AddDbParameter(DbType.String, colName, remark) colName = "FW_Ver" colNames.Add(colName) db.AddDbParameter(DbType.String, colName, FW_Ver) Dim nameCol As New List(Of String) From {"Type", "Brand", "Model", "Version"} Dim cmdTxt As String = db.CmdHelper.DbSearch(dbName, nameCol, tableName, $"{FPrefix}Type{FPrefix} = '{types}' And {FPrefix}Brand{FPrefix} = '{brand}' And {FPrefix}Model{FPrefix} = '{model}' And {FPrefix}Version{FPrefix} = '{version}'") Dim dtTable As DataTable = db.ExecuteDataTable(cmdTxt) Console.WriteLine($"查询语句：{dtTable.Rows.Count}") If dtTable.Rows.Count > 0 Then Dim hint As DialogResult = MessageBox.Show("文件已存在! 是否覆盖？", "提示"， MessageBoxButtons.OKCancel, MessageBoxIcon.Question) If hint = DialogResult.OK Then Dim cmddel As String = db.CmdHelper.DbDeleteRows(dbName, tableName, $"{FPrefix}Type{FPrefix} = '{types}' And {FPrefix}Brand{FPrefix} = '{brand}' And {FPrefix}Model{FPrefix} = '{model}' And {FPrefix}Version{FPrefix} = '{version}'") db.ExecuteNonQuery(cmddel) Console.WriteLine($"删除语句：{cmddel}") Else db.Close() Exit Sub End If End If 'insert into dbName.tablename (1,2,3) value (@1,@2,@3) Dim cmdText As String = db.CmdHelper.DbInsertParam(dbName, tableName, colNames) Console.WriteLine($"录入 cmdText:{cmdText}") db.ExecuteNonQuery(cmdText) MsgBox($"录入成功") db.Close() End Using Catch ex As Exception Console.WriteLine($"Error:{ex.Message}") End Try End Sub ''' ''' 录入保护 ''' ''' Private Function WriteProtect() As Boolean If String.IsNullOrWhiteSpace(TboPacketName.Text) Then Return False If String.IsNullOrWhiteSpace(TboxType.Text) Then Return False If String.IsNullOrWhiteSpace(TboxBrand.Text) Then Return False If String.IsNullOrWhiteSpace(TboxVersion.Text) Then Return False If String.IsNullOrWhiteSpace(TboxModel.Text) Then Return False Return True End Function ''' ''' 刷新数据表 ''' Private Sub RefreshDataTable() InitSQLDataTable() Dim connString As String = ConnSQLString() Try Using db As New DbExecutor(RemoteDbType, connString) db.Open() Dim dbName As String = RemoteDbName Dim tableName As String = "TBL_RCU_InfraredPacket" Dim colNames As New List(Of String) From {"Type", "Brand", "Model", "Version", "CreateDate", "PacketMD5", "Remark", "FW_Ver"} Dim cmdText As String = db.CmdHelper.DbSearch(dbName, colNames, tableName) Dim dtTable As DataTable = db.ExecuteDataTable(cmdText) For r = 0 To dtTable.Rows.Count - 1 GrdSqlData.AddItem("") For c = 0 To dtTable.Columns.Count - 1 GrdSqlData.Cell(r + 1, c + 1).Text = dtTable(r)(c).ToString '注意表格界限 Next Next db.Close() End Using Catch ex As Exception Console.WriteLine($"Error:{ex.Message}") End Try End Sub ''' ''' 刷新列表 ''' ''' ''' Private Sub BtnRefresh_Click(sender As Object, e As EventArgs) Handles BtnRefresh.Click RefreshDataTable() End Sub ''' ''' 刷新列表_菜单栏 ''' ''' ''' Private Sub 刷新列表ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles 刷新列表ToolStripMenuItem.Click RefreshDataTable() End Sub ''' ''' 删除记录_菜单栏 ''' ''' ''' Private Sub 删除记录ToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles 删除记录ToolStripMenuItem.Click DeleteRecord() End Sub ''' ''' 删除记录 ''' Private Sub DeleteRecord() Dim types As String = GrdSqlData.Cell(GrdSqlData.ActiveCell.Row, 1).Text Dim brand As String = GrdSqlData.Cell(GrdSqlData.ActiveCell.Row, 2).Text Dim model As String = GrdSqlData.Cell(GrdSqlData.ActiveCell.Row, 3).Text Dim version As String = GrdSqlData.Cell(GrdSqlData.ActiveCell.Row, 4).Text If GrdSqlData.ActiveCell.Row > 0 Then Dim hint As DialogResult = MessageBox.Show($"要删除的文件信息如下{vbCrLf}{vbCrLf}类型：{types}{vbCr}品牌：{brand}{vbCr}型号：{model}{vbCr}版本：{version}{vbCrLf}{vbCrLf}是否继续删除？", "警告!!!"， MessageBoxButtons.OKCancel, MessageBoxIcon.Question) If hint = DialogResult.OK Then ExecuteDelete(types, brand, model, version) End If End If End Sub ''' ''' 执行删除 ''' Private Sub ExecuteDelete(types As String, brand As String, model As String, version As String) _frmPass = New FrmPassword If _frmPass.ShowDialog = DialogResult.OK Then Console.WriteLine("OK") If _frmPass.IsDelete() = True Then DelRecord(types, brand, model, version) Console.WriteLine("删除完成") GrdSqlData.Selection.DeleteByRow() Else MsgBox($"密码错误") ExecuteDelete(types, brand, model, version) End If Else Console.WriteLine("NO") End If End Sub ''' ''' 执行删除记录 ''' Private Sub DelRecord(types As String, brand As String, model As String, version As String) Dim dbName As String = RemoteDbName Dim tableName As String = "TBL_RCU_InfraredPacket" Try Dim connString As String = ConnSQLString() Using db As New DbExecutor(RemoteDbType, connString) db.Open() Console.WriteLine($"开始删除...") Dim cmddel As String = db.CmdHelper.DbDeleteRows(dbName, tableName, $"`Type` = '{types}' And `Brand` = '{brand}' And `Model` = '{model}' And `Version` = '{version}' ") db.ExecuteNonQuery(cmddel) Console.WriteLine($"删除语句：{cmddel}") GrdSqlData.Selection.DeleteByRow() db.Close() End Using Catch ex As Exception Console.WriteLine($"Start Delete Record Error:{ex.Message}") End Try End Sub #End Region #Region "空调下载---数据库" ''' ''' 空调下载 ''' ''' ''' Private Sub BtnAirDownload_Click(sender As Object, e As EventArgs) Handles BtnAirDownload.Click If DoenloadProtect() = False Then MsgBox($"请选择要下载的空调文件信息!") Exit Sub End If StartDownload() End Sub ''' ''' 下载保护 ''' ''' Private Function DoenloadProtect() As Boolean If CBoAirBrand.Text = "" Or CBoAirBrand.Text = " " Then Return False Exit Function End If If CBoAirType.Text = "" Or CBoAirBrand.Text = " " Then Return False Exit Function End If If CboVersion.Text = "" Or CBoAirBrand.Text = " " Then Return False Exit Function End If Return True End Function ''' ''' 开始下载空调 ''' Private Sub StartDownload() If Directory.Exists(_downFile) = False Then Directory.CreateDirectory(_downFile) Dim brandtxt As String = CBoAirBrand.Text Dim modeltxt As String = CBoAirType.Text Dim versiontxt As String = CboVersion.Text Dim connString As String = ConnSQLString() Try Using db As New DbExecutor(RemoteDbType, connString) db.Open() Dim dbName As String = RemoteDbName Dim tableName As String = "TBL_RCU_InfraredPacket" Dim colNames As New List(Of String) From {"Type", "Brand", "Model", "Version", "PacketName", "PacketData", "PacketMD5"} Dim cmdText As String = db.CmdHelper.DbSearch(dbName, colNames, tableName, $"{FPrefix}Type{FPrefix} = '空调' And {FPrefix}Brand{FPrefix} = '{brandtxt}' And {FPrefix}Model{FPrefix} = '{modeltxt}'And {FPrefix}Version{FPrefix} = '{versiontxt}'") Console.WriteLine($"下载语句：{cmdText}") Dim dtTable As DataTable = db.ExecuteDataTable(cmdText) '云端的MD5值 Dim packetName As String = dtTable(0)("PacketName") Dim md5Cloud As String = dtTable(0)("PacketMD5") Console.WriteLine($"包名:{dtTable(0)("PacketName")}") Dim pData() As Byte = dtTable(0)("PacketData") Console.WriteLine($"数据包数据：{System.Text.UTF8Encoding.UTF8.GetString(pData)}") IO.File.WriteAllBytes($"{_downFile}\{packetName}", pData) PauseWait(200) '本地的MD5值 Dim md5load As String = GetFileMd5($"{_downFile}\{packetName}") Console.WriteLine($"云端MD5值：{md5Cloud}") Console.WriteLine($"本地MD5值：{md5load}") If String.Compare(md5Cloud, md5load) = 0 Then TBoAirImport.Text = $"{_downFile}\{packetName}" MsgBox($"校验完成,文件无误,已导入成功!") Else MsgBox($"校验失败! 请重试") End If db.Close() End Using Catch ex As Exception 'Console.WriteLine($"Strat Download Error:{ex.Message}") MsgBox($"校验失败! 请重试") End Try End Sub ''' ''' 选择厂商 ''' ''' ''' Private Sub CBoAirBrand_DropDown(sender As Object, e As EventArgs) Handles CBoAirBrand.DropDown CBoAirBrand.Items.Clear() SelectBrand() CBoAirType.Text = Nothing CboVersion.Text = Nothing End Sub ''' ''' 选择型号 ''' ''' ''' Private Sub CBoAirType_DropDown(sender As Object, e As EventArgs) Handles CBoAirType.DropDown CBoAirType.Items.Clear() SelectModel() CboVersion.Text = Nothing End Sub ''' ''' 选择版本 ''' ''' ''' Private Sub CboVersion_DropDown(sender As Object, e As EventArgs) Handles CboVersion.DropDown CboVersion.Items.Clear() SelectVersion() End Sub ''' ''' 查询空调品牌 ''' Private Sub SelectBrand() Dim addItems As New List(Of String) Dim connString As String = ConnSQLString() Try Using db As New DbExecutor(RemoteDbType, connString) db.Open() Dim dbName As String = RemoteDbName Dim tableName As String = "TBL_RCU_InfraredPacket" Dim colNames As New List(Of String) From {"Brand"} Dim cmdText As String = db.CmdHelper.DbSearch(dbName, colNames, tableName, $"{FPrefix}Type{FPrefix} = '空调' Group by {FPrefix}Brand{FPrefix}") Console.WriteLine($"TextXXX: {cmdText}") Dim dtTable As DataTable = db.ExecuteDataTable(cmdText) For r = 0 To dtTable.Rows.Count - 1 addItems.Add(dtTable(r)(0)) Next CBoAirBrand.Items.AddRange(addItems.ToArray) db.Close() End Using Catch ex As Exception Console.WriteLine($"厂商 Error:{ex.Message}") End Try End Sub ''' ''' 查询空调型号 ''' Private Sub SelectModel() Dim brandtxt As String = CBoAirBrand.Text Dim addItems As New List(Of String) Dim connString As String = ConnSQLString() Try Using db As New DbExecutor(RemoteDbType, connString) db.Open() Dim dbName As String = RemoteDbName Dim tableName As String = "TBL_RCU_InfraredPacket" Dim colNames As New List(Of String) From {"Model"} Dim cmdText As String = db.CmdHelper.DbSearch(dbName, colNames, tableName, $"{FPrefix}Type{FPrefix} = '空调' And {FPrefix}Brand{FPrefix} = '{brandtxt}' Group by {FPrefix}Model{FPrefix}") 'Dim cmdText As String = db.CmdHelper.DbSearch(dbName, colNames, tableName) '可添加条件 Console.WriteLine($"Model: {cmdText}") Dim dtTable As DataTable = db.ExecuteDataTable(cmdText) For r = 0 To dtTable.Rows.Count - 1 addItems.Add(dtTable(r)(0)) Next CBoAirType.Items.AddRange(addItems.ToArray) db.Close() End Using Catch ex As Exception Console.WriteLine($"型号 Error:{ex.Message}") End Try End Sub ''' ''' 查询空调版本 ''' Private Remark_Li As Dictionary(Of String, String) Private FW_Ver_Li As Dictionary(Of String, String) Private Sub SelectVersion() Dim brandtxt As String = CBoAirBrand.Text Dim modeltxt As String = CBoAirType.Text Dim addItems As New List(Of String) Dim connString As String = ConnSQLString() Try Using db As New DbExecutor(RemoteDbType, connString) db.Open() Dim dbName As String = RemoteDbName Dim tableName As String = "TBL_RCU_InfraredPacket" Dim colNames As New List(Of String) From {"Version", "Remark", "FW_Ver"} Dim cmdText As String = db.CmdHelper.DbSearch(dbName, colNames, tableName, $"{FPrefix}Type{FPrefix} = '空调' And {FPrefix}Brand{FPrefix} = '{brandtxt}' And {FPrefix}Model{FPrefix} = '{modeltxt}' ") 'CZH 查询语句去掉根据版本的分组 Group by {FPrefix}Version{FPrefix} 'Dim cmdText As String = db.CmdHelper.DbSearch(dbName, colNames, tableName) '可添加条件 Console.WriteLine($"Version: {cmdText}") Dim dtTable As DataTable = db.ExecuteDataTable(cmdText) Remark_Li = New Dictionary(Of String, String) FW_Ver_Li = New Dictionary(Of String, String) For r = 0 To dtTable.Rows.Count - 1 addItems.Add(dtTable(r)(0)) If Not Remark_Li.ContainsKey(dtTable(r)(0)) Then Remark_Li.Add(dtTable(r)(0)， dtTable(r)(1)) FW_Ver_Li.Add(dtTable(r)(0)， dtTable(r)(2)) End If Next CboVersion.Items.AddRange(addItems.ToArray) db.Close() End Using Catch ex As Exception Console.WriteLine($"版本 Error:{ex.Message}") End Try End Sub #End Region #Region "电视下载---数据库" ''' ''' 电视下载 ''' ''' ''' Private Sub BtnTvDownload_Click(sender As Object, e As EventArgs) Handles BtnTvDownload.Click If DoenloadTvProtect() = False Then MsgBox($"请选择要下载的电视文件信息!") Exit Sub End If StartTvDownload() End Sub ''' ''' 选择电视品牌 ''' ''' ''' Private Sub CBoTVBrand_DropDown(sender As Object, e As EventArgs) Handles CBoTVBrand.DropDown CBoTVBrand.Items.Clear() SelectTVBrand() CBoTVModel.Text = Nothing CBoTVVersion.Text = Nothing End Sub ''' ''' 选择电视型号 ''' ''' ''' Private Sub CBoTVModel_DropDown(sender As Object, e As EventArgs) Handles CBoTVModel.DropDown CBoTVModel.Items.Clear() SelectTVModel() CBoTVVersion.Text = Nothing End Sub ''' ''' 选择电视版本 ''' ''' ''' Private Sub CBoTVVersion_DropDown(sender As Object, e As EventArgs) Handles CBoTVVersion.DropDown CBoTVVersion.Items.Clear() SelectTvVersion() End Sub ''' ''' 查询电视厂商 ''' Private Sub SelectTVBrand() Dim addItems As New List(Of String) Dim connString As String = ConnSQLString() Try Using db As New DbExecutor(RemoteDbType, connString) db.Open() Dim dbName As String = RemoteDbName Dim tableName As String = "TBL_RCU_InfraredPacket" Dim colNames As New List(Of String) From {"Brand"} Dim cmdText As String = db.CmdHelper.DbSearch(dbName, colNames, tableName, $"{FPrefix}Type{FPrefix} = '电视' Group by {FPrefix}Brand{FPrefix}") Console.WriteLine($"查询厂商语句： {cmdText}") Dim dtTable As DataTable = db.ExecuteDataTable(cmdText) For r = 0 To dtTable.Rows.Count - 1 addItems.Add(dtTable(r)(0)) Next CBoTVBrand.Items.AddRange(addItems.ToArray) db.Close() End Using Catch ex As Exception Console.WriteLine($"电视厂商 Error:{ex.Message}") End Try End Sub ''' ''' 查询电视型号 ''' Private Sub SelectTVModel() Dim brandtxt As String = CBoTVBrand.Text Dim addItems As New List(Of String) Dim connString As String = ConnSQLString() Try Using db As New DbExecutor(RemoteDbType, connString) db.Open() Dim dbName As String = RemoteDbName Dim tableName As String = "TBL_RCU_InfraredPacket" Dim colNames As New List(Of String) From {"Model"} Dim cmdText As String = db.CmdHelper.DbSearch(dbName, colNames, tableName, $"{FPrefix}Type{FPrefix} = '电视' And {FPrefix}Brand{FPrefix} = '{brandtxt}' Group by {FPrefix}Model{FPrefix}") Console.WriteLine($"Model: {cmdText}") Dim dtTable As DataTable = db.ExecuteDataTable(cmdText) For r = 0 To dtTable.Rows.Count - 1 addItems.Add(dtTable(r)(0)) Next CBoTVModel.Items.AddRange(addItems.ToArray) db.Close() End Using Catch ex As Exception Console.WriteLine($"型号 Error:{ex.Message}") End Try End Sub ''' ''' 查询电视型号 ''' Private Sub SelectTvVersion() Dim brandtxt As String = CBoTVBrand.Text Dim modeltxt As String = CBoTVModel.Text Dim addItems As New List(Of String) Dim connString As String = ConnSQLString() Try Using db As New DbExecutor(RemoteDbType, connString) db.Open() Dim dbName As String = RemoteDbName Dim tableName As String = "TBL_RCU_InfraredPacket" Dim colNames As New List(Of String) From {"Version", "Remark", "FW_Ver"} Dim cmdText As String = db.CmdHelper.DbSearch(dbName, colNames, tableName, $"{FPrefix}Type{FPrefix} = '电视' And {FPrefix}Brand{FPrefix} = '{brandtxt}' And {FPrefix}Model{FPrefix} = '{modeltxt}' ") 'Group by {FPrefix}Version{FPrefix} Console.WriteLine($"Version: {cmdText}") Dim dtTable As DataTable = db.ExecuteDataTable(cmdText) FW_Ver_Li = New Dictionary(Of String, String) Remark_Li = New Dictionary(Of String, String) For r = 0 To dtTable.Rows.Count - 1 addItems.Add(dtTable(r)(0)) If Not Remark_Li.ContainsKey(dtTable(r)(0)) Then Remark_Li.Add(dtTable(r)(0)， dtTable(r)(1)) FW_Ver_Li.Add(dtTable(r)(0)， dtTable(r)(2)) End If Next CBoTVVersion.Items.AddRange(addItems.ToArray) db.Close() End Using Catch ex As Exception Console.WriteLine($"版本 Error:{ex.Message}") End Try End Sub ''' ''' 下载电视保护 ''' ''' Private Function DoenloadTvProtect() As Boolean If CBoTVBrand.Text = "" Or CBoTVBrand.Text = " " Then Return False Exit Function End If If CBoTVModel.Text = "" Or CBoTVModel.Text = " " Then Return False Exit Function End If If CBoTVVersion.Text = "" Or CBoTVVersion.Text = " " Then Return False Exit Function End If Return True End Function ''' ''' 开始下载电视文件 ''' Private Sub StartTvDownload() If Directory.Exists(_downFile) = False Then Directory.CreateDirectory(_downFile) Dim brandtxt As String = CBoTVBrand.Text Dim modeltxt As String = CBoTVModel.Text Dim versiontxt As String = CBoTVVersion.Text Dim connString As String = ConnSQLString() Try Using db As New DbExecutor(RemoteDbType, connString) db.Open() Dim dbName As String = RemoteDbName Dim tableName As String = "TBL_RCU_InfraredPacket" Dim colNames As New List(Of String) From {"Type", "Brand", "Model", "Version", "PacketName", "PacketData", "PacketMD5"} Dim cmdText As String = db.CmdHelper.DbSearch(dbName, colNames, tableName, $"{FPrefix}Type{FPrefix} = '电视' And {FPrefix}Brand{FPrefix} = '{brandtxt}' And {FPrefix}Model{FPrefix} = '{modeltxt}'And {FPrefix}Version{FPrefix} = '{versiontxt}'") Console.WriteLine($"下载电视语句：{cmdText}") Dim dtTable As DataTable = db.ExecuteDataTable(cmdText) '云端的MD5值 Dim packetName As String = dtTable(0)("PacketName") Dim md5Cloud As String = dtTable(0)("PacketMD5") Console.WriteLine($"电视包名:{dtTable(0)("PacketName")}") Dim pData() As Byte = dtTable(0)("PacketData") Console.WriteLine($"电视包数据：{System.Text.UTF8Encoding.UTF8.GetString(pData)}") IO.File.WriteAllBytes($"{_downFile}\{packetName}", pData) PauseWait(200) '本地的MD5值 Dim md5load As String = GetFileMd5($"{_downFile}\{packetName}") Console.WriteLine($"云端MD5值：{md5Cloud}") Console.WriteLine($"本地MD5值：{md5load}") If String.Compare(md5Cloud, md5load) = 0 Then TextBox1.Text = $"{_downFile}\{packetName}" MsgBox($"校验完成,文件无误,已导入成功!") Else MsgBox($"校验失败! 请重试") End If db.Close() End Using Catch ex As Exception Console.WriteLine($"Strat Download Error:{ex.Message}") End Try End Sub #End Region #End Region #Region "添加记录" ''' ''' 添加记录 ''' ''' ''' Private Sub AppendTipText(recordString As String, col As Color) ' FrmRCU.AppendTipText(recordString, col) If InvokeRequired Then Invoke(New Action(Sub() FrmRCU.AppendTipText(recordString, col) End Sub)) Else FrmRCU.AppendTipText(recordString, col) End If End Sub Private Sub CboVersion_SelectedIndexChanged(sender As Object, e As EventArgs) Handles CboVersion.SelectedIndexChanged If Remark_Li.ContainsKey(CboVersion.Text) Then TextBox2.Text = Remark_Li.Item(CboVersion.Text) Label6.Text = FW_Ver_Li.Item(CboVersion.Text) End If End Sub 'CZH 20240313 增加電視備注顯示 Private Sub CBoTVVersion_TabIndexChanged(sender As Object, e As EventArgs) Handles CBoTVVersion.SelectedIndexChanged If Remark_Li.ContainsKey(CBoTVVersion.Text) Then TextBox3.Text = Remark_Li.Item(CBoTVVersion.Text) Label5.Text = FW_Ver_Li.Item(CBoTVVersion.Text) End If End Sub Private Sub TextBox4_KeyPress(sender As Object, e As KeyPressEventArgs) Handles TextBox4.KeyPress ' 允许输入数字、Backspace和退出键 If Not Char.IsControl(e.KeyChar) AndAlso Not Char.IsDigit(e.KeyChar) AndAlso e.KeyChar <> ChrW(8) Then e.Handled = True End If End Sub Public cntinde As Integer = 0 Private Sub Label89_Click(sender As Object, e As EventArgs) Handles Label89.Click cntinde = cntinde + 1 If cntinde = 5 Then TabPage2.Parent = TabControl3 cntinde = 0 TextBox2.Visible = True TextBox3.Visible = True Label2.Visible = True Label1.Visible = True Else TabPage2.Parent = Nothing TextBox2.Visible = False TextBox3.Visible = False Label2.Visible = False Label1.Visible = False End If End Sub #End Region End Class