Création d'un système de chat en Pascal

procedure TFClient.BConnectClick(Sender: TObject);
begin
  if EPseudo.Text='' then
    ShowMessage('Vous devez saisir un pseudo.')
  else
  begin
    //Nous vérifions si l'adresse IP saisie est valide, dans le cas contraire, nous en informons l'utilisateur
    if not GStack.IsIP(EHost.Text) then
      ShowMessage('L''adresse IP saisie est invalide.')
    else
    begin
      try
        //Nous nous connectons. Si cette ligne déclenche une exception, la suite ne sera pas exécutée.
        //Le port saisi ici doit être le même que celui du serveur.
        IdTCPClient1.Connect(EHost.Text,3333);
 
        //Envoi du message de demande de connexion. À ce stade, nous ne sommes pas encore en capacité de
        //communiquer avec les autres clients. Le serveur doit d'abord vérifier quelques paramètres, et
        //nous renvoyer une réponse
        IdTCPClient1.IOHandler.WriteLn('C'+EPseudo.Text);
 
        //Nous créons notre thread destiné à gérer la réception des messages.
        FReceptionThread:=TReceptionthread.Create(false,IdTCPClient1);
        // Nous lui affectons aussi son évènement OnReception.
        FReceptionThread.OnReception:=ReceptionMessage;
      except
        ShowMessage('Connexion avec le serveur impossible.');
      end;
    end;
  end;
end;

procedure TFClient.BSendClick(Sender: TObject);
begin
  //Envoi du texte de l'edit
  IdTCPClient1.IOHandler.WriteLn('*'+Format('%3i',[MonID])+EMessage.Text);
  EMessage.Clear;
end;

procedure TFClient.ReceptionMessage (Sender : TObject; Recept : string);
  //Évènement OnReception de notre objet TReceptionThread
 
 
  function ExtractIDUser (Mess : string) : integer;
  //fonction qui extrait les trois premiers caractères du message et retourne l'ID
  begin
    if Length(Mess)>=2 then
      Result:=StrToIntDef(Mess[1]+Mess[2]+Mess[3],-1)
    else
      Result:=-1;
  end;
 
 
  procedure ConnectionSucceed (R : string);
  //R contient un message de connexion réussie de la forme << ID >> qui signifie que nous sommes connectés avec l'identifiant ID
  begin
    //MonID est une variable globale contenant notre identifiant
    MonID:=ExtractIDUser(R);
 
    //Stockage de notre pseudo dans le tableau d'utilisateurs
    Users[MonID]:=EPseudo.Text;
 
    //Nous annonçons notre connexion et nous activons les composants nécessaires
    MChat.Lines.Add(' --- Connexion établie --- ');
    BDisconnect.Enabled:=true;
    BConnect.Enabled:=false;
    BSend.Enabled:=true;
    EMessage.Enabled:=true;
    MChat.Enabled:=true;
    EPseudo.Enabled:=false;
    LBClientsConnectes.Items.Add('- Liste des clients connectés -');
 
    //Nous ajoutons notre pseudo dans la ListBox
    LBClientsConnectes.Items.Add(EPseudo.Text);
  end;
 
  procedure ConnectionFailed (R : string);
  //R contient un message de connexion échouée de la forme << Raison >> qui signifie que nous ne sommes pas connectés car : Raison
  begin
    //Nous affichons les informations nécessaires
    MChat.Lines.Add(' --- Connexion échouée --- ');
    MChat.Lines.Add('Raison : '+R);
 
    //Nous nous déconnectons du serveur
    IdTCPClient1.Disconnect;
  end;
 
  procedure UserConnection(R : string);
  //R contient un message de connexion de la forme << ID + Pseudo >> qui signifie que Pseudo vient de se connecter avec l'identifiant ID
  var ID : integer;
      Pse : string;
  begin
    //ID contient l'identifiant du message
    ID:=ExtractIDUser(R);
    //Pse contient le Pseudo
    Pse:=Copy(R,4,MaxInt);
    //Nous enregistrons l'utilisateur dans le tableau
    Users[ID]:=Pse;
 
    //Nous annonçons la connexion du client
    MChat.Lines.Add(Pse+' vient de se connecter.');
 
    //Nous ajoutons son nom dans la ListBox
    LBClientsConnectes.Items.Add(Pse);
  end;
 
  procedure UserDeconnection(R : string);
  //R contient un message de déconnexion de la forme << ID >> qui signifie que la personne avec l'identifiant ID vient de se déconnecter
  var ID : integer;
      Pse : string;
  begin
    //ID contient l'identifiant du message
    ID:=ExtractIDUser(R);
    //Pse contient le Pseudo sauvegardé lors de la connexion
    Pse:=Users[ID];
 
    //Nous annonçons la déconnexion du client
    MChat.Lines.Add(Pse+' vient de se déconnecter.');
 
    //Nous effaçons du tableau le client déconnecté
    Users[ID]:='';
 
    //Nous cherchons et supprimons son nom dans la ListBox
    I:=LBClientsConnectes.Items.IndexOf(Pse);
    if I<>-1 then LBClientsConnectes.Items.Delete(I);
  end;
 
  procedure ReceptMessageTexte (R : string);
  //R contient un message texte de la forme << ID + Texte >> qui signifie que la personne avec l'identifiant ID dit "Texte"
  var ID : integer;
      Pse : string;
      Texte : string;
  begin
    //ID contient l'identifiant du message
    ID:=ExtractIDUser(R);
    //Pse contient le Pseudo stocké lors de la connexion
    Pse:=Users[ID];
    //Texte contient le texte envoyé par l'utilisateur
    Texte:=Copy(R,4,MaxInt);
 
    //Nous affichons le texte précédé du pseudo de l'émetteur
    MChat.Lines.Add(Pse+' dit :');
    MChat.Lines.Add(' > '+Texte);
  end;
 
 
