[.NETV2] CLASSCOM - CLASSE DE COMMUNICATION EN RÉSEAU SIMPLIFIÉE GÉRANT LE MULTICLIENT, 2 EN 1 CLIENT ET SERVEUR - CLASS SOCKET

---

Commentaire sur cette source (36)
Ajouter un commentaire et/ou une note

Bonjour,

Je vous présente ici une class de communication réseau, simple et d'utilisation claire, pour tout ceux qui rencontre (ou non) des problèmes avec les sockets.

Fonctionnement :

} Connexion
- on définit grâce au constructeur si c'est un serveur qui écoute ou bien un client qui va se connecter à un serveur
- si instanciée en serveur, un évenement prévient lorsqu'une connexion arrive, et donne le socket client (qu'il suffit de passer à un constructeur de cette class)
- si instanciée en client (avec les infos de connexion en paramètre), un évenement prévient si la connexion s'est effectuée ou non

} Communication
# les messages sont des classcomm.commMessage (structure perso pour simplifier la comm réseau)
- pour envoyer un message, on utilise Send qui prend en paramètre un Ordre (string) et un Message (string)
- pour recevoir des messages, il suffit de tester de temps en temps MsgCount : si y'en a 0 c'est qu'il n'y a pas de CommMessage à consommer, sinon c'est qu'il y en a le nombre indiqué en attente d'être lu, grâce à ReadNextMsg qui renvoie le CommMessage

} L'event ProblemDetected
- renvoit ErrorType.connection_failed si un client n'a pas su se connecter à un serveur donné
- renvoit ErrorType.seems_disconnected si on est vraisemblablement déconnecté (erreur pendant une transmission par exemple)
- renvoit ErrorType.failed_to_listen si un serveur n'arrive pas à écouter sur un port donné ou tout autre erreur à l'ouverture d'un serveur

} Fermeture
- pour fermer un serveur ou déconnecter un client, utilisez la méthode Dispose
#en gros l'objet ne vit QUE connecté. Simple.




Ci-dessous la class à coller directement dans un module de class.net :

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

>>>>> Pourquoi avoir utilisé une structure perso (commMessage) pour l'envoi et la réception ?
L'utilisateur de cette classe simplifiée n'a pas à s'inquiéter de ce qu'il envoit et comment il l'envoit. Il envoit juste.
A la réception on reçoit donc un commMessage, on regarde l'ordre (par exemple avec un select case) et on interprete donc le message correctement, l'ordre nous renseignant sur ce qu'on doit faire du message (exemple : est-ce que c'est l'âge du gars, son nom ou bien son prénom ?)
Démo :

Dim cm As ClassComm.CommMessage = _comm.ReadNextMsg
Select Case cm.Order
  Case "nom"
    Msgbox("La personne connectée s'appelle " & cm.Message & ".")
  Case "age"
    Msgbox("La personne connectée a " & cm.Message & " ans.")
  Case "passion"
    Msgbox("La personne connectée est passionnée par " & cm.Message & ".")
End Select



>>>>> Pourquoi ne pas avoir mis en event un message arrivant ?
Parceque les sockets sont multithreads et c'est pas propre du tout : les events sont renvoyés dans un thread à part à cause des callbacks des sockets, donc on ne peut pas agir sur une interface à partir des events renvoyés par la class.
Alors j'ai jugé plus souple de mettre les messages arrivant dans une file d'attente FIFO (first in first out), qui sera par exemple checké par l'utilisateur à l'aide d'un Timer 100ms, ce qui est parfait pour de la comm réseau.
Démo :

Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
  If Not _traitement Then
    If _comm.MsgCount > 0 Then
      _traitement = True
      Dim cm As ClassComm.CommMessage = _comm.ReadNextMsg
      'traitement du message ici ou renvoie sur une sub qui traitera
      _traitement = False
    End If
  End If
End Sub



>>>>> C'est quoi idCode dans le commMessage ?
La classe est consciencieuse : quand elle envoit un message, avant de pouvoir en envoyer un nouveau, elle attend d'avoir la confirmation que le message précédent a bien été reçu (bien que le protocole TCP/IP est censé s'en occupé... mais j'ai déjà subit trop de perte en réseau pour des causes inconnues donc avec ça, c'est plus un problème). Chaque message a un idCode unique, et ce code sert d'accusé de réception. Quand la class reçoit un message, elle renvoie l'idCode à l'expéditeur pour dire OK, sinon le dit expéditeur renverra sans cesse le message au bout d'un laps de temps (timeout définit au constructeur) jusqu'à avoir la confirmation que c'est bien reçu.
Pas d'inquiétude, les messages n'arrivent pas en double, le mécanisme est bien géré, tout est vérifié.
Pas d'inquiétude non plus, les nouveaux messages demandés à être envoyé entre un envoi précédent et son propre accusé de réception sont mis en file d'attente pour être envoyé après, donc rien n'est perdu.
Au final on a une class bien aboutie qui gère bien ses comm réseau à la place de l'user.
Bref, ne pas prendre garde à l'idcode, c'est pour info seulement, au cas où on en aurait besoin pour autre chose... sinon pas touche !!
De toute façon c'est une property codée et la valeur de l'IdCode n'est redéfinissable que si elle n'a pas encore été attribuée (valeur 0).







