Imports System.Net Imports System.Net.Sockets Imports System.Threading Public Class DevNetworkCommunication Inherits Transmitter Public m_Serial As Socket Public m_SerialComfig As UDPComfig Public m_Control As Control '接收数据队列 Public m_ReceiveQueue As List(Of Cmdconfig) = New List(Of Cmdconfig) '特殊接收处理标志 Public m_SpecialReceiveFlag As Integer Public recvBufferli As List(Of Byte) ''' ''' 透传数据包头 ''' Public _fixedHead As Byte() = {&HAA, &H55} ''' ''' 透传数据固定ID ''' Public _fixeSystemId As Byte() = {&H54, &H33, &H53, &H41} ''' ''' 透传数据房间信息 ''' Public _fixeRoomInfo As Byte() = {&HFF, &HFF, &HFF, &HFF} ''' ''' UDP通讯接收线程 ''' Private _receiveThread As Thread Sub New(gControl As Control) m_SerialComfig = New UDPComfig m_ReceiveQueue = New List(Of Cmdconfig) m_ReceiveQueue.Clear() m_Control = gControl recvBufferli = New List(Of Byte) m_SpecialReceiveFlag = -1 CommunicationTypeindex = 2 End Sub Public Overrides Sub SendData(data As Cmdconfig) data.CmdSendTime = DateTime.Now If IsNothing(m_Serial) OrElse Not m_Serial.IsBound Then RuningLog.OutputLogsToTheControl(m_Control, New RuningLogConfig($"发送器未连接!", Color.Red), 1) Return End If '清空发送缓存 m_Serial.SendTo(data.CmdSendData, m_SerialComfig.TargetEndPoint) End Sub Public Overrides Sub CloseTransmitter() If Not IsNothing(m_Serial) Then m_Serial.Shutdown(SocketShutdown.Both) m_Serial.Close() m_Serial = Nothing End If If Not IsNothing(_receiveThread) AndAlso _receiveThread.IsAlive Then _receiveThread.Abort() End If End Sub Public Overrides Sub ClearSendData() If IsNothing(m_ReceiveQueue) Then Return m_ReceiveQueue.Clear() End Sub Public Overrides Sub ClearReadData() End Sub Public Overrides Function ReceiveData(g_comfig As Cmdconfig) As Cmdconfig End Function ''' ''' UDP接收数据 ''' Private Sub UdpRecviveData() Dim recvLength As Integer Dim recvBuffer(1024) As Byte While m_Serial.IsBound Try recvLength = m_Serial.ReceiveFrom(recvBuffer, m_SerialComfig.TargetEndPoint) '_countRXData += recvLength Dim buf As Byte() = New Byte(recvLength - 1) {} Array.Copy(recvBuffer, buf, recvLength) RuningLog.OutputLogsToTheControl(m_Control, New RuningLogConfig($"RX:{DataProcessing.ByteToString2(buf)}", Color.Blue), 1) Catch ex As Exception Console.WriteLine($"Udp Recv Error:{ex.Message}") Return End Try ReceivingDataProcessing(recvBuffer, recvLength) End While ' If Not IsNothing(m_Transmitter) AndAlso m_Transmitter.IsTransmitter Then m_Transmitter.CloseTransmitter() End Sub ''' ''' 接收数据处理 ''' ''' ''' Private Sub ReceivingDataProcessing(recvBuffer() As Byte, recvLength As Integer) Dim startIndex As Integer '定义一个开始的计数值 Dim packetLength As Integer '定义包的长度 While startIndex < recvLength '判断计数值是否小于总包长 If recvBuffer(startIndex) = _fixedHead(0) AndAlso recvBuffer(startIndex + 1) = _fixedHead(1) Then ' 判断包头是否等于AA55 If recvBuffer(startIndex + 4) = _fixeSystemId(0) AndAlso '判断第4,5,6,7位是否等于固定值 recvBuffer(startIndex + 5) = _fixeSystemId(1) AndAlso recvBuffer(startIndex + 6) = _fixeSystemId(2) AndAlso recvBuffer(startIndex + 7) = _fixeSystemId(3) Then packetLength = recvBuffer(startIndex + 2) + recvBuffer(startIndex + 3) * 256 '赋值包长 If packetLength + startIndex <= recvLength Then '判断包长 + 计数值是否小于等于总包长 Dim packetData(packetLength - 1) As Byte '定义一个新数据包数组 Array.Copy(recvBuffer, startIndex, packetData, 0, packetLength) '复制数组 +5个重载 If CheckCRC16Sucess(packetData, packetData.Length) Then '判断CRC16校验是否通过 '显示数据 DealData(packetData, packetLength) '分部处理数据(显示文字提示) startIndex += packetData.Length '计数值更新 Else RuningLog.OutputLogsToTheControl(m_Control, New RuningLogConfig($"CRC16校验失败!", Color.Red), 1) Exit While End If Else RuningLog.OutputLogsToTheControl(m_Control, New RuningLogConfig($"数据包长校验失败!", Color.Red), 1) Exit While End If Else RuningLog.OutputLogsToTheControl(m_Control, New RuningLogConfig($"数据校验失败!", Color.Red), 1) Exit While End If Else RuningLog.OutputLogsToTheControl(m_Control, New RuningLogConfig($"非RCU主机发送的数据!", Color.Red), 1) Exit While End If End While End Sub ''' ''' 检验CRC16成功 ''' ''' ''' ''' Private Function CheckCRC16Sucess(dataBuff() As Byte, length As Integer) As Boolean Dim crcBytes() As Byte = GetCRC16CheckSum(dataBuff, length - 2) If crcBytes(0) <> dataBuff(length - 2) OrElse crcBytes(1) <> dataBuff(length - 1) Then Return False Return True End Function ''' ''' 处理数据 ''' ''' ''' ''' Private Function DealData(dataBuff() As Byte, length As Integer) As Boolean Select Case dataBuff(8) Case &H70 '获取队列第5个元素 Dim len As Integer = m_ReceiveQueue.Count Dim item As Cmdconfig Dim buf(length - 17 - 1) As Byte Array.Copy(dataBuff, 15, buf, 0, buf.Length) For i = 0 To len - 1 If (len - 1 - i) < m_ReceiveQueue.Count Then item = m_ReceiveQueue(len - 1 - i) If dataBuff(15) = 2 Then item.OtherProtocol.UDP_TRANSPARENT_MODE_COMMAND_REPLY_STATUS = 1 item.OtherProtocol.UDP_TRANSPARENT_MODE_COMMAND_REPLY_RESULT = dataBuff(16) End If If dataBuff(15) = 1 Then item.OtherProtocol.UDP_QUERY_HOST_CURRENT_MODE_COMMAND_REPLY_STATUS = 1 item.OtherProtocol.UDP_QUERY_HOST_CURRENT_MODE_COMMAND_REPLY_RESULT = dataBuff(16) End If 'item.Protocol.ParseReceiveData(item, buf) End If Next Case &H71 Dim len As Integer = m_ReceiveQueue.Count Dim item As Cmdconfig Dim buf(length - 17 - 1 - 2) As Byte If 17 + buf.Length < dataBuff.Length Then Array.Copy(dataBuff, 17, buf, 0, buf.Length) For i = 0 To len - 1 If (len - 1 - i) < m_ReceiveQueue.Count Then item = m_ReceiveQueue(len - 1 - i) 'If dataBuff(15) = 2 Then ' item.OtherProtocol.UDP_TRANSPARENT_MODE_COMMAND_REPLY_STATUS = 1 ' item.OtherProtocol.UDP_TRANSPARENT_MODE_COMMAND_REPLY_RESULT = dataBuff(16) 'End If 'If dataBuff(15) = 1 Then ' item.OtherProtocol.UDP_QUERY_HOST_CURRENT_MODE_COMMAND_REPLY_STATUS = 1 ' item.OtherProtocol.UDP_QUERY_HOST_CURRENT_MODE_COMMAND_REPLY_RESULT = dataBuff(16) 'End If item.Protocol.ParseReceiveData2(item, buf) End If Next End If End Select Return True End Function ''' ''' 获取CRC16校验和 ''' ''' 数据 ''' 数据长度 ''' Private Function GetCRC16CheckSum(dataBuff() As Byte, length As Integer) As Byte() Dim crc16 As UInteger Dim crcBytes() As Byte crc16 = &HFFFF For i = 0 To length - 1 crc16 = crc16 And &HFFFF crc16 = crc16 Xor dataBuff(i) For bit = 0 To 7 crc16 = IIf((crc16 And 1) = 0, crc16 >> 1, (crc16 >> 1) Xor &HA001) Next Next crc16 = crc16 And &HFFFF crcBytes = BitConverter.GetBytes(UShort.Parse(crc16)) Return crcBytes End Function Public Overrides Function IsTransmitter() As Boolean If IsNothing(m_Serial) OrElse m_Serial.Connected = False Then Return False Return True End Function Public Overrides Function OpenTransmitter() As Boolean If Not IsNothing(m_Serial) Then m_Serial.Shutdown(SocketShutdown.Both) m_Serial.Close() End If If Not IsNothing(_receiveThread) AndAlso _receiveThread.IsAlive Then _receiveThread.Abort() End If m_Serial = New Socket(AddressFamily.InterNetwork, SocketType.Dgram, ProtocolType.Udp) ''加保护机制 m_Serial.Bind(m_SerialComfig.LocalEndPoint) m_Serial.Connect(m_SerialComfig.TargetEndPoint) _receiveThread = New Thread(New ThreadStart(AddressOf UdpRecviveData)) _receiveThread.Start() End Function Public Overrides Function GetTransmitterStatus() As Boolean If IsNothing(m_Serial) Then Return False Return True End Function ''' ''' 本地ip/本地端口/目标ip/目标端口 ''' ''' ''' Public Overrides Function SetTransmitterParameter(ParamArray params() As Object) As Boolean If IsNothing(m_SerialComfig) Then Return False Dim ipAddr As IPAddress Dim port As Integer If params.Length > 0 Then '判断是否为ip If IPAddress.TryParse(params(0), ipAddr) Then m_SerialComfig.LocalIP = ipAddr End If If params.Length > 1 Then '判断是否为端口 If Integer.TryParse(params(1), port) Then m_SerialComfig.LocalPort = port End If End If If params.Length > 2 Then '判断是否为ip If IPAddress.TryParse(params(2), ipAddr) Then m_SerialComfig.TargetIP = ipAddr End If If params.Length > 3 Then '判断是否为端口 If Integer.TryParse(params(3), port) Then m_SerialComfig.TargetPort = port End If End If End If End If '判断本地ip和 端口是否有效 If IsNothing(m_SerialComfig.LocalIP) OrElse IsNothing(m_SerialComfig.LocalPort) Then MsgBox("本地ip或端口无效") Else '判断目标ip和 端口是否有效 m_SerialComfig.LocalEndPoint = New IPEndPoint(m_SerialComfig.LocalIP, m_SerialComfig.LocalPort) End If '判断目标ip和 端口是否有效 If IsNothing(m_SerialComfig.TargetIP) OrElse IsNothing(m_SerialComfig.TargetPort) Then MsgBox("目标ip或端口无效") Else m_SerialComfig.TargetEndPoint = New IPEndPoint(m_SerialComfig.TargetIP, m_SerialComfig.TargetPort) End If End Function '判断是否为端口 Private Function IsPort(port As String) As Boolean Return Integer.TryParse(port, port) End Function '判断是否为ip Private Function IsIP(ip As String) As Boolean Dim ipAddr As IPAddress Return IPAddress.TryParse(ip, ipAddr) End Function Public Overrides Function SendData(data() As Byte) As Boolean 'data.CmdSendTime = DateTime.Now If IsNothing(m_Serial) Then RuningLog.OutputLogsToTheControl(m_Control, New RuningLogConfig($"发送器未连接!", Color.Red), 1) Return False End If '清空发送缓存 m_Serial.SendTo(data, m_SerialComfig.TargetEndPoint) Return True End Function End Class Public Class UDPComfig '本地ip Public LocalIP As IPAddress '本地端口 Public LocalPort As Integer '目标ip Public TargetIP As IPAddress '目标端口 Public TargetPort As Integer '发送网络端点 Public LocalEndPoint As IPEndPoint '接收网络端点 Public TargetEndPoint As IPEndPoint '获取 串口名称列表 Sub New() LocalIP = GetLocalIP.Item(0) End Sub '获取本地IP列表 Public Shared Function GetLocalIP() As List(Of IPAddress) Dim address() As IPAddress Dim destAddress As New List(Of IPAddress) address = Dns.GetHostEntry(Dns.GetHostName()).AddressList For Each pAddress As IPAddress In address If pAddress.AddressFamily = AddressFamily.InterNetwork Then destAddress.Add(pAddress) End If Next Return destAddress End Function End Class