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

- - Dernière réponse : MiniApp
Messages postés
654
Date d'inscription
lundi 21 juillet 2014
Dernière intervention
5 décembre 2018
- 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.
Afficher la suite 

Votre réponse

1 réponse

Messages postés
654
Date d'inscription
lundi 21 juillet 2014
Dernière intervention
5 décembre 2018
0
Merci
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 !!!)
Commenter la réponse de MiniApp

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.