Imports System.Net.Sockets
Imports System.Net
Imports System.Text
 
Public Class ClassComm
  Implements IDisposable
 
#Region "IDisposable Support"
  Private disposedValue As Boolean = False
 
  ' IDisposable
  Protected Overridable Sub Dispose(ByVal disposing As Boolean)
    If Not Me.disposedValue Then
      If disposing Then
        If Not TimerConnectionTimeOut Is Nothing Then
          TimerConnectionTimeOut.Enabled = False
          TimerConnectionTimeOut.Close()
          TimerConnectionTimeOut.Dispose()
          TimerConnectionTimeOut = Nothing
        End If
        If Not TimerSendTimeOut Is Nothing Then
          TimerSendTimeOut.Enabled = False
          TimerSendTimeOut.Close()
          TimerSendTimeOut.Dispose()
          TimerSendTimeOut = Nothing
        End If
        If Not TimerSend Is Nothing Then
          TimerSend.Enabled = False
          TimerSend.Close()
          TimerSend.Dispose()
          TimerSend = Nothing
        End If
        _bytes = Nothing
        _qrcv.Clear()
        _qrcv = Nothing
        _qsnd.Clear()
        _qsnd = Nothing
        On Error Resume Next
        _sck.Shutdown(SocketShutdown.Both)
        _sck.Close()
        On Error GoTo 0
        _sck = Nothing
      End If
      'free shared unmanaged resources
    End If
    Me.disposedValue = True
  End Sub
 
  Public Sub Dispose() Implements IDisposable.Dispose
    Dispose(True)
    GC.SuppressFinalize(Me)
  End Sub
#End Region
 
#Region "Enumeration"
  Public Enum ErrorType
    seems_disconnected
    connection_failed
    failed_to_listen
  End Enum
#End Region
 
#Region "Structure"
  Public Structure CommMessage
    Public Order As String
    Public Message As String
    Private _idCode As Long
    Public IsComplete As Boolean
    Public Property idCode() As Long
      Get
        If _idCode = 0 Then _idCode = Now.Ticks / ((Rnd() * 1000) + 1)
        Return _idCode
      End Get
      Set(ByVal value As Long)
        If _idCode = 0 Then _idCode = value
        _idCode = value
      End Set
    End Property
    Public ReadOnly Property MyBytes() As Byte()
      Get
        If _idCode = 0 Then _idCode = Now.Ticks / ((Rnd() * 1000) + 1)
        If Order Is Nothing Then Order = ""
        If Message Is Nothing Then Message = ""
        Dim ms As New IO.MemoryStream
        Dim bw As New IO.BinaryWriter(ms, Encoding.Unicode)
        With bw
          .Write(Order)
          .Write(Message)
          .Write(IsComplete)
          .Write(_idCode)
          .Close()
        End With
        ms.Close()
        Return ms.ToArray
        bw = Nothing
        ms.Dispose()
        ms = Nothing
      End Get
    End Property
    Public Sub SetBytes(ByRef ByteCommMessage As Byte())
      Dim ms As New IO.MemoryStream(ByteCommMessage, False)
      Dim br As New IO.BinaryReader(ms, Encoding.Unicode)
      With br
        Order = .ReadString
        Message = .ReadString
        IsComplete = .ReadBoolean
        _idCode = .ReadUInt64
        .Close()
      End With
      br = Nothing
      ms.Close()
      ms.Dispose()
      ms = Nothing
    End Sub
    Public Function ConfirmSequence() As Byte()
      Dim ms As New IO.MemoryStream
      Dim bw As New IO.BinaryWriter(ms, Encoding.Unicode)
      With bw
        .Write("" )
        .Write("" )
        .Write(True)
        .Write(_idCode)
        .Close()
      End With
      ms.Close()
      Return ms.ToArray
      bw = Nothing
      ms.Dispose()
      ms = Nothing
    End Function
  End Structure
#End Region
 
#Region "Private objects"
  Private _bytes() As Byte
  Private _qrcv As New Queue(Of CommMessage)
  Private _qsnd As New Queue(Of CommMessage)
  Private _last_send As CommMessage
  Private _last_rcv As CommMessage
  Private _sck As Socket = New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.IP)
  Private WithEvents TimerConnectionTimeOut As Timers.Timer
  Private WithEvents TimerSendTimeOut As Timers.Timer
  Private WithEvents TimerSend As New Timers.Timer(10)
  Private _sending As Boolean = False
#End Region
 
