Imports System.IO Imports System.Net Imports Newtonsoft.Json.Linq Public MustInherit Class ConnectionManagerBase Private Const HEADER_LENGTH As Integer = 12 Private listening As Boolean = False Private ReadOnly dicData As New Dictionary(Of Integer, Dictionary(Of Integer, Byte())) Public ReadOnly Property Port As Integer Public Property UseAssemblyQualifiedName As Boolean = False Public Event RetriveData(manager As ConnectionManagerBase, senderIP As String, cmd As String, content As Object) Public Property IsListening As Boolean Get Return listening End Get Protected Set(value As Boolean) listening = value End Set End Property Public Sub New(port As Integer) Me.Port = port End Sub Protected Overrides Sub Finalize() [Stop]() End Sub Public MustOverride Sub Start() Public MustOverride Sub [Stop]() Protected MustOverride Sub SendData(endPoint As IPEndPoint, data As Byte()) Protected MustOverride Function GetBufferSize() As Integer Public Overridable Sub Send(empfängerIP As String, cmd As String) Send(empfängerIP, cmd, String.Empty) End Sub Public Overridable Sub Send(empfängerIP As String, cmd As String, info As String) Send(empfängerIP, cmd, CObj(info)) End Sub Private Sub RaiseRetriveData(senderIP As String, cmd As String, content As Object) RaiseEvent RetriveData(Me, senderIP, cmd, content) End Sub Protected Sub ProcessRetrivedData(senderIP As String, buf As Byte()) Dim readInteger = Function(index As Integer) As Integer Return (CInt(buf(index)) << 24) Or (CInt(buf(index + 1)) << 16) Or (CInt(buf(index + 2)) << 8) Or buf(index + 3) End Function Dim dataID As Integer = readInteger(0) Dim packageID As Integer = readInteger(4) Dim packageCount As Integer = readInteger(8) Dim resolveData As Boolean = True 'Remember data Dim data As Byte() = buf.Skip(HEADER_LENGTH).ToArray Dim dicMyData As Dictionary(Of Integer, Byte()) If dicData.ContainsKey(dataID) Then dicMyData = dicData(dataID) If dicMyData.ContainsKey(packageID) Then dicMyData(packageID) = data Else dicMyData.Add(packageID, data) End If Else dicMyData = New Dictionary(Of Integer, Byte()) From {{packageID, data}} dicData.Add(dataID, dicMyData) End If If dicMyData.Count < packageCount Then resolveData = False End If 'Resolve Data If resolveData Then If dicMyData Is Nothing Then dicMyData = dicData(dataID) End If Dim myData As New List(Of Byte) For Each kvp In dicMyData.OrderBy(Function(n) n.Key) myData.AddRange(kvp.Value) Next dicMyData.Remove(dataID) Dim content As Object = Nothing Dim cmd As String = String.Empty Try Dim res = DecodeFromBytes(myData.ToArray) cmd = res.cmd content = res.content Catch ex As Exception End Try RaiseRetriveData(senderIP, cmd, content) End If End Sub Public Sub Send(empfängerIP As String, cmd As String, content As Object) Static rnd As New Random Dim ep As New IPEndPoint(GetIPFromHost(empfängerIP).MapToIPv4, Port) Dim finalBuffer As New List(Of Byte) Dim maxBufferSize As Integer = GetBufferSize() Dim maxDataSize As Integer = maxBufferSize - HEADER_LENGTH Dim data As Byte() = EncodeToBytes(cmd, content, UseAssemblyQualifiedName) Dim dataID As Integer = rnd.Next 'Some methods for later user Dim send = Sub() SendData(ep, finalBuffer.ToArray) Dim addInteger = Sub(value As Integer) finalBuffer.Add((value >> 24) And &HFF) finalBuffer.Add((value >> 16) And &HFF) finalBuffer.Add((value >> 8) And &HFF) finalBuffer.Add(value And &HFF) End Sub Dim addHeader = Sub(packageID As Integer, packagesCount As Integer) addInteger(dataID) 'Data ID addInteger(packageID) 'Package ID addInteger(packagesCount) 'Packages Count End Sub 'Send data (this if statement and else content might be useless) If data.Length > maxDataSize Then Dim curIndex As Integer = 0 Dim curID As Integer = 0 Dim packagesCount As Integer = Math.Ceiling(data.Length / maxDataSize) Do While curIndex < data.Length finalBuffer.Clear() addHeader(curID, packagesCount) For i As Integer = 1 To maxDataSize If curIndex < data.Length Then finalBuffer.Add(data(curIndex)) curIndex += 1 End If Next send() curID += 1 Loop Else addHeader(0, 1) finalBuffer.AddRange(data) send() End If End Sub Private Shared Function EncodeToBytes(cmd As String, content As Object, useAssemblyQualifiedName As Boolean) As Byte() Dim ms As New MemoryStream() Dim bw As New BinaryWriter(ms) Dim obj As New JObject 'Write header obj("Cmd") = cmd obj("ContentType") = If(useAssemblyQualifiedName, content?.GetType?.AssemblyQualifiedName, content?.GetType?.ToString) 'Content obj("Content") = JToken.FromObject(content) 'Write Json to MemoryStream bw.Write(Text.Encoding.Default.GetBytes(obj.ToString)) 'Get Buffer Bytes Dim buf As Byte() = ms.ToArray ms.Close() Return buf End Function Private Shared Function DecodeFromBytes(buf As Byte()) As (cmd As String, content As Object) Dim contentstring As String = Text.Encoding.Default.GetString(buf) Dim content As Object = Nothing Dim contentobj As JObject = JObject.Parse(contentstring) Dim cmd As String = contentobj("Cmd") Dim contenttypestring As String = contentobj("ContentType") Dim contentlinq As JToken = contentobj("Content") If Not String.IsNullOrEmpty(contenttypestring) Then Dim contenttype As Type = Type.GetType(contenttypestring) content = contentlinq.ToObject(contenttype) End If Return (cmd, content) End Function End Class