Files

670 lines
18 KiB
VB.net
Raw Permalink Normal View History

2025-12-11 10:59:57 +08:00
Imports System.Data.Common
Imports System.IO
Imports System.Security.Cryptography
Imports System.Text
Module RCUModule
#Region "数据库操作"
''' <summary>远程数据库类型</summary>
Public RemoteDbType As DbExecutor.DbTypeEnum = DbExecutor.DbTypeEnum.Mysql
''' <summary>远程数据库名</summary>
Public RemoteDbName As String = "blv_rcu_config"
Public FPrefix As Char = "`"
'Public FSuffix As Char = "'"
''' <summary>
''' 连接数据库字符串
''' </summary>
''' <returns></returns>
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 "功能全局变量"
''' <summary>
''' 是否处于网络接收状态
''' </summary>
Public _isReceiving As Boolean
''' <summary>
''' 是否通过UDP发送数据
''' </summary>
Public _isSendByUdp As Boolean
''' <summary>
''' 是否读取
''' </summary>
Public _isRead As Boolean
''' <summary>
''' 是否准备完成
''' </summary>
Public _isPrepare As Boolean
''' <summary>
''' 红外回复处理
''' </summary>
Public _InfraredReceProcessing As Boolean
''' <summary>
''' 红外烧录是否回复
''' </summary>
Public _isInfraredreply As Boolean
''' <summary>
''' 记录重发次数
''' </summary>
Public _resend As Integer = 0
''' <summary>
''' 配对设备列表设备总数
''' </summary>
Public _pairingDevCount As Integer = 0
''' <summary>
''' RF配对模式
''' </summary>
Public _pairingModel As Boolean
''' <summary>
''' 设备列表键值对
''' </summary>
Public _devList As New Dictionary(Of String, DeviceListInfo)
''' <summary>
''' 升级设备列表_键值对
''' </summary>
Public _upgradeDevList As New Dictionary(Of String, UpdateDeviceInfo)
''' <summary>
''' 点击计数
''' </summary>
Public _clickCount As Integer = 0
#End Region
#Region "数据组透传包"
''' <summary>
''' 透传数据包头
''' </summary>
Public _fixedHead As Byte() = {&HAA, &H55}
''' <summary>
''' 透传数据固定ID
''' </summary>
Public _fixeSystemId As Byte() = {&H54, &H33, &H53, &H41}
''' <summary>
''' 透传数据房间信息
''' </summary>
Public _fixeRoomInfo As Byte() = {&HFF, &HFF, &HFF, &HFF}
''' <summary>
''' 包头数据长度
''' </summary>
Public _dataHeadLength As UShort = 15
''' <summary>
''' 数据CRC校验长度
''' </summary>
Public _dataCRCLength As UShort = 2
''' <summary>
''' 透传命令
''' </summary>
Public _serialCmd As Byte = &H3
''' <summary>
''' 透传端口
''' </summary>
Public _port485 As Byte
''' <summary>
''' 透传超时
''' </summary>
Public _timeouts As Byte
''' <summary>
''' 发送次数标志位
''' </summary>
Public _sendTick As Short = 2 '标志位
''' <summary>
''' 填充发送数据包
''' </summary>
''' <param name="data"></param>
''' <returns></returns>
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
''' <summary>
''' 填充发送包头数据
''' </summary>
''' <param name="data"></param>
''' <returns></returns>
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
''' <summary>
''' 填充发送信息包头
''' </summary>
''' <param name="length"></param>
''' <param name="cmdType"></param>
''' <param name="frameNum"></param>
''' <returns></returns>
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
''' <summary>
''' 填充发送校验数据
''' </summary>
''' <param name="byteHead"></param>
''' <param name="data"></param>
''' <returns></returns>
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
''' <summary>
''' 填充发送数据包
''' </summary>
''' <param name="head">数据包头</param>
''' <param name="data">数据内容</param>
''' <param name="crc16">CRC16校验</param>
''' <returns></returns>
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
''' <summary>
''' 填充透传函数
''' 填充透传函数的抽象实现
''' </summary>
''' <param name="dataBuff"></param>
''' <returns></returns>
Public Function FillPacket(dataBuff() As Byte) As Byte()
If _isReceiving = True Then
dataBuff = FillPacketRealize(dataBuff) '透传数据
End If
Return dataBuff
End Function
''' <summary>
''' 填充透传函数的具体实现
''' </summary>
''' <param name="dataBuff"></param>
''' <returns></returns>
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
''' <summary>
''' 透传数据CMD
''' </summary>
''' <param name="dataBuff">串口数据</param>
''' <returns></returns>
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 "校验"
''' <summary>
''' CRC16校验
''' </summary>
''' <param name="dataBuff"></param>
''' <param name="length"></param>
''' <returns></returns>
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
''' <summary>
''' MD5值校验
''' </summary>
''' <param name="strSource">需要校验的字符串</param>
''' <param name="Code">加密模式</param>
''' <returns></returns>
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
''' <summary>
''' MD5校验
''' </summary>
''' <param name="strSource">需要校验的字符串</param>
''' <returns></returns>
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
''' <summary>
''' 获取文件的MD5值
''' </summary>
''' <param name="filepath">文件路径</param>
''' <returns></returns>
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
''' <summary>
''' 和校验
''' 求Byte数组的和校验
''' </summary>
''' <param name="dataPacket">Byte数组</param>
''' <returns></returns>
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
''' <summary>
''' 和校验
''' 求Byte数组的和校验
''' </summary>
''' <param name="dataPacket">Byte数组</param>
''' <returns></returns>
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
''' <summary>
''' 和校验取余数
''' 求Byte数组的和校验取余数
''' </summary>
''' <param name="dataPacket">Byte数组</param>
''' <returns></returns>
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 "功能模块"
''' <summary>
''' 红外下载文件夹
''' </summary>
Public _downFile As String = $"{Application.StartupPath}\DownFile"
''' <summary>
''' 检查网络连接
''' </summary>
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
''' <summary>
''' 检测串口连接
''' </summary>
Public Function CheckSerialPortConn() As Boolean
If FrmRCU.SerialPort.IsOpen = False Then
FrmRCU.AppendTipText("数据发送失败! 原因:未打开串口!!!" & vbCrLf, Color.Red)
Return False
End If
Return True
End Function
''' <summary>
''' Byte数组转字符串
''' </summary>
''' <param name="databuff"></param>
''' <returns></returns>
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
''' <summary>
''' Int转2个字节Byte
''' 高字节在前,低字节在后
''' </summary>
''' <param name="i"></param>
''' <returns></returns>
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
''' <summary>
''' Int转2个字节Byte
''' 低字节在前,高字节在后
''' </summary>
''' <param name="i"></param>
''' <returns></returns>
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
''' <summary>
''' 分块函数
''' 计算Byte数组的块数
''' </summary>
''' <param name="databuff"></param>
''' <returns></returns>
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
''' <summary>
''' 延时N秒
''' </summary>
''' <param name="HowLong">时间值</param>
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
''' <summary>
''' 读取Hex文件到Byte数组
''' </summary>
''' <param name="filePath"></param>
''' <returns></returns>
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
''' <summary>
''' 删除文件夹
''' </summary>
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
''' <summary>
''' 字符串转换Byte数组
''' 字符串为连续且不包含任意字符的字符串
''' </summary>
''' <param name="str"></param>
''' <returns></returns>
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 "未完善"
''' <summary>
''' 发送数据处理所发所见—16进制
''' </summary>
''' <returns></returns>
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