#Region "Events"
  Public Event ConnectionRequestAccepted(ByRef sck As Socket)
  Public Event Connected()
  Public Event ProblemDetected(ByVal source As ErrorType)
  Public Event NewMessage()
#End Region
 
#Region "Constructor New"
 
  Public Sub New(ByVal Port_To_Listen_If_Server As Integer)
    _last_rcv.idCode = -1
    _last_rcv.IsComplete = True
    Try
      With _sck
        .Bind(New IPEndPoint(IPAddress.Any, Port_To_Listen_If_Server))
        .Listen(10)
        .BeginAccept(AddressOf CallBackAccept, _sck)
      End With
    Catch
      RaiseEvent ProblemDetected(ErrorType.failed_to_listen)
    End Try
  End Sub
  Public Sub New(ByVal Host_To_Connect As String, ByVal Port_To_Connect As Integer, Optional ByVal Timeout_ms As Integer = 5000)
    _last_rcv.idCode = -1
    _last_rcv.IsComplete = True
    If Timeout_ms >= 0 Then
      TimerConnectionTimeOut = New Timers.Timer
      TimerConnectionTimeOut.Interval = Timeout_ms
      TimerConnectionTimeOut.Enabled = True
      TimerSendTimeOut = New Timers.Timer
      TimerSendTimeOut.Interval = Timeout_ms
      TimerSendTimeOut.Enabled = False
    End If
    Try
      _sck.BeginConnect(Host_To_Connect, Port_To_Connect, AddressOf CallBackConnect, _sck)
    Catch
      RaiseEvent ProblemDetected(ErrorType.seems_disconnected)
    End Try
  End Sub
  Public Sub New(ByRef Sck As Socket, Optional ByVal Timeout_ms As Integer = 5000)
    _last_rcv.idCode = -1
    _last_rcv.IsComplete = True
    If Sck.Connected Then
      If Timeout_ms >= 0 Then
        TimerSendTimeOut = New Timers.Timer
        TimerSendTimeOut.Interval = Timeout_ms
        TimerSendTimeOut.Enabled = False
      End If
      Try
        _sck = Sck
        TimerSend.Enabled = True
        _bytes = New Byte(_sck.ReceiveBufferSize) {}
        _sck.BeginReceive(_bytes, 0, _sck.ReceiveBufferSize, SocketFlags.None, AddressOf CallBackReceive, _sck)
      Catch
        RaiseEvent ProblemDetected(ErrorType.seems_disconnected)
      End Try
    Else
      RaiseEvent ProblemDetected(ErrorType.seems_disconnected)
    End If
  End Sub
 
#End Region
 
#Region "Timers events"
  Private Sub TimerConnectionTimeOut_Elapsed(ByVal sender As Object, ByVal e As system.Timers.ElapsedEventArgs) Handles TimerConnectionTimeOut.Elapsed
    TimerConnectionTimeOut.Enabled = False
    RaiseEvent ProblemDetected(ErrorType.connection_failed)
  End Sub
 
  Private Sub TimerSendTimeOut_Elapsed(ByVal sender As Object, ByVal e As System.Timers.ElapsedEventArgs) Handles TimerSendTimeOut.Elapsed
    If _sending Then Sendcm(_last_send.MyBytes) Else TimerSendTimeOut.Enabled = False
  End Sub
 
  Private Sub TimerSend_Elapsed(ByVal sender As Object, ByVal e As System.Timers.ElapsedEventArgs) Handles TimerSend.Elapsed
    If Not _sending Then
      If _qsnd.Count > 0 Then
        Sending(True)
        _last_send = _qsnd.Dequeue
        Sendcm(_last_send.MyBytes)
      End If
    End If
  End Sub
 
#End Region
 
#Region "Public properties"
  Public ReadOnly Property ReadNextMsg() As CommMessage
    Get
      If _qrcv.Count > 0 Then Return _qrcv.Dequeue Else Return Nothing
    End Get
  End Property
 
  Public ReadOnly Property MsgCount() As Integer
    Get
      Return _qrcv.Count
    End Get
  End Property
 
  Public ReadOnly Property IsSending() As Boolean
    Get
      Return _sending
    End Get
  End Property
 
#End Region
 
