Utilisation de TAsyncProcess

Version imprimable

1 pièce(s) jointe(s)

Bjr à vous,

Je désire lancer un programme externe qui génère de très longues sorties. Le programme externe est lancé du démarrage de mon application. Il envoie à intervalles irréguliers (en fait, il récupère des données d'un instrument de mesure) des lignes de données texte.
Comme le programme externe travaille en arrière plan, j'ai mis un TAsyncProcess dans un thread.

Je cherche à:
1. Récupérer la sortie standard du programme dans un TListbox ou équivalent
2. Dès qu'une ligne de données arrive, je la récupère pour traitement.

Je bute sur beacoup de choses:
- Le programme externe se lance dans une fenêtre en mode bloquant
- AV à la fermeture

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
procedure TdlgTestAsyncProcess.btnStartProcessClick(Sender: TObject);
begin
  AfficherMessage('Démarrage du thread');           
   FAsyncProcessThread.Executable  := 'Triangulateur.exe'; // Le programme console qui envoie les données
      AfficherMessage('--> 001');
      FAsyncProcessThread.OnReadData  := self.AsyncProcessOnReadData; // Le callback censé récupérer les données
      AfficherMessage('--> 002');
      FAsyncProcessThread.OnTerminate := self.AsyncProcessOnTerminate; // Le callback de terminaison du process
      FAsyncProcessThread.Options     := [poUsePipes];
      AfficherMessage('--> 003');
      FOutputStream := TMemoryStream.Create;
      AfficherMessage('--> 004');
      FOutputStream := TMemoryStream(FAsyncProcessThread.Output);
      AfficherMessage('--> 005');
      FAsyncProcessThread.Execute;
end;

Quelques tuyaux ?

L'unité unitTAsyncProcessThread:

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
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
 
unit unitTAsyncProcessThread;
 
{$mode delphi}{$H+}
 
interface
 
uses
  Classes, SysUtils, process, AsyncProcess, Pipes;
 
type
 
  { TAsyncProcessThread }
 
  TAsyncProcessThread = class(TThread)
  private
    FProcess: TAsyncProcess;
    FMessage: string;
    function  getExecutable(): TProcessString;
    function  getOptions: TProcessOptions;
    function  getOutput(): TInputPipeStream;
    procedure setExecutable(const P: TProcessString);
    function  getProcOnReadData(): TNotifyEvent;
    function  getProcOnTerminate(): TNotifyEvent;
    procedure setOptions(const AValue: TProcessOptions);
    procedure setProcOnReadData(const E: TNotifyEvent);
    procedure setProcOnTerminate(const E: TNotifyEvent);
  protected
    procedure DoMessage;
  public
    constructor Create(AOwner: TComponent);
    destructor  Destroy; override;
    property    Output: TInputPipeStream read getOutput;
    property    Options: TProcessOptions read getOptions write setOptions;
 
    property    Executable: TProcessString read getExecutable write SetExecutable;
    procedure   AddParameter(const P: TProcessString);
    property    OnReadData: TNotifyEvent read getProcOnReadData   write setProcOnReadData;
    property    OnTerminate: TNotifyEvent read getProcOnTerminate write setProcOnTerminate;
 
 
    procedure   Execute; override;
 
    //procedure   ReadData(Sender: TObject);
    procedure   OnProcTerminate(Sender: TObject);
    procedure   SendMessage(AString: string);
 
  end;
 
 
 
 
implementation
uses
  Common;
 
procedure TAsyncProcessThread.Execute;
begin
  FreeOnTerminate:= True;
  try
    FProcess.Execute;
    if not FProcess.WaitOnExit then
      raise Exception.Create('Error: Process exited with status: ' + FProcess.ExitStatus.ToString);
  finally
    //FProcess.Free;
  end;
end;
 
procedure TAsyncProcessThread.SendMessage(AString: string);
begin
  FMessage:= AString;
  Synchronize(DoMessage);
end;
 
function TAsyncProcessThread.getExecutable(): TProcessString;
begin
  Result := FProcess.Executable;
end;
 
function TAsyncProcessThread.getOptions: TProcessOptions;
begin
  Result := FProcess.Options;
end;
 
function TAsyncProcessThread.getOutput: TInputPipeStream;
begin
  Result := FProcess.Output;
end;
 
procedure TAsyncProcessThread.setExecutable(const P: TProcessString);
begin
  FProcess.Executable := P;
end;
 
function TAsyncProcessThread.getProcOnReadData(): TNotifyEvent;
begin
  Result := FProcess.OnReadData;
end;
 
function TAsyncProcessThread.getProcOnTerminate(): TNotifyEvent;
begin
  Result := FProcess.OnTerminate;
end;
 
procedure TAsyncProcessThread.setOptions(const AValue: TProcessOptions);
begin
  FProcess.Options := AValue;
end;
 
procedure TAsyncProcessThread.setProcOnReadData(const E: TNotifyEvent);
begin
  FProcess.OnReadData := E;
end;
 
procedure TAsyncProcessThread.setProcOnTerminate(const E: TNotifyEvent);
begin
  FProcess.OnTerminate := E;
end;
 
procedure TAsyncProcessThread.AddParameter(const P: TProcessString);
begin
  FProcess.Parameters.Add(P);
end;
 
procedure TAsyncProcessThread.DoMessage;
begin
  //frmMain.OnProcessRead(Self, FMessage);
end;
 
constructor TAsyncProcessThread.Create(AOwner: TComponent);
begin
  FProcess := TAsyncProcess.Create(AOwner);
end;
 
procedure TAsyncProcessThread.OnProcTerminate(Sender: TObject);
begin
  //SendMessage('Process Terminated');
end;
 
destructor TAsyncProcessThread.Destroy;
begin
  FreeAndNil(FProcess);
  //SendMessage('<Thread is destroyed!>');
  inherited Destroy;
end;
 
end.

La form d'utilisation:

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
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
 
unit frmMainTAsyncProcess;
// Pilote pour TAsyncProcessThread
 
{$mode delphi}{$H+}
 
interface
 
uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
  process,
  unitTAsyncProcessThread;
 
type  TdlgTestAsyncProcess = class(TForm)
    btnStartProcess: TButton;
    btnStopProcess: TButton;
    lsbMessages: TListBox;
    lsbOutput: TListBox;
    procedure btnStartProcessClick(Sender: TObject);
    procedure btnStopProcessClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
 
  private
    FOutputStream: TMemoryStream;
    FAsyncProcessThread: TAsyncProcessThread;
    procedure FormDestroy(Sender: TObject);        procedure AfficherMessage(const Msg: string);
    procedure AsyncProcessOnReadData(Sender: TObject);
    procedure AsyncProcessOnTerminate(Sender: TObject);
  public
 
  end;
 
var
  dlgTestAsyncProcess: TdlgTestAsyncProcess;
 
implementation
 
{$R *.lfm}
 
{ TdlgTestAsyncProcess }
 
procedure TdlgTestAsyncProcess.AsyncProcessOnReadData(Sender: TObject);
var
  BytesAvailable: DWord;
  s: string;
  sa: SysUtils.TStringArray;
begin
  if Assigned(FAsyncProcessThread) then
  try
    // Check how much data is waiting
    BytesAvailable:= FAsyncProcessThread.Output.NumBytesAvailable;
    setlength(s, BytesAvailable);
    // Read data and store in string s
    FAsyncProcessThread.Output.Read(s[1], BytesAvailable);
    // Split output by cr/lf into separate strings
    sa:= s.split(#13#10);
    for s in sa do
    begin
      lsbOutput.Items.Add(s);
    end;
 
  except
    On E : Exception do
      raise Exception.Create('Exception in procedure ReadData! - ' +E.Message);
  else
    raise Exception.Create('No process assigned!');
  end;
end;
procedure TdlgTestAsyncProcess.AsyncProcessOnTerminate(Sender: TObject);
begin
  AfficherMessage('Fin du thread');
  AfficherMessage('--> 001');
  ShowMessage('Processus nuisible terminé');
end;
 
procedure TdlgTestAsyncProcess.btnStartProcessClick(Sender: TObject);
begin
  AfficherMessage('Démarrage du thread');
 
  //try
    //try
      FAsyncProcessThread.Executable  := 'Triangulateur.exe'; // Le programme console qui envoie les données
      AfficherMessage('--> 001');
      FAsyncProcessThread.OnReadData  := self.AsyncProcessOnReadData; // Le callback censé récupérer les données
      AfficherMessage('--> 002');
      FAsyncProcessThread.OnTerminate := self.AsyncProcessOnTerminate; // Le callback de terminaison du process
      FAsyncProcessThread.Options     := [poUsePipes];
      AfficherMessage('--> 003');
      FOutputStream := TMemoryStream.Create;
      AfficherMessage('--> 004');
      FOutputStream := TMemoryStream(FAsyncProcessThread.Output);
      AfficherMessage('--> 005');
      FAsyncProcessThread.Execute;
    //except
    //end;
  //finally
  //end;
end;
 
procedure TdlgTestAsyncProcess.btnStopProcessClick(Sender: TObject);
begin
  AfficherMessage('Finalisation du thread et récupération des messages');
  FOutputStream.LoadFromStream(FAsyncProcessThread.Output);
  AfficherMessage('--> 001');
  lsbOutput.Items.LoadFromStream(FOutputStream);
  AfficherMessage('--> 002');
  FAsyncProcessThread.Terminate;
  FreeandNil(FOutputStream);
end;
 
procedure TdlgTestAsyncProcess.FormCreate(Sender: TObject);
begin
  FAsyncProcessThread := TAsyncProcessThread.Create(self);
end;
 
procedure TdlgTestAsyncProcess.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FAsyncProcessThread);
end;
 
procedure TdlgTestAsyncProcess.AfficherMessage(const Msg: string);
begin
  lsbMessages.Items.Add(Msg);
  lsbMessages.ItemIndex := lsbMessages.Items.Count -1;
end;
end.

Exemple de sortie de programme externe que je veux récupérer:

Citation:

triangle [-prq__a__uAcDjevngBPNEIOXzo_YS__iFlsCQVh] input_file
-p Triangulates a Planar Straight Line Graph (.poly file).
-r Refines a previously generated mesh.
-q Quality mesh generation. A minimum angle may be specified.
-a Applies a maximum triangle area constraint.
-u Applies a user-defined triangle constraint.
-A Applies attributes to identify triangles in certain regions.
-c Encloses the convex hull with segments.
-D Conforming Delaunay: all triangles are truly Delaunay.
-j Jettison unused vertices from output .node file.
-e Generates an edge list.
-v Generates a Voronoi diagram.
-n Generates a list of triangle neighbors.
-g Generates an .off file for Geomview.
-B Suppresses output of boundary information.
-P Suppresses output of .poly file.
-N Suppresses output of .node file.
-E Suppresses output of .ele file.
-I Suppresses mesh iteration numbers.
-O Ignores holes in .poly file.
-X Suppresses use of exact arithmetic.
-z Numbers all items starting from zero (rather than one).
-o2 Generates second-order subparametric elements.
-Y Suppresses boundary segment splitting.
-S Specifies maximum number of added Steiner points.
-i Uses incremental method, rather than divide-and-conquer.
-F Uses Fortune's sweepline algorithm, rather than d-and-c.
-l Uses vertical cuts only, rather than alternating cuts.
-s Force segments into mesh by splitting (instead of using CDT).
-C Check consistency of final mesh.
-Q Quiet: No terminal output except errors.
-V Verbose: Detailed information on what I'm doing.
-h Help: Detailed instructions for Triangle.

28/03/2025, 09h49
JP CASSOU

Pour Jurassik Pork:

https://forum.lazarus.freepascal.org...?topic=69618.0

Bjr à tous,

Jurassik Pork a développé un outil à cet effet. Testé sous Windows, il marche très bien avec la commande 'ping', mais pour les autres programmes console, il n'affiche le résultat qu'à la fermeture de ces programmes, alors que je souhaite afficher et récupérer les données de leur sortie en temps réel (le programme console envoie ses données issues d'instruments de mesure)

Semble résolu. Deux variantes

J'ai tenté avec deux autres approches. Cà marche

Fiche vierge avec
4 TButton
1 TAsyncProcess
1 TMemo
1 TListBox

Button1 lance RunConsoleWithRedirect(), qui ne fonctionne que sous Windows, est bloquant et utilise CreatePipe()

Button2 démarre le programme externe (Bidon.exe) avec StartAsyncProcess(). Un nouvel appui sur ce bouton signale que le process est en cours et propose de le stopper ou de le laisser poursuivre

Button3 stoppe le processus

Button4 lance un traitement long (pour montrer que l'application n'est pas bloquée)

Et maintenant, servez-vous ;) Je vais essayer d'en faire un composant

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
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
 
 
unit MainFrorm;
 
{$mode delphi}{$H+}
 
interface
 
uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, AsyncProcess, Windows, Process, LCLType;
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    AsyncProcess1: TAsyncProcess;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    ListBox1: TListBox;
    Memo1: TMemo;
    procedure AsyncProcess1ReadData(Sender: TObject);
    procedure AsyncProcess1Terminate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    procedure RunConsoleWithRedirect(const ProgConsoleName: string; const Params: array of string);
    procedure StartAsyncProcess(const ProgConsoleName: string; const Params: array of string);
 
  public
 
  end;
var
  Form1: TForm1;
 
implementation
 
{$R *.lfm}
 
procedure TForm1.Button1Click(Sender: TObject);
var
  EWE: String;
begin
  EWE := ExtractFilePath(ParamStr(0)) + 'Bidon.exe'; // Le programme console à exécuter
  RunConsoleWithRedirect(EWE, ['6']);
  //RunConsoleWithRedirect('Triangulateur.exe', ['']);
  ShowMessage('Terminé');
end;
 
procedure TForm1.AsyncProcess1ReadData(Sender: TObject);
var
  OutputString: string;
begin
  // Lire la sortie du processus
  SetLength(OutputString, AsyncProcess1.Output.NumBytesAvailable);
  AsyncProcess1.Output.Read(OutputString[1], Length(OutputString));
  // Ajouter au TMemo
  if (Trim(OutputString) <> '') then Memo1.Lines.Add(Trim(OutputString));
end;
 
procedure TForm1.AsyncProcess1Terminate(Sender: TObject);
begin
  Memo1.Lines.Add('Processus terminé.');
end;
 
procedure TForm1.Button2Click(Sender: TObject);
var
  EWE: String;
begin
  EWE := ExtractFilePath(ParamStr(0)) + 'Bidon.exe';
  StartAsyncProcess(EWE, ['20']);
 
 
end;
 
procedure TForm1.Button3Click(Sender: TObject);
begin
  if (AsyncProcess1.Running) then  AsyncProcess1.Terminate(0);
end;
// un process long à lancer
procedure TForm1.Button4Click(Sender: TObject);
var
  i: Integer;
begin
  for i := 1 to 666 do
  begin
    ListBox1.Items.Add(i.toString());
    sleep(25);
    Application.ProcessMessages;
  end;
end;
 
procedure TForm1.StartAsyncProcess(const ProgConsoleName: string; const Params: array of string);
var
  i: Integer;
begin
  // si un process est en route
  if (AsyncProcess1.Running) then
  begin
    case MessageDlg('Processus en cours', 'Ce processus est en cours - Arrêter', mtConfirmation, [mbYes, mbNo], 0) of
      mrYES:
      begin
         AsyncProcess1.Terminate(0);
         exit;
      end;
      mrNO:
      begin
        Exit;
 
      end;
    else
      exit;
    end;
  end;
  // Configurer le processus
  AsyncProcess1.Executable := ProgConsoleName;
  if (Length(Params) > 0) then
     for i := 0 to High(Params) do AsyncProcess1.Parameters.Add(Params[i]);
  AsyncProcess1.Options := AsyncProcess1.Options + [poUsePipes];
  // Démarrer le processus
  AsyncProcess1.Execute;
end;
 
(* Windows only, bloquant, Avec CreatePipe: OK *)
procedure TForm1.RunConsoleWithRedirect(const ProgConsoleName: string; const Params: array of string);
var
  ProcessInfo: TProcessInformation;
  StartupInfo: TStartupInfo;
  ReadPipe, WritePipe: THandle;
  Security: TSecurityAttributes;
  Buffer: array[0..255] of AnsiChar;
  BytesRead: DWORD;
  Output, MyCommand, Parametres: string;
  i: Integer;
begin
  // Configuration de la sécurité du pipe
  Security.nLength := SizeOf(TSecurityAttributes);
  Security.bInheritHandle := True;
  Security.lpSecurityDescriptor := nil;
 
  // Création du pipe anonyme
  if not CreatePipe(ReadPipe, WritePipe, @Security, 0) then
    Exit;
 
  MyCommand := ProgConsoleName;
  Parametres := '';
  if (Length(Params) > 0) then for i := 0 to High(Params) do Parametres += (' ' + Params[i]);
  MyCommand += ' ' + Trim(Parametres);
 
  try
    // Initialisation des structures
    FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
    FillChar(ProcessInfo, SizeOf(TProcessInformation), 0);
    StartupInfo.cb := SizeOf(TStartupInfo);
    StartupInfo.hStdOutput := WritePipe; // Redirige stdout
    StartupInfo.hStdError := WritePipe;  // Redirige stderr
    StartupInfo.dwFlags := STARTF_USESTDHANDLES;
    // Lancer le processus
    if CreateProcess(nil, PChar(MyCommand), nil, nil, True, CREATE_NO_WINDOW, nil, nil, StartupInfo, ProcessInfo) then
    begin
      CloseHandle(WritePipe); // Fermer le WritePipe, car seul le processus enfant écrit
 
      // Lecture des données en boucle
      Output := '';
      repeat
        BytesRead := 0;
        if ReadFile(ReadPipe, Buffer, SizeOf(Buffer) - 1, BytesRead, nil) and (BytesRead > 0) then
        begin
          Buffer[BytesRead] := #0;
          Output := Output + string(Buffer);
          Memo1.Lines.Text := Output; // Mise à jour de TMemo
          Application.ProcessMessages; // Rafraîchissement de l'interface
        end;
      until BytesRead = 0;
 
      // Attendre la fin du processus
      WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
      CloseHandle(ProcessInfo.hProcess);
      CloseHandle(ProcessInfo.hThread);
    end;
  finally
    CloseHandle(ReadPipe);
  end;
end;

28/03/2025, 12h01
Guesset

Bonjour,

Est-ce que le code de l'application console appelée est accessible ?

Je crois que le pipe ne fonctionne qu'en mode console.

Salutations

Citation:

Envoyé par Guesset

Bonjour,

Est-ce que le code de l'application console appelée est accessible ?

Je crois que le pipe ne fonctionne qu'en mode console.

Salutations

Oui.

Voici le programme que je dois exécuter et dont je dois récupérer la sortie en temps réel
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 program Bidon; uses SysUtils; var i: Integer; Nb: LongInt; begin writeLn('Bidon.exe'); if (ParamCount = 0) then begin writeLn('Utilisation: Bidon.exe <nombre d''iterations>'); writeLn(''); exit; end; Randomize; Nb := StrToIntDef(ParamStr(1), 20); for i := 1 to Nb do begin writeLn(DateTimeToStr(Now)); sleep(Random(1000)); end; writeLn('Terminated'); end.

29/03/2025, 09h39
Guesset
Bonjour,

Je me trompe peut être, mais je doute qu'un programme GUI puisse être en pipe avec un programme console.

Sous Windows, il y a de nombreuses possibilités dont je n'ai hélas pratiqué que certaines :
- Rediriger la sortie vers un fichier et placer le programme principale en surveillance de fichier répertoire. Il y a des fonctions système permettant d'actualiser automatiquement des répertoires (voir l'API Windows, ShellEvent.PIDL etc.).
- Envoyer un message vers l'application principale contenant les nouvelles sorties, soit directement à partir du programme console, soit à partir d'un programme console dédié chainé avec l'autre (>).
- Une variante consiste à mettre les données dans un fichier mappé en mémoire (soit à partir du programme console générateur soit à partir d'un programme console dédié chainé). Comme les objets nommés sont uniques sous Windows, si l'application GUI ouvre le même fichier mappé, elle accède aux données.
- Autre variante, utiliser le presse-papier si accessible depuis une application console avec ou sans hook sur le presse-papier du coté application GUI.
- Créer une console dans l'application GUI et lancer le programme console dedans (jamais fait mais déjà vu). On a la main sur ce qui s'y passe.
- Utiliser un hook (ça remonte à loin dans ma mémoire) mais le hook tend à capter sans un discernement très fin.
Il y a certainement d'autres techniques...

Salutations et courage 8-)
29/03/2025, 13h04
Andnotor

Tu as résolu ton problème différemment, donc je ne vais pas trop m'étendre sur le sujet, mais...

Citation:

Envoyé par JP CASSOU

- Le programme externe se lance dans une fenêtre en mode bloquant

Normal puisque tu appelles Execute depuis la tâche principale.
On appelle jamais Execute qui est automatiquement invoqué au démarrage du thread. Soit la tâche est créée d'avance et mise en pause (par event), soit on ne la crée que lorsqu'on en a effectivement besoin.

Citation:

Envoyé par JP CASSOU

- AV à la fermeture

Peut-être (sans doute) lié à l'absence d' inherited dans le constructeur de TAsyncProcessThread.
Et comment est créé le thread (BeginThread) si tu ne fais pas appel à l'ancêtre ;)