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..
Partager