Imports System.Threading Public Class Frm485Update Implements IModuleForm #Region "窗体" ''' ''' 窗体加载函数 ''' ''' ''' Private Sub Frm485Update_Load(sender As Object, e As EventArgs) Handles Me.Load InitDevInfo() InitTypeGirdInfo() End Sub ''' ''' 显示窗体_接口 ''' ''' 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) FrmRCU.SendData(sendPacket) '方法1 End Sub #End Region #Region "485升级" #Region "设备表信息" ''' ''' 枚举表格设备列信息 ''' Enum EnTypeColInfo ''' NULL Null ''' 是否选中 Check ''' 设备地址 DevAddr ''' 设备名称 DevName ''' 状态_区域 Status ''' 结果 Result End Enum ''' 类型表的列集合 Private _typeGirdCols() As String = {"0", "是否选中", "设备地址", "设备名称", "设备分区", "升级结果"} ''' ''' 初始化设备表格信息 ''' Private Sub InitTypeGirdInfo() GrdTypeInfo.DisplayRowNumber = True GrdTypeInfo.ExtendLastCol = True GrdTypeInfo.Cols = _typeGirdCols.Length GrdTypeInfo.Rows = 1 For index = 1 To _typeGirdCols.Length - 1 With GrdTypeInfo.Cell(EnTypeColInfo.Null, index) .Text = _typeGirdCols(index) .BackColor = Color.LightGray .ForeColor = Color.Blue .Font = New Font("Arial", 8, FontStyle.Bold) End With Next '是否选中_文本对齐,单元格宽度 GrdTypeInfo.Column(EnTypeColInfo.Check).CellType = FlexCell.CellTypeEnum.CheckBox 'GrdTypeInfo.Cell(1, EnTypeColInfo.Check).Text = $"0" GrdTypeInfo.Column(EnTypeColInfo.Check).Alignment = FlexCell.AlignmentEnum.CenterCenter GrdTypeInfo.Column(EnTypeColInfo.Check).Width = 80 '设备地址_文本对齐,单元格宽度 GrdTypeInfo.Column(EnTypeColInfo.DevAddr).Alignment = FlexCell.AlignmentEnum.CenterCenter GrdTypeInfo.Column(EnTypeColInfo.DevAddr).Width = 80 '设备名称_文本对齐,单元格宽度 GrdTypeInfo.Column(EnTypeColInfo.DevName).Alignment = FlexCell.AlignmentEnum.CenterCenter GrdTypeInfo.Column(EnTypeColInfo.DevName).Width = 180 '设备分区_文本对齐,单元格宽度 GrdTypeInfo.Column(EnTypeColInfo.Status).Alignment = FlexCell.AlignmentEnum.CenterCenter GrdTypeInfo.Column(EnTypeColInfo.Status).Width = 80 End Sub #End Region #Region "485升级初始化" ''' 设备项目列表 Private _devNameList() As String = {"None 485", "PB 485", "BLV_C1"} ''' 单包数据字节长度 Private _packagebyte() As String = {"128", "256", "512", "1024", "2048", "4096"} ''' 发送数据序号 Private _dataNumber As Byte = 0 Const _loadFileSize As Integer = 512 * 1024 Const _loadDataSize As Integer = 512 * 1024 Private _LoadHexFileData(_loadFileSize - 1) As Byte Private _LoadDataBuff(_loadDataSize - 1) As Byte Private _LoadEndAddr As Integer Private _HexStart_C1 As Integer = 0 ''' ''' 初始化设备列表 ''' Private Sub InitDevInfo() ComboBox1.Items.Clear() ComboBox1.Items.AddRange(_devNameList) If ComboBox1.Items.Count >= 3 Then ComboBox1.SelectedIndex = 2 ComboBox2.Items.Clear() ComboBox2.Items.AddRange(_packagebyte) If ComboBox2.Items.Count >= 3 Then ComboBox2.SelectedIndex = 2 End Sub ''' ''' 设备类型转换 ''' ''' ''' Private Sub ComboBox1_SelectedIndexChanged(sender As Object, e As EventArgs) Handles ComboBox1.SelectedIndexChanged If ComboBox1.SelectedIndex = 0 Or ComboBox1.SelectedIndex = 1 Then If ComboBox2.Items.Count > 1 Then ComboBox2.SelectedIndex = 0 End If End If End Sub #End Region #Region "串口固件升级组包" ''' ''' 填充串口升级包 ''' ''' ''' ''' Private Function FillSendPacket(cmd As Byte, data As Byte()) Dim databuff As Byte() Select Case ComboBox1.Text Case _devNameList(0), _devNameList(1) 'databuff = FillSendPacket485(cmd, data) Case _devNameList(2) databuff = FillSendPacketC1(cmd, data) Case Else End Select Return databuff End Function ''' ''' 填充C1发送包 ''' ''' 命令码 ''' Data数组 ''' Private Function FillSendPacketC1(cmd As Byte, data As Byte()) Dim sendNumber As Byte = GetSendNumber() '发送序号 Dim len(1) As Byte '数据长度,占2个字节 Dim dataSum As Byte '校验和 Dim length As Integer = 5 + data.Length len = IntToByteLB(length) Dim databuff As New List(Of Byte) databuff.Add(sendNumber) databuff.Add(cmd) databuff.AddRange(len) databuff.AddRange(data) dataSum = GetSumCheckMod(databuff.ToArray) databuff.Insert(4, dataSum) Return databuff.ToArray End Function ''' ''' 获取发送序号 ''' ''' Private Function GetSendNumber() _dataNumber += 1 If _dataNumber > 15 Then _dataNumber = 1 End If Return _dataNumber End Function #End Region ''' ''' 判断设备类型 ''' Private Sub SelectDevice() If ComboBox1.Text <> _devNameList(2) Then FrmRCU._isDeviceC1 = True Else FrmRCU._isDeviceC1 = False End If End Sub ''' ''' 搜索 ''' ''' ''' Private Sub BtnSearch_Click(sender As Object, e As EventArgs) Handles BtnSearch.Click Dim startValue As Integer = NumericUpDown1.Value Dim endValue As Integer = NumericUpDown2.Value SelectDevice() BtnUpdateFile.Enabled = False SearchData(startValue, endValue) BtnUpdateFile.Enabled = True End Sub ''' ''' 搜索数据 ''' ''' ''' Private Sub SearchData(startValue As Integer, endValue As Integer) Dim cmd As Byte For count = 0 To 1 If count = 0 Then FrmRCU.SerialPort.BaudRate = 2400 PauseWait(1) cmd = &H63 Else FrmRCU.SerialPort.BaudRate = CInt(FrmRCU.CboSerialBaud.Text) PauseWait(1) cmd = &H1 End If For index = startValue To endValue If startValue > endValue Then index = endValue End If Dim indexs(0) As Byte indexs(0) = index Dim sendPacket As Byte() If cmd = &H63 Then 'Boot区搜索 Dim data As Byte() = GetAppSearchData(index) sendPacket = FillSendPacket(cmd, data) Console.WriteLine($"Boot区搜索{index}:{ByteToString(sendPacket)}") ElseIf cmd = &H1 Then 'App区搜索 sendPacket = FillSendPacket(cmd, indexs) Console.WriteLine($"App区搜索{index}:{ByteToString(sendPacket)}") End If sendPacket = FillPacket(sendPacket) '是否填充透传数据包 SendData(sendPacket) '发送数据包 Next Next End Sub ''' ''' Boot区搜索数据 ''' ''' ''' Private Function GetAppSearchData(index As Byte) As Byte() Dim data As New List(Of Byte) data.Add(index) data.Add(&H0) '超时时间H data.Add(&H14) '超时时间H Return data.ToArray End Function ''' ''' 搜索范围值_委托 ''' ''' ''' Delegate Sub Delegate_SearchRangeValue_Change(ByRef startValue As Integer, ByRef endValue As Integer) ''' ''' 委托搜索范围值 ''' ''' ''' Private Sub SearchRangeValue(ByRef startValue As Integer, ByRef endValue As Integer) If Me.InvokeRequired = True Then Dim a As New Delegate_SearchRangeValue_Change(AddressOf SearchRangeValue) Me.Invoke(a, New Object() {startValue, endValue}) Else startValue = NumericUpDown1.Value endValue = NumericUpDown2.Value End If End Sub ''' ''' 选择下发文件改变 ''' ''' ''' Private Sub TextBox1_TextChanged(sender As Object, e As EventArgs) Handles TextBox1.TextChanged _flashData = Nothing '重新选择,置空 End Sub ''' ''' 选择文件 ''' ''' ''' Private Sub BtnSelectFile_Click(sender As Object, e As EventArgs) Handles BtnSelectFile.Click _flashData = Nothing '重新选择,置空 Dim dlg As New OpenFileDialog dlg.InitialDirectory = Application.StartupPath dlg.Filter = "HEX File|*.hex||" Dim oldPath As String = TextBox1.Text If IO.File.Exists(oldPath) Then dlg.InitialDirectory = IO.Path.GetDirectoryName(oldPath) dlg.FileName = oldPath Else dlg.InitialDirectory = Application.StartupPath End If If dlg.ShowDialog() = DialogResult.OK Then TextBox1.Text = dlg.FileName 'BtnSelectFile.PerformClick() End If 'Todo:解析Hex文件 Dim path As String = TextBox1.Text ThreadPool.QueueUserWorkItem(AddressOf DealHexFile, path) End Sub ''' ''' 状态栏解析文本委托 ''' 改变文本和颜色 ''' ''' ''' ''' Delegate Sub Delegate_StateLabel_Change(text As String, color As Color, flg As Boolean) ''' ''' 状态栏解析文本 ''' 改变文本和颜色 ''' ''' ''' ''' Private Sub StateLabel(text As String, color As Color, flg As Boolean) If Me.InvokeRequired = True Then Dim a As New Delegate_StateLabel_Change(AddressOf StateLabel) Me.Invoke(a, New Object() {text, color, flg}) Else TSSLbl1.ForeColor = color TSSLbl1.Text = text BtnUpdateFile.Enabled = flg End If End Sub #Region "解析Hex文件" ''' ''' 解析Hex文件 ''' ''' Private Sub DealHexFile(filePath As String) StateLabel($"正在解析......", Color.Blue, False) Dim tmpRet As Boolean = LoadDataFromFile(filePath) Dim checkSum(3) As Byte Dim tmpStrCks As String = "" Dim tmpIdx As Integer = 0 Dim tmpLineCnt As Integer = 1 Dim tmpStrBuffer As String = "" Dim tmpHexValidLenght As Integer = _LoadEndAddr - _HexStart_C1 If tmpRet Then For tmpIdx = _HexStart_C1 To _LoadEndAddr - 1 tmpStrBuffer = tmpStrBuffer & HexByteStr(_LoadDataBuff(tmpIdx)) & " " If tmpIdx > 0 And (tmpIdx + 1) Mod 16 = 0 Then tmpLineCnt = tmpLineCnt + 1 'Todo:加进度条显示 tmpStrBuffer = tmpStrBuffer & vbCrLf End If Next MsgBox("Hex 加载成功!" & vbCrLf & "起始偏移地址 :" & _HexStart_C1 & vbCrLf & " 结束地址 :" & _LoadEndAddr & vbCrLf & " 文件长度 :" & tmpHexValidLenght & vbCrLf ) StateLabel($"解析完成", Color.Green, True) _flashData = tmpStrBuffer Console.WriteLine($"解析出的数据:{vbCrLf}{tmpStrBuffer}") 'GetSumCheck(_LoadDataBuff, _LoadEndAddr, checkSum) 'tmpStrCks = HexByteStr(checkSum(3)) 'tmpStrCks = tmpStrCks & " " & HexByteStr(checkSum(2)) 'tmpStrCks = tmpStrCks & " " & HexByteStr(checkSum(1)) 'tmpStrCks = tmpStrCks & " " & HexByteStr(checkSum(0)) 'lab_HexLastModifyDate.Text = IO.File.GetLastWriteTime(Tb_HexFilePath.Text) 'lab_HexDataLenght.Text = Format(tmpHexValidLenght, "###,###") & " Bytes" 'lab_HexDataCks.Text = tmpStrCks 'Me.Text = "Massduino Nano485 Loader(" & Application.ProductVersion & ")" & " - " & Tb_HexFilePath.Text Else 'lab_HexDataLenght.Text = "" 'lab_HexDataCks.Text = "" End If End Sub ''' ''' 加载hex文件数据 ''' ''' ''' Private Function LoadDataFromFile(ByVal path As String) As Boolean Array.Clear(_LoadHexFileData, 0, _LoadHexFileData.Length) Try Dim fs As New IO.FileStream(path, IO.FileMode.Open, IO.FileAccess.Read) If fs.Length <= _loadFileSize Then fs.Read(_LoadHexFileData, 0, fs.Length) Else Return False End If fs.Close() Catch ex As Exception Return False End Try Return HexFileToData(_LoadHexFileData, _LoadDataBuff, _LoadEndAddr) End Function ''' ''' 解析Hex文件到Byte数组 ''' ''' ''' ''' ''' Private Function HexFileToData(ByVal hexBuffer() As Byte, ByVal dataBuffer() As Byte, ByRef endAddr As Integer) As Boolean Dim i As Integer '行数 Dim LineCnt As Integer = 0 Dim DataType_00_Idx As Integer = 0 '清空数据缓存区域 For i = 0 To dataBuffer.Length - 1 dataBuffer(i) = &HFF Next '本行数据缓存 Dim dataStrBuf(31) As Byte Dim dataValBuf(15) As Byte '首地址标记 Dim headAddrFlag As Boolean = True '本行地址值 Dim tmpLineAdd As Integer = 0 '偏移地址 0x04 数据类型指示偏移地址 Dim LineAddOffestBase As Integer = 0 '结束地址 endAddr = 0 Dim flashAddressBuf(3) As Byte Dim flashAddress As Integer 'Hex格式解析,每一行以0D 0A结束 '文本串::1000000000800020A500010061090100AF0001008F '分解为20 Bytes Hex数据 ' '--- | ----- | ---| ----------------------------------------------------------|---- 'Len | ADD |Type| Data | CKS '--- | ----- | ---| ----------------------------------------------------------|---- ' B0 | B1 B2 | B3 | B4 B5 B6 B7 B8 B9 B10 B11 B12 B13 B14 B15 B16 B17 B18 B19 | B20 ':10 | 00 00 | 00 | 00 80 00 20 A5 00 01 00 61 09 01 00 AF 00 01 00 | 8F ' ---| -----| ---| ----------------------------------------------------------|---- '1: 每行固定以“:”开头 '2:B0 :数据长度 '3:B1~B2 :数据地址 B1为地址高位,B2为地址低位 '4:B3 :数据类型 ' 00' Data Record //数据记录 ' 01' End of File Record //文件结束记录 ' 02' Extended Segment Address Record //扩展段地址记录 ' 03' Start Segment Address Record //开始段地址记录 ' 04' Extended Linear Address Record //扩展线性地址记录 ' 05' Start Linear Address Record //开始线性地址记录 '5:B4~B19 :数据内容 '6:B20 :校验码 '’'''''''''''’'' 'Hex 数据首地址确认方式:将第一个00类型的数据的地址作为起始地址 '因此,最低地址必须出现在第一个00类型数据中 For i = 0 To hexBuffer.Length - 1 '首先找到冒号 If hexBuffer(i) = &H3A Then '&H3A = ":" LineCnt += 1 'B0:数据长度 Dim dataLen As Integer = (StrToHex(hexBuffer(i + 1)) * 16 + StrToHex(hexBuffer(i + 2))) If dataLen > 0 Then 'By:CheckSum Dim checkSum As Byte = (StrToHex(hexBuffer(i + 9 + dataLen * 2)) * 16 + StrToHex(hexBuffer(i + 10 + dataLen * 2))) '取出整行数据 Dim rowDataStrBuf(41) As Byte Dim rowDataValBuf(20) As Byte Dim rowLen As Integer Array.Clear(rowDataStrBuf, 0, 42) Array.Clear(rowDataValBuf, 0, 21) rowLen = (dataLen * 2) + 10 Array.Copy(hexBuffer, i + 1, rowDataStrBuf, 0, rowLen) StrToHex(rowDataValBuf, rowDataStrBuf, rowLen / 2) Dim tempCheckSum As Byte = GetSumChecks(rowDataValBuf, rowLen / 2) If tempCheckSum <> &HFF Then Return False 'CheckSum校验不通过,返回错误 End If 'B4~Bx:数据内容 Array.Clear(dataStrBuf, 0, 32) Array.Clear(dataValBuf, 0, 16) Array.Copy(hexBuffer, i + 9, dataStrBuf, 0, dataLen * 2) StrToHex(dataValBuf, dataStrBuf, dataLen) End If 'B1~B2:取出地址位的值 Array.Copy(hexBuffer, i + 3, flashAddressBuf, 0, 4) '本行地址取出来放在 flashAddress中’ StrToHex(tmpLineAdd, flashAddressBuf) flashAddress = LineAddOffestBase + tmpLineAdd 'B3:数据类型 Dim dataType = StrToHex(hexBuffer(i + 8)) Select Case dataType Case 0 '数据记录 DataType_00_Idx = DataType_00_Idx + 1 '将第一个00类型数据的地址作为起始地址, 保存到 _HexStart_C1 If DataType_00_Idx = 1 Then _HexStart_C1 = flashAddress End If Array.Copy(dataValBuf, 0, dataBuffer, flashAddress, dataLen) endAddr = flashAddress + dataLen Case 1 '文件结束 If endAddr = 0 Then Return False Else Return True End If Case 2, 3, 5 '扩展段地址, 开始段地址, 开始线性地址’ Continue For Case 4 '扩展线性地址 If dataLen = 2 Then LineAddOffestBase = (dataValBuf(0) * 256 + dataValBuf(1)) * 65536 Else Return False '确认DataLen必须是2,否则报错 End If Case Else Return False End Select End If Next Return False End Function Private Function HexByteStr(hexByte As Byte) As String If hexByte < 16 Then Return "0" & Hex(hexByte) Else Return Hex(hexByte) End If End Function ''' ''' 获取和校验 ''' ''' ''' ''' Private Sub GetSumCheck(ByVal buf() As Byte, ByVal len As UInt32, ByRef resultBuf() As Byte) Dim sum As Integer = 0 Dim i As Integer = 0 Dim j As Integer = 0 Dim retByte As Integer Do For j = 0 To 127 sum += buf(i + j) sum = sum And &HFFFFFFFF Next i += 128 Loop Until i >= len retByte = sum resultBuf(0) = (retByte \ &H1000000) And &HFF resultBuf(1) = (retByte \ &H10000) And &HFF resultBuf(2) = (retByte \ &H100) And &HFF resultBuf(3) = retByte And &HFF End Sub Private Sub StrToHex(pbDest() As Byte, pbSrc() As Byte, nLen As UInt16) Dim h1 As Byte Dim h2 As Byte Dim s1 As Byte Dim s2 As Byte Dim i As Integer For i = 0 To nLen - 1 h1 = pbSrc(2 * i) h2 = pbSrc(2 * i + 1) s1 = toupper(h1) - &H30 If s1 > 9 Then s1 -= 7 End If s2 = toupper(h2) - &H30 If s2 > 9 Then s2 -= 7 End If pbDest(i) = s1 * 16 + s2 Next End Sub Private Sub StrToHex(ByRef pbDest As UInt16, pbSrc() As Byte) Dim pBufDest(1) As Byte Dim h1 As Byte Dim h2 As Byte Dim s1 As Byte Dim s2 As Byte Dim i As UInt16 For i = 0 To 2 - 1 h1 = pbSrc(2 * i) h2 = pbSrc(2 * i + 1) s1 = toupper(h1) - &H30 If s1 > 9 Then s1 -= 7 End If s2 = toupper(h2) - &H30 If s2 > 9 Then s2 -= 7 End If pBufDest(i) = s1 * 16 + s2 Next 'pbDest = (pBufDest(0) << 8) + pBufDest(1) pbDest = pBufDest(0) * 256 + pBufDest(1) End Sub Private Function StrToHex(ByVal src) As Byte If src >= &H30 AndAlso src <= &H39 Then Return (src - &H30) ElseIf src >= &H41 AndAlso src <= &H46 Then Return (src - &H41 + 10) ElseIf src >= &H61 AndAlso src <= &H66 Then Return (src - &H61 + 10) Else Return 0 End If End Function Private Function toupper(val As Byte) As Byte If val >= &H61 AndAlso val <= &H7A Then Return (val - &H20) Else Return val End If End Function #End Region #Region "升级流程" ''' ''' 升级 ''' ''' ''' Private Sub BtnUpdateFile_Click(sender As Object, e As EventArgs) Handles BtnUpdateFile.Click SelectDevice() PrepareUpdate485() End Sub ''' ''' 获取更新设备类型委托 ''' ''' Delegate Function Delegate_GetUpdateDevType_Change() ''' ''' 获取更新设备类型 ''' ''' Public Function GetUpdateDevType() Dim devType As String If InvokeRequired = True Then Dim dev As New Delegate_GetUpdateDevType_Change(AddressOf GetUpdateDevType) Me.Invoke(dev) Else Select Case ComboBox1.Text Case _devNameList(0) devType = _devNameList(0) Case _devNameList(1) devType = _devNameList(1) Case _devNameList(2) devType = _devNameList(2) End Select End If Return devType End Function ''' 是否准备升级 Public _isPrepareUpdate As Boolean ''' ''' 准备开始升级485 ''' Private Sub PrepareUpdate485() If _isPrepareUpdate = False Then _isPrepareUpdate = True BtnUpdateFile.ForeColor = Color.Yellow BtnUpdateFile.Text = $"停止升级" TSPBar1.Value = 1 ThreadPool.QueueUserWorkItem(AddressOf StartUpdate) Else If MsgBox("当前处于升级状态,确定结束升级?", MsgBoxStyle.YesNo, $"Tip") = MsgBoxResult.Yes Then _isPrepareUpdate = False BtnUpdateFile.ForeColor = Color.Green BtnUpdateFile.Text = $"开始升级" TSPBar1.Value = 0 AppendTipText($"已终止升级,升级失败!" & vbCrLf, Color.Red) End If End If End Sub ''' ''' 开始升级 ''' Private Sub StartUpdate() _CRC16List.Clear() '升级流程 Static startValue As Integer Static endValue As Integer If GrdTypeInfo.Rows > 0 Then For index = 1 To GrdTypeInfo.Rows - 1 If GrdTypeInfo.Cell(index, EnTypeColInfo.Check).Text = $"1" Then '选中升级 '开始握手 SearchRangeValue(startValue, endValue) SearchData(startValue, endValue) Dim addr As Integer = GrdTypeInfo.Cell(index, EnTypeColInfo.DevAddr).Text If GrdTypeInfo.Cell(index, EnTypeColInfo.Status).Text = "App" Then '判断分区 FrmRCU.SerialPort.BaudRate = CInt(FrmRCU.CboSerialBaud.Text) '设置波特率 JumpBootPartition(addr) '跳转Boot区 End If FrmRCU.SerialPort.BaudRate = 2400 '设置波特率 SearchPartition(addr) '再次握手 SetParam(addr) '设置参数 FrmRCU.SerialPort.BaudRate = CInt(FrmRCU.CboSerialBaud.Text) '设置波特率 SearchPartition(addr) '最后握手 EraseFlash(addr) '擦除Flash ReadFlashData(addr) '写入数据 Dim devType As String = GetUpdateDevType() '委托 Dim burnLen As Integer = GetFlashCheckDataLen(devType) '根据类型确认,单包参与crc16校验数据长度 FlashCheck(addr, burnLen) 'Flash校验 '检验成功后,跳转App区 JumpAppPartition(addr) End If Next End If End Sub ''' ''' 搜索Boot分区 ''' ''' 485地址 Private Sub SearchPartition(Index As Integer) Dim cmd As Byte = &H63 Dim data As Byte() = GetAppSearchData(Index) Dim sendPacket As Byte() = FillSendPacket(cmd, data) sendPacket = FillPacket(sendPacket) '是否填充透传数据包 Console.WriteLine($"搜索:{Index}-Boot分区:{ByteToString(sendPacket)}") SendData(sendPacket) '发送数据包 End Sub ''' ''' 跳转BootLoader分区 ''' ''' 485地址 Private Sub JumpBootPartition(Index As Integer) Dim cmd As Byte = &H68 Dim indexs(0) As Byte indexs(0) = Index Dim sendPacket As Byte() = FillSendPacket(cmd, indexs) sendPacket = FillPacket(sendPacket) '是否填充透传数据包 Console.WriteLine($"跳转{Index}:{ByteToString(sendPacket)}") SendData(sendPacket) '发送数据包 End Sub ''' ''' 设置参数 ''' ''' 485地址 Private Sub SetParam(Index As Integer) Dim cmd As Byte = &H69 Dim zero As Byte = &H0 Dim baud() As Byte = IntToByteHB(FrmRCU.CboSerialBaud.Text / 100) Dim timeout() As Byte = IntToByteLB(10) Dim type As Byte = GetUpdateType() Dim databuff As New List(Of Byte) databuff.Add(Index) databuff.AddRange(baud) databuff.AddRange(timeout) databuff.Add(type) Dim sendPacket As Byte() = FillSendPacket(cmd, databuff.ToArray) sendPacket = FillPacket(sendPacket) '是否填充透传数据包 Console.WriteLine($"设置{Index}:{ByteToString(sendPacket)}") SendData(sendPacket) '发送数据包 End Sub ''' ''' 获取更新设备类型 ''' ''' Private Function GetUpdateType() Dim devType As String = GetUpdateDevType() Dim type As Byte Select Case devType Case _devNameList(0) 'None 485 type = &H0 Case _devNameList(1) 'PB 485 type = &H1 Case _devNameList(2) 'BLV_C1 type = &H2 End Select Return type End Function ''' ''' 擦除Flash ''' ''' 485地址 Private Sub EraseFlash(Index As Integer) Dim cmd As Byte = &H62 Dim indexs(0) As Byte indexs(0) = Index Dim sendPacket As Byte() = FillSendPacket(cmd, indexs) sendPacket = FillPacket(sendPacket) '是否填充透传数据包 Console.WriteLine($"擦除{Index}:{ByteToString(sendPacket)}") SendData(sendPacket) '发送数据包 End Sub ''' ''' 获取Flash数据 ''' ''' Private Function GetFlashDataByte() _flashData = _flashData.Replace($"{vbCrLf}", "").Replace($" ", "") Dim dataBuff() As Byte = GetStringToDataByte(_flashData) Return dataBuff End Function ''' ''' 写入Flash回复 ''' Private _isReadFlashRelay As Boolean ''' ''' 记录重发次数 ''' Public _retry As Integer = 0 ''' ''' Flash数据 ''' Private _flashData As String ''' ''' Flash新数据 ''' Private _flashNewData As New List(Of Byte) ''' ''' 写入Flash ''' ''' Private Sub ReadFlashData(index As Integer) '1、根据不同类型,选择不同组包方式组包,发送 Dim devType As Byte = GetUpdateType() Dim dataBuff() As Byte = GetFlashDataByte() '数据 Dim blockCount As Integer = SubPackage(devType, dataBuff) Dim burnPackage() As Byte Dim packageNumber As Integer For packageNumber = 1 To blockCount _isReadFlashRelay = False burnPackage = FillBurnPackage(index, _flashNewData.ToArray, packageNumber, blockCount) AppendTipText($"开始发送第{packageNumber}包数据..." & vbCrLf, Color.Blue) burnPackage = FillPacket(burnPackage) '是否填充透传数据包 SendData(burnPackage) Console.WriteLine($"第{packageNumber}包:{ByteToString(burnPackage)}") 'ChangePrgValue(packageNumber, blockCount, 0) WaitReadFlashRelay() If _isReadFlashRelay = True Then '判断是回复 If packageNumber = blockCount Then AppendTipText($"写入Flash数据成功!" & vbCrLf, Color.Blue) 'ChangePrgAirBurnValue(0, 1) Return End If Else _retry += 1 If _retry <= 3 Then AppendTipText($"开始重发次数:{_retry}次" & vbCrLf, Color.Blue) packageNumber -= 1 Else AppendTipText($"已超出最大重发次数!" & vbCrLf, Color.Red) AppendTipText($"下载失败!" & vbCrLf, Color.Red) 'ChangePrgAirBurnValue(0, 1) _retry = 0 Return End If End If Next End Sub ''' ''' 根据设备地址类型分包 ''' ''' 设备地址类型 ''' 数据包 Private Function SubPackage(ByRef devType As Byte, ByRef dataBuff As Byte()) Dim blockCount As Integer Dim packetCount As Integer = ComboBox2.Text Select Case devType Case 0 'None 485 blockCount = GetPacketCount(128, dataBuff) Case 1 'PB 485 blockCount = GetPacketCount(128, dataBuff) Case 2 'BLV_C1 blockCount = GetPacketCount(packetCount, dataBuff) Dim fill(blockCount * packetCount - dataBuff.Length - 1) As Byte For index = 0 To fill.Length - 1 fill(index) = &HFF Next _flashNewData.AddRange(dataBuff) _flashNewData.AddRange(fill) End Select Return blockCount End Function ''' ''' 具体分包函数 ''' 根据不同类型的包长度分包 ''' ''' 不同类型的包长 ''' Private Function GetPacketCount(len As Integer, dataBuff As Byte()) Dim blockCount As Integer = dataBuff.Length \ len If dataBuff.Length Mod len > 0 Then blockCount += 1 End If Return blockCount End Function ''' ''' Flash校验 ''' Private _CRC16List As New List(Of Byte) ''' ''' 填充写入Flash数据包 ''' ''' 485地址 ''' ''' ''' ''' Private Function FillBurnPackage(index As Integer, padData() As Byte, blockIndex As Integer, blockCount As Integer) As Byte() Dim cmd As Byte = &H60 Dim databuff As Byte() = FillBurnAlonePackage(padData, blockIndex, blockCount) Dim data As New List(Of Byte) data.Add(index) data.AddRange(databuff) Dim sendPacket As Byte() = FillSendPacket(cmd, data.ToArray) Return sendPacket End Function ''' ''' 填充烧录单包数据 ''' ''' ''' ''' ''' Private Function FillBurnAlonePackage(padData() As Byte, blockIndex As Integer, blockCount As Integer) As Byte() Dim blockPacket As New List(Of Byte) Dim count As Integer = ComboBox2.Text Dim devType As String = GetUpdateDevType() Select Case devType Case _devNameList(0), _devNameList(1) 'None 485, 'PB 485 '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 Case _devNameList(2) 'BLV_C1 'If blockIndex = blockCount Then ' For index = count * (blockIndex - 1) To padData.Length - 1 ' blockPacket.Add(padData(index)) ' Next 'Else For index = count * (blockIndex - 1) To count * blockIndex - 1 blockPacket.Add(padData(index)) Next 'End If End Select Return blockPacket.ToArray End Function ''' ''' 获取Flash单包校验数据长度 ''' 根据类型判断需要校验的数据长度 ''' ''' Private Function GetFlashCheckDataLen(devType As String) Dim burnLen As Integer Select Case devType Case _devNameList(0), _devNameList(1) burnLen = 512 Case _devNameList(2) burnLen = 4096 Case Else End Select Return burnLen End Function ''' ''' Flash校验 ''' ''' Private Sub FlashCheck(Index As Integer, burnLen As Integer) Dim cmd As Byte = &H67 Dim data As Byte() = GetFlashCheck(burnLen) Console.WriteLine($"Flash-CRC16-{Index}:{ByteToString(data)}") Dim sendPacket As Byte() = FillSendPacket(cmd, data) sendPacket = FillPacket(sendPacket) '是否填充透传数据包 Console.WriteLine($"校验{Index}:{ByteToString(sendPacket)}") SendData(sendPacket) '发送数据包 End Sub ''' ''' 获取Flash校验数据 ''' ''' 根据类型确认,单包参与crc16校验数据长度burnLen ''' Private Function GetFlashCheck(burnLen As Integer) Dim blockCount As Integer = _flashNewData.ToArray.Length \ burnLen If _flashNewData.ToArray.Length Mod burnLen > 0 Then blockCount += 1 End If For index = 0 To blockCount - 1 Dim burnPack(burnLen - 1) As Byte Array.Copy(_flashNewData.ToArray, index * burnLen, burnPack, 0, burnPack.Length - 1) Dim crc16 As Byte() = GetCRC16CheckSum(burnPack, burnPack.Length) _CRC16List.AddRange(crc16) Next Return _CRC16List.ToArray End Function ''' ''' 跳转App区 ''' ''' Private Sub JumpAppPartition(index As Integer) Dim cmd As Byte = &H68 Dim data(0) As Byte data(0) = index Dim sendPacket As Byte() = FillSendPacket(cmd, data) sendPacket = FillPacket(sendPacket) '是否填充透传数据包 Console.WriteLine($"跳转APP区-{index}:{ByteToString(sendPacket)}") SendData(sendPacket) '发送数据包 End Sub ''' ''' 回复超时 ''' Private ReadOnly _RelayTimeout As Integer = 1000 ''' ''' 等待写入Flash数据回复 ''' Private Sub WaitReadFlashRelay() Dim tick As Integer Dim startTick As Integer = My.Computer.Clock.TickCount _isReadFlashRelay = False While _isReadFlashRelay = False AndAlso tick <= _RelayTimeout Thread.Sleep(100) tick = My.Computer.Clock.TickCount - startTick Application.DoEvents() End While End Sub ''' ''' 升级设备列表总数 ''' Public _devUpdateCount As Integer = 1 ''' ''' 搜索分区委托 ''' Delegate Sub delegate_SearchPartition_Change() ''' ''' 搜索分区委托 ''' 刷新设备列表 ''' Public Sub SearchPartition() If InvokeRequired = True Then Dim dev As New delegate_SearchPartition_Change(AddressOf SearchPartition) Me.Invoke(dev) Else For Each key As String In _upgradeDevList.Keys GrdTypeInfo.AddItem("") GrdTypeInfo.Cell(_devUpdateCount, EnTypeColInfo.DevAddr).Text = _upgradeDevList(key).DevAddress GrdTypeInfo.Cell(_devUpdateCount, EnTypeColInfo.DevName).Text = _upgradeDevList(key).DevName GrdTypeInfo.Cell(_devUpdateCount, EnTypeColInfo.Status).Text = _upgradeDevList(key).DevPartition GrdTypeInfo.Cell(_devUpdateCount, EnTypeColInfo.Result).Text = _upgradeDevList(key).DevResult _devUpdateCount += 1 Next End If End Sub ''' ''' 搜索分区委托 ''' 刷新设备列表 ''' ''' ''' ''' Delegate Sub delegate_SearchPartitionDevList_Change(devAddr As String, devName As String, devPartition As String) ''' ''' 刷新设备列表信息 ''' 局部刷新_委托 ''' ''' ''' ''' Public Sub RefreshSearchPartitionDevList(devAddr As String, devName As String, devPartition As String) If InvokeRequired = True Then Dim dev As New delegate_SearchPartitionDevList_Change(AddressOf RefreshSearchPartitionDevList) Me.Invoke(dev, New Object() {devAddr, devName, devPartition}) Else GrdTypeInfo.AddItem("") GrdTypeInfo.Cell(_devUpdateCount, EnTypeColInfo.DevAddr).Text = devName GrdTypeInfo.Cell(_devUpdateCount, EnTypeColInfo.DevName).Text = devName GrdTypeInfo.Cell(_devUpdateCount, EnTypeColInfo.Status).Text = devPartition GrdTypeInfo.Cell(_devUpdateCount, EnTypeColInfo.Result).Text = $"未升级" _devUpdateCount += 1 End If End Sub #End Region #End Region #Region "添加记录" ''' ''' 添加记录 ''' ''' ''' Private Sub AppendTipText(recordString As String, col As Color) If InvokeRequired Then Invoke(New Action(Sub() FrmRCU.AppendTipText(recordString, col) End Sub)) Else FrmRCU.AppendTipText(recordString, col) End If End Sub ''' ''' 测试 ''' ''' ''' Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click 'GetFlashDataByte() 'JumpBootPartition(&H01) 'SearchPartition(&H01) 'SetParam(&H01) 'EraseFlash(&H01) 'GetFlashDataByte() 'FlashCheck(&H1, 2048) 'JumpAppPartition(&H01) End Sub #End Region End Class