var Repere : char;
begin
  //le premier caractère du message permet de différencier la marche à suivre
  Repere:=Recept[1];
  //Nous l'effaçons de la chaine de caractères
  Delete(Recept,1,1);
 
  //Suivant les cas, on exécute une des procédures ci-dessous
  case Repere of
    'O' : ConnectionSucceed(Recept);
    'N' : ConnectionFailed(Recept);
    'C' : UserConnection(Recept);
    'D' : UserDeconnection(Recept);
    '*' : ReceptMessageTexte(Recept);
  end;
end;

type
  TConnexionState = (csOk, csDisconnecting);
 
  TUser = class
  private
    FPseudo : string;
    FID : integer;
    FState : TConnexionState;
  public
    constructor Create (APseudo : string; AID : integer);
 
    property Pseudo : string read FPseudo;
    property ID : integer read FID;
    property State : TConnexionState read FState write FState;
  end;
 
...
 
constructor TUser.Create (APseudo : string; AID : integer);
//Nous créons notre objet TUser en l'initialisant avec les bonnes valeurs
begin
  inherited Create;
 
  FPseudo:=APseudo;
  FID:=AID;
  FState:=usOk;
end;

Users : array [1..MAXUSERS] of TUser;

procedure TFServeur.SendAll (Mess : string);
var ListeContext : TList;
    i : integer;
    AUser : TUser;
begin
  //Nous récupérons la liste des IdContext qui correspond à la liste des clients
  ListeContext:=IdTCPServer1.Contexts.LockList;
 
  //Pour chaque client prêt (State = usOK), on envoie le message Mess
  for i:=0 to ListeContext.Count-1 do
  begin
    AUser:=TUser(TIdContext(ListeContext.Items[i]).Data);
 
    if Assigned(AUser) and (AUser.State=usOk) then TIdContext(ListeContext.Items[i]).Connection.IOHandler.WriteLn(Mess);
  end;
 
  //Comme nous avons appelé LockList, nous devons débloquer la liste.
  IdTCPServer1.Contexts.UnlockList;
end;

