Imports System.Data.Common Imports System.IO Imports System.Security.Cryptography Imports System.Text Module RCUModule #Region "数据库操作" ''' 远程数据库类型 Public RemoteDbType As DbExecutor.DbTypeEnum = DbExecutor.DbTypeEnum.Mysql ''' 远程数据库名 Public RemoteDbName As String = "blv_rcu_config" Public FPrefix As Char = "`" 'Public FSuffix As Char = "'" ''' ''' 连接数据库字符串 ''' ''' Public Function ConnSQLString() As String 'MSSQL连接方式 Dim remoteConn As New DbConnectionStringBuilder From { {"Data Source", "47.119.147.104"}, {"Initial Catalog", "AuthorityDB"}, {"Integrated Security", "false"}, {"User ID", "sa"}, {"Password", "9S844fK3"} } Dim DbConnString As String = "Server=blv-cloud-db.mysql.rds.aliyuncs.com;Port=3307;Database=blv_rcu_config;Uid=blv_rcu;Pwd=fnadiaJDIJ7546;charset=utf8;" Return DbConnString Return remoteConn.ToString() End Function #End Region #Region "功能全局变量" ''' ''' 是否处于网络接收状态 ''' Public _isReceiving As Boolean ''' ''' 是否通过UDP发送数据 ''' Public _isSendByUdp As Boolean ''' ''' 是否读取 ''' Public _isRead As Boolean ''' ''' 是否准备完成 ''' Public _isPrepare As Boolean ''' ''' 红外回复处理 ''' Public _InfraredReceProcessing As Boolean ''' ''' 红外烧录是否回复 ''' Public _isInfraredreply As Boolean ''' ''' 记录重发次数 ''' Public _resend As Integer = 0 ''' ''' 配对设备列表设备总数 ''' Public _pairingDevCount As Integer = 0 ''' ''' RF配对模式 ''' Public _pairingModel As Boolean ''' ''' 设备列表键值对 ''' Public _devList As New Dictionary(Of String, DeviceListInfo) ''' ''' 升级设备列表_键值对 ''' Public _upgradeDevList As New Dictionary(Of String, UpdateDeviceInfo) ''' ''' 点击计数 ''' Public _clickCount As Integer = 0 #End Region #Region "数据组透传包" ''' ''' 透传数据包头 ''' Public _fixedHead As Byte() = {&HAA, &H55} ''' ''' 透传数据固定ID ''' Public _fixeSystemId As Byte() = {&H54, &H33, &H53, &H41} ''' ''' 透传数据房间信息 ''' Public _fixeRoomInfo As Byte() = {&HFF, &HFF, &HFF, &HFF} ''' ''' 包头数据长度 ''' Public _dataHeadLength As UShort = 15 ''' ''' 数据CRC校验长度 ''' Public _dataCRCLength As UShort = 2 ''' ''' 透传命令 ''' Public _serialCmd As Byte = &H3 ''' ''' 透传端口 ''' Public _port485 As Byte ''' ''' 透传超时 ''' Public _timeouts As Byte ''' ''' 发送次数标志位 ''' Public _sendTick As Short = 2 '标志位 ''' ''' 填充发送数据包 ''' ''' ''' Public Function FillSendDataPacket(data As Byte()) As Byte() Dim byteHead As Byte() Dim crc16 As Byte() Dim sendPacket As Byte() byteHead = SendDataHead(data) '获取DataHaed crc16 = CheckSendData(byteHead, data) '获取Data检验值 sendPacket = FillSendPacket(byteHead, data, crc16) '组合发送数据 Return sendPacket End Function ''' ''' 填充发送包头数据 ''' ''' ''' Public Function SendDataHead(data As Byte()) As Byte() Dim byteHead As Byte() Dim packetLength As Short = _dataHeadLength + _dataCRCLength + data.Length Dim cmdType As Byte = &H70 Dim frameNum As Short = 1 byteHead = FillSendPacketHead(packetLength, cmdType, frameNum) Return byteHead End Function ''' ''' 填充发送信息包头 ''' ''' ''' ''' ''' Public Function FillSendPacketHead(length As Short, cmdType As Byte, frameNum As Short) As Byte() Dim dataHead As New List(Of Byte) dataHead.AddRange(_fixedHead) dataHead.AddRange(BitConverter.GetBytes(length)) dataHead.AddRange(_fixeSystemId) dataHead.Add(cmdType) dataHead.AddRange(BitConverter.GetBytes(frameNum)) dataHead.AddRange(_fixeRoomInfo) Return dataHead.ToArray End Function ''' ''' 填充发送校验数据 ''' ''' ''' ''' Public Function CheckSendData(byteHead As Byte(), data As Byte()) As Byte() Dim crc16 As Byte() Dim dataList As New List(Of Byte) dataList.AddRange(byteHead) dataList.AddRange(data) crc16 = GetCRC16CheckSum(dataList.ToArray, dataList.Count) Return crc16 End Function ''' ''' 填充发送数据包 ''' ''' 数据包头 ''' 数据内容 ''' CRC16校验 ''' Public Function FillSendPacket(head() As Byte, data() As Byte, crc16() As Byte) As Byte() Dim dataList As New List(Of Byte) dataList.AddRange(head) dataList.AddRange(data) dataList.AddRange(crc16) Return dataList.ToArray End Function ''' ''' 填充透传函数 ''' 填充透传函数的抽象实现 ''' ''' ''' Public Function FillPacket(dataBuff() As Byte) As Byte() If _isReceiving = True Then dataBuff = FillPacketRealize(dataBuff) '透传数据 End If Return dataBuff End Function ''' ''' 填充透传函数的具体实现 ''' ''' ''' Public Function FillPacketRealize(dataBuff() As Byte) As Byte() Dim data() As Byte = PassthroughData(dataBuff) Dim byteHead As Byte() Dim crc16 As Byte() Dim sendPacket As Byte() byteHead = SendDataHead(data) '获取DataHaed crc16 = CheckSendData(byteHead, data) '获取Data检验值 sendPacket = FillSendPacket(byteHead, data, crc16) '组合发送数据 Return sendPacket End Function ''' ''' 透传数据CMD ''' ''' 串口数据 ''' Public Function PassthroughData(dataBuff() As Byte) Dim dataLen As Integer = dataBuff.Length + 3 Dim data(dataLen - 1) As Byte data(0) = _serialCmd data(1) = _port485 data(2) = _timeouts Array.Copy(dataBuff, 0, data, 3, dataBuff.Length) Return data.ToArray End Function #End Region #Region "校验" ''' ''' CRC16校验 ''' ''' ''' ''' Public 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 ''' ''' MD5值校验 ''' ''' 需要校验的字符串 ''' 加密模式 ''' Public Function MD5(ByVal strSource As String, ByVal Code As Short) As String Dim dataToHash As Byte() = (New ASCIIEncoding).GetBytes(strSource) Dim hashvalue As Byte() = CType(System.Security.Cryptography.CryptoConfig.CreateFromName("MD5"), System.Security.Cryptography.HashAlgorithm).ComputeHash(dataToHash) Dim ATR As String = "" Dim i As Integer Select Case Code Case 16 '选择16位字符的加密结果 For i = 4 To 11 ATR &= Hex(hashvalue(i)).PadLeft(2, "0").ToLower Next Case 32 '选择32位字符的加密结果 For i = 0 To 15 ATR &= Hex(hashvalue(i)).PadLeft(2, "0").ToLower Next Case Else 'Code错误时,返回全部字符串,即32位字符 For i = 0 To 15 ATR &= Hex(hashvalue(i)).PadLeft(2, "0").ToLower Next End Select Return ATR End Function ''' ''' MD5校验 ''' ''' 需要校验的字符串 ''' Public Function MD51(ByVal strSource As String) As Byte() Dim dataToHash As Byte() = (New UTF8Encoding).GetBytes(UCase(strSource)) Dim hashvalue As Byte() = CType(System.Security.Cryptography.CryptoConfig.CreateFromName("MD5"), System.Security.Cryptography.HashAlgorithm).ComputeHash(dataToHash) Return hashvalue End Function ''' ''' 获取文件的MD5值 ''' ''' 文件路径 ''' Public Function GetFileMd5(filepath As String) As String Dim md5Hasher As New MD5CryptoServiceProvider() Dim data As Byte() = md5Hasher.ComputeHash(IO.File.ReadAllBytes(filepath)) Dim fileMd5 As New StringBuilder() Dim i As Integer For i = 0 To data.Length - 1 fileMd5.Append(data(i).ToString("X2")) Next Return fileMd5.ToString() End Function ''' ''' 和校验 ''' 求Byte数组的和校验 ''' ''' Byte数组 ''' Public Function GetSumCheck(dataPacket As Byte()) As Byte Dim sum As Integer For idx = 0 To dataPacket.Length - 1 sum += dataPacket(idx) sum = sum And &HFF Next Return sum End Function ''' ''' 和校验 ''' 求Byte数组的和校验 ''' ''' Byte数组 ''' Public Function GetSumChecks(dataPacket As Byte(), ByRef len As Integer) As Byte Dim sum As Integer For idx = 0 To len - 1 sum += dataPacket(idx) sum = sum And &HFF Next sum = (Not sum) And &HFF Return sum End Function ''' ''' 和校验取余数 ''' 求Byte数组的和校验取余数 ''' ''' Byte数组 ''' Public Function GetSumCheckMod(dataPacket As Byte()) As Byte Dim sum As Integer For idx = 0 To dataPacket.Length - 1 sum += dataPacket(idx) sum = sum And &HFF Next Dim sumMod As Byte = &HFF - sum Return sumMod End Function #End Region #Region "功能模块" ''' ''' 红外下载文件夹 ''' Public _downFile As String = $"{Application.StartupPath}\DownFile" ''' ''' 检查网络连接 ''' Public Function CheckNetWorkConn() As Boolean If FrmRCU._connectStatus = FrmRCU.EnConnectStatus.DisConnect Then FrmRCU.AppendTipText("数据发送失败! 原因:未打开网络!!!" & vbCrLf, Color.Red) Return False End If Return True End Function ''' ''' 检测串口连接 ''' Public Function CheckSerialPortConn() As Boolean If FrmRCU.SerialPort.IsOpen = False Then FrmRCU.AppendTipText("数据发送失败! 原因:未打开串口!!!" & vbCrLf, Color.Red) Return False End If Return True End Function ''' ''' Byte数组转字符串 ''' ''' ''' Public Function ByteToString(databuff() As Byte) Dim strData As String = String.Empty For i = 0 To databuff.Length - 1 strData &= $" {Hex(databuff(i)).PadLeft(2, "0"c)}" Next Return strData End Function ''' ''' Int转2个字节Byte ''' 高字节在前,低字节在后 ''' ''' ''' Public Function IntToByteHB(ByVal i As Integer) As Byte() Dim btemp() As Byte = {0, 0} Dim b() As Byte = BitConverter.GetBytes(i) btemp(0) = b(0) btemp(1) = b(1) Return btemp End Function ''' ''' Int转2个字节Byte ''' 低字节在前,高字节在后 ''' ''' ''' Public Function IntToByteLB(ByVal i As Integer) As Byte() Dim btemp() As Byte = {0, 0} Dim b() As Byte = BitConverter.GetBytes(i) btemp(0) = b(1) btemp(1) = b(0) Return btemp End Function ''' ''' 分块函数 ''' 计算Byte数组的块数 ''' ''' ''' Public Function GetBlocks(databuff As Byte()) As Integer Dim blockCount As Integer = databuff.Length \ 128 If databuff.Length Mod 128 > 0 Then blockCount += 1 End If Return blockCount End Function ''' ''' 延时N秒 ''' ''' 时间值 Public Sub PauseWait(ByVal HowLong As Long) Dim tick As Long tick = My.Computer.Clock.TickCount Do My.Application.DoEvents() Loop Until tick + HowLong < My.Computer.Clock.TickCount End Sub ''' ''' 读取Hex文件到Byte数组 ''' ''' ''' Public Function ReadFileToBytes(filePath) As Byte() Dim result As New List(Of Byte) Dim tmpString As String = File.ReadAllText(filePath) Console.WriteLine($"Befor tmpString:{tmpString}") tmpString = tmpString.Replace("0x", "").Replace(vbCrLf, "").Replace(" ", "").Replace(vbTab, "") Console.WriteLine($"After tmpString:{tmpString}") Dim tmpStringArray() As String = tmpString.Split(New Char() {","c}, StringSplitOptions.RemoveEmptyEntries) Dim tmp As String = "" For index = 0 To tmpStringArray.Length - 1 result.Add($"&H{tmpStringArray(index)}") tmp &= tmpStringArray(index) & "" Next Console.WriteLine($"Befor tmp:{ByteToString(result.ToArray)}") 'Console.WriteLine($"After tmp:{tmp}") Return result.ToArray End Function ''' ''' 删除文件夹 ''' Public Sub DeleteFiles() If Directory.Exists(_downFile) = False Then Exit Sub Try Directory.Delete(_downFile, True) Catch ex As Exception MsgBox($"Delete File Error:{ex.Message}") End Try End Sub ''' ''' 字符串转换Byte数组 ''' 字符串为连续且不包含任意字符的字符串 ''' ''' ''' Public Function GetStringToDataByte(str As String) As Byte() Dim dataList As New List(Of Byte) For index As Integer = 0 To str.Length - 1 Step 2 dataList.Add($"&H{str.Substring(index, 2)}") Next Console.WriteLine($"字符串转换Byte数组: {ByteToString(dataList.ToArray)}") Return dataList.ToArray End Function #End Region #Region "未完善" ''' ''' 发送数据处理(所发所见—16进制) ''' ''' Private Function CMDParameterSendData() Dim sourceData As String = String.Empty '显示框控件文本 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)}" Console.WriteLine($"要发送的数据" & hexData(tmpCnt)) tmpCnt += 1 End If Next Catch ex As Exception MsgBox("数据输入格式有误") End Try Return hexData End Function #End Region End Module