Exemple d'utilisation complet à lire :
Public Class Form1

  Private WithEvents Srv As New ClassComm(25000) 'ici on a déjà un serveur en écoute sur le port 25000
  Private WithEvents Clt1 As ClassComm
  Private WithEvents Clt2 As ClassComm

'en cliquant sur le Button1, on créé le client classComm CLT1 qui va tenter de se connecter au serveur (déjà ouvert juste au dessus)
  Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
    Clt1 = New ClassComm("localhost", 25000)
  End Sub

'ici le serveur reçoit la demande de connexion et l'accepte en créant le client ClassComm CLT2
  Private Sub Srv_ConnectionRequestAccepted(ByRef sck As System.Net.Sockets.Socket) Handles Srv.ConnectionRequestAccepted
    Clt2 = New ClassComm(sck)
  End Sub

'ceci est l'évenement du client ClassComm CLT1 qui confirme que la connexion a bien eu lieu
'a ce stade on a donc une communication prête et ouverte entre CLT1 et CLT2, avec en plus un serveur qui écoute toujours
'normalement c'est fait pour du multiclient donc on devrait pas avoir juste CLT1 et CLT2 mais une collection de client
'et là à ce stade de cette petite appli, vu que ses 2 clients sont pris, on devrait fermer le serveur avec Srv.dispose, mais bref....
  Private Sub Clt1_Connected() Handles Clt1.Connected
    MsgBox("connecté" )
  End Sub

'en cliquand sur le Button2, on fait envoyer un commMessage (ordre + message) par CLT1
  Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
    Clt1.Send(InputBox("ordre" ), InputBox("mon message" ))
  End Sub

'ici j'ai mis un bouton qui permet de dire si la file d'attente du CLT2 contient des messages
  Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
    MsgBox(Clt2.MsgCount)
  End Sub

'et ici un bouton qui lit les messages en attente dans CLT2
  Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
    Dim cm As CommMessage = Clt2.ReadNextMsg
    MsgBox(cm.Order & vbCrLf & cm.Message)

'ici il faudrait (exemple) :
'SELECT CASE cm.Order
'CASE "age" : msgbox ("le type a " & cm.Message & " ans" )
'CASE "nom" : msgbox ("le type s'appelle " & cm.Message)
'CASE "profession" : msgbox ("le type travaille dans " & cm.Message)
'END SELECT

  End Sub


'Les 2 subs précédentes devraient être dans un Timer avec un test sur MsgCount

'ici un exemple de l'event ProblemDetected chez CLT1
  Private Sub Clt1_ProblemDetected(ByVal source As ClassComm.ErrorType) Handles Clt1.ProblemDetected
    Select Case source
      Case ErrorType.connection_failed : MsgBox("échec connexion" )
      Case ErrorType.seems_disconnected : MsgBox("semble déconnecté" )
    End Select
    Clt1.Dispose()
    Clt1 = Nothing
  End Sub

End Class

11 avril 2007 15:48:24 :

Correction du << bug des longueurs >>, voir parmi les premiers commentaires pour l'explication. Dorénavant donc, la procédure Send découpe les ordres/messages trop long en plusieurs sous-messages, le tout étant reconstitué automatiquement à la fin. La propriété MsgCount n'indiquera un nouveau message reçu que lorsque tout les paquets auront été reçus et recollés en interne. Ajout d'une propriété en lecture seule << Sending >>, qui renvoie vrai ou faux selon qu'un envoi est actuellement en cours. Ajout d'un évènement << NewMessage >> qui se déclenche à l'enqueuing d'un message arrivant, uniquement pour informer de son arrivée.

• COMPARAISON ENTRE 2 CHAINES, RETOURNE UN POURCENTAGE DE RESSEMBLANCE (DUPONT = 66,67% DE DURAND)
• CLASS POUR TRANSFERER DES FICHIERS VIA WINSOCK AVEC CONTROLES PENDANT LE TRANSFERT
• CLASS POUR GENERER DYNAMIQUEMENT DES CONTROLES DANS UN CONTENEUR, POUR CREER DES FORMULAIRES DYNAMIQUES
• MOTEUR DE SERVEUR FTP OBJET ET FONCTIONNEL TESTE SOUS FILEZILLA
• ZONE DE SAISIE DE DATE FORMAT JJ/MM/AAAA, N'UTILISEZ PLUS LE CONTROLE MASKEDIT.OCX !

• TRANSFERT DE FICHIERS ENTRE 2 PC DISTANTS
• NAVIGATEUR WEB MODIFIÉ
• IPGUARDIAN
• FUNRADIO :: VB PLAYER + TITRE LIVE
• SOCKET ASYNCHRONES : SERVEUR WEB

• TRANSFERT DE FICHIERS ENTRE 2 PC DISTANTS
• CONVERTIR DU CODE HTML TEXTE AU FORMAT HTML (EN VB6 ET VBA) [MODULE DE CLASSE]
• SOCKET ASYNCHRONES : SERVEUR WEB
• SOCKET ASYNCHRONES : SOURCE D'UNE PAGE HTTP D'UN SERVEUR WEB
• CHAT :SERVEUR/MULTICLIENT