procedure TFServeur.IdTCPServer1Disconnect(AContext: TIdContext);
var AUser : TUser;
begin
  //On stocke dans une variable temporaire les caractéristiques de l'utilisateur qui se déconnecte
  AUser:=TUser(AContext.Data);
 
  if Assigned(AUser) then
  begin
    //On met son statut en Disconnecting pour éviter qu'il ne reçoive le message lors du SendAll suivant
    AUser.State:=csDisconnecting;
 
    //On envoie à tous les clients l'annonce de la déconnexion
    SendAll('D'+Format('%.3d',[AUser.ID])+AUser.Pseudo);
 
    //On efface le pointeur Data et on libère le client du tableau Users
    AContext.Data:=nil;
    Users[AUser.ID].Free;
  end;
end;

procedure TFServeur.IdTCPServer1Execute(AContext: TIdContext);
var Recept : string;
begin
  //Lecture du message
  Recept:=AContext.Connection.IOHandler.ReadLn;
 
  //Analyse du message
  GestionMessage(AContext,Recept);
end;

procedure TFServeur.GestionMessage (AContext : TIdContext; Recept : string);
 
  procedure EnvoiListeUsers;
  var i : integer;
  begin
    //On parcourt le tableau Users et on envoie la liste des personnes connectées à notre client
    for i:=1 to MAXUSERS do
      if Assigned(Users[i]) and (Users[i].State=csOk) then
        AContext.Connection.IOHandler.WriteLn('C'+Format('%.3d',[i])+Users[i].Pseudo);
  end;
 
  procedure DemandeConnection(R : string);
  //R contient un message de demande de connexion de la forme << Pseudo >> qui signifie que Pseudo veut se connecter
  var Raison : string;
      IsPossibleConnection : boolean;
      ID : integer;
  begin
    IsPossibleConnection:=true;
 
    //Nous testons si une personne ne possède pas le même pseudo
    ID:=0;
    repeat
      inc(ID);
    until (ID>MAXUSERS) or (Assigned(Users[ID]) and (Users[ID].Pseudo=R));
 
    if ID<=MAXUSERS then
    begin
      IsPossibleConnection:=false;
      Raison:='Pseudo déjà utilisé';
    end;
 
    if IsPossibleConnection then
    begin
      //Nous vérifions s'il reste de la place dans le serveur
      ID:=1;
      while (ID<=MAXUSERS) and Assigned(Users[ID]) do
        inc(ID);
 
      if ID>MAXUSERS then
      begin
        IsPossibleConnection:=false;
        Raison:='Serveur plein'
      end;
      //ici, la variable ID contient l'indice de la première place libre dans le tableau Users
    end;
 
    //Maintenant que nos tests sont finis, nous répondons à l'utilisateur
    if not IsPossibleConnection then
    begin
      //Connexion impossible
      AContext.Connection.IOHandler.WriteLn('N'+Raison);
    end
    else
    begin
      //Connexion possible avec l'identifiant ID
      AContext.Connection.IOHandler.WriteLn('O'+Format('%.3d',[ID]));
 
      //Envoi de la liste des personnes déjà connectées
      EnvoiListeUsers;
 
      //Annonce de la connexion de l'utilisateur à tous les autres utilisateurs
      SendAll('C'+Format('%.3d',[ID])+R);
 
      //Stockage dans le tableau Users
      Users[ID]:=TUser.Create(R,ID);
 
      //On fait pointer la propriété Data du IdContext vers notre nouveau TUser
      AContext.Data:=Users[ID];
    end;
 
  end;
 
  procedure ReceptMessageTexte (R : string);
  //R contient un message texte de la forme << ID + Texte >> qui signifie que la personne avec l'identifiant ID dit "Texte"
  begin
    SendAll('*'+R);
  end;
 
 
var Repere : char;
begin
  //Le premier caractère du message permet de différencier la marche à suivre
  Repere:=Recept[1];
  //Nous l'effaçons de la chaine de caractères
  Delete(Recept,1,1);
 
  //Suivant les cas, on exécute une des procédures ci-dessous
  case Repere of
    'C' : DemandeConnection(Recept);
    '*' : ReceptMessageTexte(Recept);
  end;
end;