Discussion :

[Gregory666]

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.

Si plusieurs clients se déconnecté en mémé temps sa bloque le serveur impossible de rétablir une connexion avec le serveur.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
  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;

IdTCPServer Disconnect

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
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;

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


http://mick605.developpez.com/articles/creation-chat/

Code Source : systeme-chat-v2.zip

Merci pour votre réponse.

[Gregory666]

La source du problème "SendAll" j'ai retiré cette ligne est la impeccable mais maintenant les clients ne son pas informé de la déconnexion.


//On envoie à tous les clients l'annonce de la déconnection
SendAll('D'+Format('%.3d',[AUser.ID])+AUser.Pseudo);

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
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 efface le pointeur Data et on libère le client du tableau Users
    AContext.Data:=nil;
    FreeAndNil(Users[AUser.ID]);
  end;
end;

[Gregory666]

Je pence avoir résolut le problème avec

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
if Assigned(AUser) and (AUser.State = csOk) then 
     try
      TIdContext(ListeContext.Items[i]).Connection.IOHandler.WriteLn(Mess);
     except
        Continue;
     end;

J'ai connecté 200 Clients sur le serveur puis j'ai appliquer un "fin de tâche" sur 199 clients , Serveur OK pas de blocage, Pas d’expression ... , pour le client qui n'a pas été déconnecté sa liste des clients a été mise a jour correctement je pence que le problème est résolu

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
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 
     try
      TIdContext(ListeContext.Items[i]).Connection.IOHandler.WriteLn(Mess);
     except
        Continue;
     end;
  end;
 
  //Comme nous avons appelé LockList, nous devons débloquer la liste.
  IdTCPServer1.Contexts.UnlockList;
end;