Sujet Précédent Sujet Suivant

IdTCPServer ne décharge pas les clients qui se déconnecte bruta

Xilence - 21 déc. 2015 à 20:48
MiniApp Messages postés 654 Date d'inscription lundi 21 juillet 2014 Statut Membre Dernière intervention 22 février 2019 - 21 mars 2016 à 20:33
Bonsoir ,

Je viens de testé une simulation de déconnexion de plusieurs clients en coupent leur connexion internet , je me suis aperçu que le IdTCPServer ne décharge pas les threads, il ne détecte pas leur déconnexion, par conte quand je ferme un client manuellement le serveur détecte sa déconnexion est décharge son thread. 

unit UServeur2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPServer, IdContext, StdCtrls, Contnrs;

const
  MAXUSERS = 100;

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;

  TFServeur = class(TForm)
    IdTCPServer1: TIdTCPServer;
    procedure IdTCPServer1Disconnect(AContext: TIdContext);
    procedure IdTCPServer1Execute(AContext: TIdContext);
  private
    Users : array [1..MAXUSERS] of TUser;

    procedure SendAll (Mess : string);
    procedure GestionMessage (AContext : TIdContext; Recept : string);
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  FServeur: TFServeur;

implementation

{$R *.dfm}



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:=csOk;
end;

procedure TFServeur.SendAll (Mess : string);
var ListeContext : TList;
    i : integer;
    AUser : TUser;
begin
  //Nous récupérons la liste des IdContext qui correspond a la liste des clients
  ListeContext:=IdTCPServer1.Contexts.LockList;

  //Pour chaque client prêt (State = csOk), 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=csOk) 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.GestionMessage (AContext : TIdContext; Recept : string);

  procedure EnvoiListeUsers;
  var i : integer;
  begin
    //On parcours 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 possede 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 si 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 test sont finis, nous répondons à l'utilisateur
    if not IsPossibleConnection then
    begin
      //Connection impossible
      AContext.Connection.IOHandler.WriteLn('N'+Raison);
    end
    else
    begin
      //Connection possible avec l'indentifiant ID
      AContext.Connection.IOHandler.WriteLn('O'+Format('%.3d',[ID]));

      //Envoi de la liste des personnes déjà connectées
      EnvoiListeUsers;

      //Annonce de la connection de l'utilisateur a 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ère
  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;

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.IdTCPServer1Disconnect(AContext: TIdContext);
var AUser : TUser;
begin
  //On stocke dans une variable temporaire les caracteristiques 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 recoive le message lors du SendAll suivant
    AUser.State:=csDisconnecting;

    //On envoie à tous les clients l'annonce de la déconnection
    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;
    FreeAndNil(Users[AUser.ID]);
  end;
end;

end.


Une idée d’où le problème peu venir ?

Merci pour votre réponse.

1 réponse

Réponse 1 / 1
MiniApp Messages postés 654 Date d'inscription lundi 21 juillet 2014 Statut Membre Dernière intervention 22 février 2019 5
21 mars 2016 à 20:33
Bonjour

Réponse très tardive mais j'espère quelle peut vous aider. Peut être que la cause est que la connection n'est pas proprement rompu au niveau de TCP. Du coup si ceci te gêne tu peut implémenter par exemple un système de KeepAlive (tu ping régulièrement). Après perso je déteste Indy. (Je fais actuellement des sockets un peu dans le genre d'Indy mais en facile !!!)
0

Discussions similaires

Probleme avec les IdTCPClient et IdTCPServer
cs_Champy70 -
Champy70 -

10 réponses
Transefert de fichiers IdTCPClient et IdTCPServer
ewertheimer -
mrsimo7 -

1 réponse
Rejoignez-nous