Discussion :

[Gregory666]

Bonsoir a tous,

J'ai un petit problème quand je désactive le serveur "IdTCPServer.Active := False" , l'application ne répond plus


1: Connexion du serveur
2: Je connecte quelque clients
3: je déconnecte le serveur {Application est bloqué quand j’arrête le serveur}

Je vois pas d’où sa peu venir , une petite idée ?, merci pour votre réponse.

[ShaiLeTroll]

Tu n'aurais pas un Thread que tu ne Terminate pas ?
Cela peut être un WaitFor qui attend indéfiniment

As-tu un thread par client ?
Est-ce que ton serveur reçoit bien la notification d'arret de tous les clients.

[Gregory666]

Voici le code , j'ai repris l'exemple : http://mick605.developpez.com/articles/creation-chat/

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
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
const
  MaxUsers = 100;
 
{Class : TUser}
type
  TConnexionState = (csOk, csDisconnecting);
  TUser = class
 
  private
    { Déclarations privées }
 
    FPseudo: String;
    FID: Integer;
    FState: TConnexionState;
 
  public
    { Déclarations publiques }
    constructor Create (APseudo: String; AID: Integer);
 
    property Pseudo: String read FPseudo;
 
    property ID: Integer read FID;
 
    property State: TConnexionState read FState write FState;
 
  end;
 
{............}
 
{Démarrer le serveur}
    procedure BtStartServerClick(Sender: TObject);
 
    {Serveur: Execute}
    procedure IdTCPServerExecute(AContext: TIdContext);
 
    {Client Disconnect Server}
    procedure IdTCPServerDisconnect(AContext: TIdContext);
 
    {Arrêter le serveur}
    procedure BtStopServerClick(Sender: TObject);
 
  private
    { Déclarations privées }
 
    Users : array [1..MaxUsers] of TUser; {100 Utilisateurs MAX}
 
    {Envoie un message a tout les clients}
    procedure SendAll (Mess: String);
 
    {Gestion des messages}
    procedure GestionMessage (AContext: TIdContext; Recept: String);
 
  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:=csOk;
end;
 
procedure TFmServeur.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:= IdTCPServer.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.
  IdTCPServer.Contexts.UnlockList;
end;
 
procedure TFmServeur.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);
  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;
 
{Démarrer le serveur}
procedure TFmServeur.BtStartServerClick(Sender: TObject);
begin
   IdTCPServer.DefaultPort := PortTCPServer.Value;
   IdTCPServer.Active := True;
end;
 
{Serveur: Execute}
procedure TFmServeur.IdTCPServerExecute(AContext: TIdContext);
var
 Recept: String;
begin
  //AContext.Connection.IOHandler.CheckForDataOnSource(5);
  Recept := AContext.Connection.IOHandler.ReadLn;
  GestionMessage(AContext, Recept);
end;
 
{Client Disconnect Server}
procedure TFmServeur.IdTCPServerDisconnect(AContext: TIdContext);
var
 AUser: TUser;
begin
  AUser := TUser(AContext.Data);
 
  if Assigned(AUser) then
  begin
    AUser.State := csDisconnecting;
    SendAll('D' + Format('%.3d', [AUser.ID]) + AUser.Pseudo);
    AContext.Data := nil;
    FreeAndNil(Users[AUser.ID]);
  end;
end;
 
{Arrêter le serveur}
procedure TFmServeur.BtStopServerClick(Sender: TObject);
begin
 IdTCPServer.Active:=false;
end;

[Gregory666]

Quand il y a qu'un client connecte il a pas de problème , au delà sa bloque l’application lors de la déconnexion du serveur.

[Gregory666]

J'ai tester de fermer tout les connexions {Les threads son bien décharger , mais l'application bloque toujours}

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
Procedure TFmServeur.CloseAllConnections;
var
  i: Integer;
begin
 if IdTCPServer.Contexts <> nil then
   begin
     with IdTCPServer.Contexts.LockList do
       begin
         if Count > 0 then
 
         try
            for i := 0 to Count - 1 do
               begin
                 TIdContext(Items[i]).Connection.IOHandler.Close;
                 TIdContext(Items[i]).Connection.Disconnect;
               end;
         finally
          IdTCPServer.Contexts.UnlockList;
         end;
       end;
   end;
end;
 
 
{Arrêter le serveur}
procedure TFmServeur.BtStopServerClick(Sender: TObject);
begin
 CloseAllConnections;
 IdTCPServer.Active := False;
end;

[Gregory666]

Il y a quelque chose qui tourne en boucle dans le IdTCPServer , Même avec tous les Threads "Client" Déchargé sa bloque encore l'application.


L'application reste bloquer dans la procedure BtStopServerClick , j'ai inséré un ShowMessage Pour voir si j'allai jusqu’à la fin de la procédure , est non sa bloque sur IdTCPServer.Active := False;

Code :

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

1
2
3
4
5
6
7
{Arrêter le serveur}
procedure TFmServeur.BtStopServerClick(Sender: TObject);
begin
 CloseAllConnections;
 IdTCPServer.Active:=false;
 ShowMessage(''); {TEST}
end;