TtcpServer - code interdit dans OnAccept ?
Bonjour
J’ai réalisé une petite application pour m’approprier les composants TtcpServer et TtcpClient.. Elle permet de chatter et d’envoyer des fichiers.
Ça marche.
Mais j’ai constaté avec surprise que si je rajoute dans le code du OnAccept de TTtpserver1, cette simple ligne de code « Progress.visible := true ; » (barre de progression destinée à indiquer l’avancement de la réception du fichier), cela perturbe l’application. : Quand j’essaye de la fermer j’ai un messages d’erreur « l’application ne répond plus voulez vous terminer ?».
Si par contre dans le OnAccept je positionne un booléen, que je teste dans un timer pour rendre la progressbar visible tout est ok.
Ci dessous j’ai séparé et simplifié à l’extrême le code du client et du serveur pour éliminer le maximum de cause d’erreurs. Le problème subsiste.
Comment expliquer ce phénomène ?
Code:
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
|
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Sockets;
type
TForm1 = class(TForm)
Button1: TButton;
TcpClient1: TTcpClient;
Memo1: TMemo;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Déclarations privées }
public
{ Déclarations publiques }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
message: string;
begin
// On envoie bonjour
message := 'bonjour';
TcpClient1.Connect;
TcpClient1.Sendln(message);
memo1.Lines.Add('message envoyé : ' + message);
sleep(10);
Tcpclient1.Disconnect;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
TcpClient1.Active := false;
Tcpclient1.RemoteHost := '192.168.1.45';
Tcpclient1.RemotePort := '2001';
TcpClient1.Active := True;
if TcpClient1.Connected then
memo1.Lines.Add('Le serveur est connecté ' + 'port distant : '+
tcpclient1.RemotePort+
' adresse ' + Tcpclient1.RemoteHost)
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
TcpClient1.Active := false ;
end;
end |
Code:
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
|
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, Sockets, StdCtrls, strutils ;
type
TForm1 = class(TForm)
ProgressR: TProgressBar;
TcpServer1: TTcpServer;
Memo1: TMemo;
ButtonCnx: TButton;
procedure TcpServer1Accept(Sender: TObject; ClientSocket: TCustomIpClient);
procedure ButtonCnxClick(Sender: TObject);
private
{ Déclarations privées }
public
{ Déclarations publiques }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.ButtonCnxClick(Sender: TObject);
begin
TcpServer1.Active := false;
TcpServer1.LocalPort := '2001';
TcpServer1.Active := true;
If TcpServer1.Listening then
memo1.Lines.Add('le serveur est à l''écoute sur le port '+TcpServer1.LocalPort)
Else
memo1.Lines.Add('Problèmz :le serveur n''est à l''écoute sur le port '+TcpServer1.LocalPort);
end;
procedure TForm1.TcpServer1Accept(Sender: TObject;
ClientSocket: TCustomIpClient);
var
Line: string;
begin
//progressR.Visible := true;
memo1.Lines.Add(' Evenement on accept');
Line := ClientSocket.Receiveln;
memo1.Lines.Add('message reçu : ' + line);
ClientSocket.Disconnect; //A la fin, on déconnecte
end;
end.. |
