SERVEUR TELNET (MULTI-CLIENTS)

VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.UserControl TelnetMultiServer 
   ClientHeight    =   4635
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   3075
   ScaleHeight     =   4635
   ScaleWidth      =   3075
   Begin VB.TextBox txtState 
      Height          =   350
      Index           =   0
      Left            =   120
      Locked          =   -1  'True
      TabIndex        =   0
      Top             =   120
      Width           =   2775
   End
   Begin VB.Timer tmStateCheck 
      Left            =   3180
      Top             =   105
   End
   Begin MSWinsockLib.Winsock TcpServer 
      Index           =   0
      Left            =   3195
      Top             =   645
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
End
Attribute VB_Name = "TelnetMultiServer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Const nMAX_CLIENTS As Integer = 10
Private IndexUsed(nMAX_CLIENTS) As Boolean
Private LastReceivedData(nMAX_CLIENTS) As String
Private MemoServerState(nMAX_CLIENTS) As Integer

Event ClientConnected(RemoteIP As String, index As Integer)
Event DataFromClient(Data As String, index As Integer)

Private Sub UserControl_Initialize()
    Dim ServerIndex As Integer
    
    ' Paramètres de la connexion
    TcpServer(0).Protocol = sckTCPProtocol
    TcpServer(0).LocalPort = 23
    TcpServer(0).Listen
    IndexUsed(0) = True
    ' Paramètres du timer
    tmStateCheck.Interval = 500
    tmStateCheck.Enabled = False
    ' Init
    For ServerIndex = 0 To nMAX_CLIENTS
        MemoServerState(ServerIndex) = -1
    Next ServerIndex
End Sub

Private Sub UserControl_InitProperties()
    ' Si le conteneur du contrôle est en mode création,
    ' désactivation du timer, qui perturbe le fonctionnement du contrôle.
    tmStateCheck.Enabled = Ambient.UserMode
End Sub

Private Sub UserControl_ReadProperties( _
    PropBag As PropertyBag)
    
    ' Si le conteneur du contrôle est en mode création,
    ' désactivation du timer, qui perturbe le fonctionnement du contrôle.
    tmStateCheck.Enabled = Ambient.UserMode
End Sub

Private Sub UserControl_Terminate()
    Dim ServerIndex As Integer
    
    tmStateCheck.Enabled = False
    For ServerIndex = 1 To nMAX_CLIENTS
        If IndexUsed(ServerIndex) Then
            TcpServer(ServerIndex).Close
            Unload TcpServer(ServerIndex)
            Unload txtState(ServerIndex)
            IndexUsed(ServerIndex) = False
        End If
    Next ServerIndex
    TcpServer(0).Close
End Sub

Private Sub TcpServer_ConnectionRequest( _
    index As Integer, _
    ByVal requestID As Long)
    
    Dim FreeServerIndex As Integer
    
    If index = 0 Then
        ' Recherche d'un numéro libre
        FreeServerIndex = 1
        Do
            If IndexUsed(FreeServerIndex) = False Then Exit Do
            FreeServerIndex = FreeServerIndex + 1
            ' On n'accepte pas plus de nMAX_CLIENTS
            If FreeServerIndex > nMAX_CLIENTS Then Exit Sub
        Loop
        ' Numéro libre trouvé
        IndexUsed(FreeServerIndex) = True
        Load TcpServer(FreeServerIndex)
        Load txtState(FreeServerIndex)
        txtState(FreeServerIndex).Top = 120 + (FreeServerIndex * 400)
        txtState(FreeServerIndex).Visible = True
        TcpServer(FreeServerIndex).LocalPort = 0
        TcpServer(FreeServerIndex).Listen
        ' Vérifie que le serveur est prêt
        If TcpServer(FreeServerIndex).State = sckListening Then
            ' Ferme l'attente d'autres clients
            TcpServer(FreeServerIndex).Close
            ' Accepte la demande de connexion avec le paramètre requestID
            TcpServer(FreeServerIndex).Accept requestID
        End If
    End If
End Sub
 

Télécharger le zip