Pilz/Pilz.Networking/ConnectionManagerBase.vb

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.AddRange({(value >> 24) And &HFF, (value >> 16) And &HFF, (value >> 8) And &HFF, 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