#Region "Public functions"
 
  Public Sub Send(ByVal Order As String, ByVal Message As String)
    Dim cm As CommMessage
    Dim LenTT As Integer = (Order & Message).Length
    If LenTT > 4000 Then
      'Si supérieur à 4000 alors découpe
 
      'Les paquets sont basés sur 4000 car le tout sera encodé en Unicode, donc doublé,
      'la limite des paquets des sockets étant 8192, j'ai arrondi la découpe à 4000
      'pour prendre en compte les autres paramètres transmis avec les messages
      Dim i As Integer = 0
      Dim j As Integer = 0
      Dim ti As Integer
      Dim tj As Integer
      Do
        tj = 0
        ti = 0
        cm = New CommMessage
        ti = IIf(Order.Substring(i).Length > 4000, 4000, Order.Substring(i).Length)
        cm.Order = Order.Substring(i, ti)
        i += ti
        If ti < 4000 Then
          tj = IIf(Message.Substring(j).Length > (4000 - ti), (4000 - ti), Message.Substring(j).Length)
          cm.Message = Message.Substring(j, tj)
          j += tj
        End If
        cm.IsComplete = (LenTT = i + j)
        _qsnd.Enqueue(cm)
      Loop Until cm.IsComplete
 
    Else
      'Sinon envoie tel quel
      cm = New CommMessage
      cm.Order = Order
      cm.Message = Message
      cm.IsComplete = True
      _qsnd.Enqueue(cm)
    End If
  End Sub
 
#End Region
 
#Region "Private functions"
  Private Sub Sendcm(ByRef _b() As Byte)
    Try
      _sck.BeginSend(_b, 0, _b.Length, SocketFlags.None, AddressOf CallBackSend, _sck)
    Catch
      RaiseEvent ProblemDetected(ErrorType.seems_disconnected)
    End Try
  End Sub
  Private Sub Sending(ByVal Flag As Boolean)
    _sending = Flag
    TimerSendTimeOut.Enabled = Flag
  End Sub
#End Region
 
#Region "Socket delegate CallBack"
 
  'en mode serveur, renvoit un socket connecté à un client
  'puis repasse en attente
  Private Sub CallBackAccept(ByVal async As IAsyncResult)
    Try
      RaiseEvent ConnectionRequestAccepted(_sck.EndAccept(async))
      _sck.BeginAccept(AddressOf CallBackAccept, _sck)
    Catch
      RaiseEvent ProblemDetected(ErrorType.failed_to_listen)
    End Try
  End Sub
 
  'en mode client, établit la connexion
  Private Sub CallBackConnect(ByVal async As IAsyncResult)
    If Not TimerConnectionTimeOut Is Nothing Then TimerConnectionTimeOut.Enabled = False
    Try
      _sck.EndConnect(async)
      RaiseEvent Connected()
      TimerSend.Enabled = True
      _bytes = New Byte(_sck.ReceiveBufferSize) {}
      _sck.BeginReceive(_bytes, 0, _sck.ReceiveBufferSize, SocketFlags.None, AddressOf CallBackReceive, _sck)
    Catch
      RaiseEvent ProblemDetected(ErrorType.connection_failed)
    End Try
  End Sub
 
  'réception de données, puis se remet en attente
  Private Sub CallBackReceive(ByVal async As IAsyncResult)
    Dim size As Integer
    Try
      size = _sck.EndReceive(async)
      If size > 0 Then
        Dim cm As New CommMessage
        cm.SetBytes(_bytes)
        If cm.Order = "" AndAlso cm.Message = "" Then
          If cm.idCode = _last_send.idCode Then Sending(False)
        Else
          If cm.idCode <> _last_rcv.idCode Then
            If Not _last_rcv.IsComplete Then
              cm.Order = cm.Order.Insert(0, _last_rcv.Order)
              cm.Message = cm.Message.Insert(0, _last_rcv.Message)
            End If
            _last_rcv = cm
            If cm.IsComplete Then
              _qrcv.Enqueue(cm)
              RaiseEvent NewMessage()
            End If
          End If
          Sendcm(cm.ConfirmSequence)
        End If
      Else
        RaiseEvent ProblemDetected(ErrorType.seems_disconnected)
      End If
      _bytes = New Byte(_sck.ReceiveBufferSize) {}
      _sck.BeginReceive(_bytes, 0, _sck.ReceiveBufferSize, SocketFlags.None, AddressOf CallBackReceive, _sck)
    Catch
      RaiseEvent ProblemDetected(ErrorType.seems_disconnected)
    End Try
  End Sub
 
  'envoi des données terminées
  Private Sub CallBackSend(ByVal async As IAsyncResult)
    Try
      _sck.EndSend(async)
    Catch
      RaiseEvent ProblemDetected(ErrorType.seems_disconnected)
    End Try
  End Sub
 
#End Region
 
End Class