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 client : 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
 
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 serveur : 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
 
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..