Je vous propose un nouvel élément à utiliser : Exécuter des scripts batch ou des commandes système depuis une application

Cette unité fournit la classe utilitaire TCmdPipeExecutor qui permet de lancer cmd.exe en arrière-plan depuis une application VCL, d’envoyer des commandes via stdin, de capturer stdout/stderr à travers des pipes anonymes, et de récupérer le code de sortie du processus.

TCmdPipeExecutor

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
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
unit UnitCmdPipeExecutor;
 
interface
 
uses
  System.SysUtils, System.Classes, Winapi.Windows, Vcl.StdCtrls;
 
type
  // Classe utilitaire pour exécuter des commandes via cmd.exe et capturer la sortie
  TCmdPipeExecutor = class
  private
    // Crée les handles de pipe nécessaires pour rediriger stdin/stdout du processus enfant
    function CreatePipeHandles(out ReadStdOut, WriteStdOut, ReadStdIn,
      WriteStdIn: THandle): Boolean;
 
  public
    constructor Create;
    destructor Destroy; override;
 
    // Exécute les commandes passées dans Commands, capture la sortie dans Output et le code de sortie dans ExitCode.
    // HiddenWindow: si True, demande à cacher la fenêtre du processus (STARTF_USESHOWWINDOW + SW_HIDE)
    // UseUtf8: si True, écrit les commandes en UTF-8 et décode la sortie en UTF-8; sinon utilise le jeu de caractères OEM
    // TimeoutMs: délai en ms pour détecter une absence d'activité de sortie; INFINITE signifie aucun timeout
    function ExecuteCmdAndCapture(const Commands: TStrings; out Output: string;
      out ExitCode: DWORD; HiddenWindow: Boolean = True;
      UseUtf8: Boolean = False; TimeoutMs: Cardinal = INFINITE): Boolean;
 
    // Méthode pratique : lit les commandes depuis SourceMemo, exécute, et écrit le résultat dans DestMemo
    procedure ExecuteFromMemo(SourceMemo, DestMemo: TMemo;
      HiddenWindow: Boolean = True; UseUtf8: Boolean = False;
      TimeoutMs: Cardinal = INFINITE);
  end;
 
implementation
 
// Convertit un buffer d'octets interprétés en OEM vers une chaîne WideString Delphi
function OEMBytesToString(const Buffer: Pointer; Count: Integer): string;
var
  WideLen: Integer;
begin
  Result := '';
  if (Buffer = nil) or (Count <= 0) then
    Exit;
 
  // Calcule la longueur nécessaire en WideChar
  WideLen := MultiByteToWideChar(CP_OEMCP, 0, PAnsiChar(Buffer), Count, nil, 0);
  if WideLen > 0 then
  begin
    SetLength(Result, WideLen);
    // Convertit du OEM vers WideChar (Unicode interne Delphi)
    MultiByteToWideChar(CP_OEMCP, 0, PAnsiChar(Buffer), Count,
      PWideChar(Result), WideLen);
  end;
end;
 
// Convertit une chaîne WideString en tableau d'octets selon le code page OEM
// Retourne le nombre d'octets et remplit Bytes
function WideStringToOEMBytes(const S: string; out Bytes: TBytes): Integer;
begin
  Result := 0;
  Bytes := nil;
  if S = '' then
    Exit;
 
  // Obtient la longueur nécessaire en octets
  Result := WideCharToMultiByte(CP_OEMCP, 0, PWideChar(S), Length(S), nil, 0,
    nil, nil);
  if Result > 0 then
  begin
    SetLength(Bytes, Result);
    // Remplit le tableau d'octets avec la conversion OEM
    WideCharToMultiByte(CP_OEMCP, 0, PWideChar(S), Length(S), PAnsiChar(Bytes),
      Result, nil, nil);
  end;
end;
 
{ TCmdPipeExecutor }
 
constructor TCmdPipeExecutor.Create;
begin
  inherited Create;
end;
 
destructor TCmdPipeExecutor.Destroy;
begin
  inherited;
end;
 
// Crée deux pipes anonymes : un pour capturer stdout/err du processus enfant (ReadStdOut/WriteStdOut)
// et un pour fournir stdin au processus enfant (ReadStdIn/WriteStdIn).
// Les handles destinés au processus enfant restent héritables; les handles parentaux sont marqués non-héritables.
function TCmdPipeExecutor.CreatePipeHandles(out ReadStdOut, WriteStdOut,
  ReadStdIn, WriteStdIn: THandle): Boolean;
var
  SecAttr: SECURITY_ATTRIBUTES;
begin
  Result := False;
  ReadStdOut := 0;
  WriteStdOut := 0;
  ReadStdIn := 0;
  WriteStdIn := 0;
 
  ZeroMemory(@SecAttr, SizeOf(SecAttr));
  SecAttr.nLength := SizeOf(SecAttr);
  SecAttr.bInheritHandle := True;
  // Permet l'héritage des handles au processus enfant
  SecAttr.lpSecurityDescriptor := nil;
 
  // Pipe pour stdout/err du processus enfant
  if not CreatePipe(ReadStdOut, WriteStdOut, @SecAttr, 0) then
    Exit;
 
  // Pipe pour stdin du processus enfant
  if not CreatePipe(ReadStdIn, WriteStdIn, @SecAttr, 0) then
  begin
    // en cas d'échec, fermer le premier pipe et sortir
    CloseHandle(ReadStdOut);
    CloseHandle(WriteStdOut);
    Exit;
  end;
 
  // Empêcher le parent d'hériter des handles côté lecture/écriture qui sont uniquement destinés à l'enfant
  SetHandleInformation(ReadStdOut, HANDLE_FLAG_INHERIT, 0);
  SetHandleInformation(WriteStdIn, HANDLE_FLAG_INHERIT, 0);
 
  Result := True;
end;
 
// Exécute les commandes et capture la sortie
function TCmdPipeExecutor.ExecuteCmdAndCapture(const Commands: TStrings;
  out Output: string; out ExitCode: DWORD; HiddenWindow: Boolean;
  UseUtf8: Boolean; TimeoutMs: Cardinal): Boolean;
var
  ReadStdOut, WriteStdOut, ReadStdIn, WriteStdIn: THandle;
  StartInfo: TStartupInfo;
  ProcInfo: TProcessInformation;
  CmdLine: array [0 .. 255] of Char;
  Buffer: array [0 .. 4095] of Byte;
  BytesRead, BytesWritten: DWORD;
  CmdText: string;
  OutStream: TMemoryStream;
  WaitRes, LastTick: DWORD;
  Utf8Bytes: TBytes;
  OemBytes: TBytes;
  OemLen: Integer;
  TmpBytes: TBytes;
begin
  Result := False;
  Output := '';
  ExitCode := DWORD($FFFFFFFF);
  ReadStdOut := 0;
  WriteStdOut := 0;
  ReadStdIn := 0;
  WriteStdIn := 0;
 
  // Crée les handles de pipe nécessaires
  if not CreatePipeHandles(ReadStdOut, WriteStdOut, ReadStdIn, WriteStdIn) then
    Exit;
 
  try
    // Initialise STARTUPINFO en précisant les handles pour stdin/stdout/stderr
    ZeroMemory(@StartInfo, SizeOf(StartInfo));
    StartInfo.cb := SizeOf(StartInfo);
    StartInfo.hStdInput := ReadStdIn;
    StartInfo.hStdOutput := WriteStdOut;
    StartInfo.hStdError := WriteStdOut;
    StartInfo.dwFlags := STARTF_USESTDHANDLES;
    if HiddenWindow then
    begin
      // Si demandé, indique au système de cacher la fenêtre du processus
      StartInfo.dwFlags := StartInfo.dwFlags or STARTF_USESHOWWINDOW;
      StartInfo.wShowWindow := SW_HIDE;
    end;
 
    ZeroMemory(@ProcInfo, SizeOf(ProcInfo));
 
    // Prépare la ligne de commande pour lancer cmd.exe en mode silencieux (/Q)
    StrPCopy(CmdLine, 'cmd.exe /Q');
 
    // Crée le processus enfant en héritant des handles nécessaires
    if not CreateProcess(nil, CmdLine, nil, nil, True, CREATE_NO_WINDOW, nil,
      nil, StartInfo, ProcInfo) then
      Exit;
 
    // Le parent ferme ses copies des handles que seul l'enfant doit utiliser
    if ReadStdIn <> 0 then
    begin
      CloseHandle(ReadStdIn);
      ReadStdIn := 0;
    end;
    if WriteStdOut <> 0 then
    begin
      CloseHandle(WriteStdOut);
      WriteStdOut := 0;
    end;
 
    try
      // Prépare le texte des commandes : si vide, écrit un message; s'assure qu'il y a un 'exit'
      CmdText := Commands.Text;
      if CmdText = '' then
        CmdText := 'echo Aucun commande' + sLineBreak;
      if Pos('exit' + sLineBreak, LowerCase(CmdText)) = 0 then
        CmdText := CmdText + 'exit' + sLineBreak;
 
      // Écrit les commandes dans stdin de l'enfant en UTF-8 ou en OEM selon UseUtf8
      BytesWritten := 0;
      if UseUtf8 then
      begin
        Utf8Bytes := TEncoding.UTF8.GetBytes(CmdText);
        if Length(Utf8Bytes) > 0 then
          WriteFile(WriteStdIn, Utf8Bytes[0], Length(Utf8Bytes),
            BytesWritten, nil);
      end
      else
      begin
        OemLen := WideStringToOEMBytes(CmdText, OemBytes);
        if OemLen > 0 then
          WriteFile(WriteStdIn, OemBytes[0], OemLen, BytesWritten, nil);
      end;
 
      // Ferme le côté écriture du pipe stdin pour signaler EOF au processus enfant
      if WriteStdIn <> 0 then
      begin
        CloseHandle(WriteStdIn);
        WriteStdIn := 0;
      end;
 
      // Lit la sortie produite par le processus enfant dans un TMemoryStream
      OutStream := TMemoryStream.Create;
      try
        LastTick := GetTickCount;
        repeat
          BytesRead := 0;
          // Tente de lire des données disponibles
          if ReadFile(ReadStdOut, Buffer, SizeOf(Buffer), BytesRead, nil) then
          begin
            if BytesRead > 0 then
            begin
              // Stocke les données lues et réinitialise le timer d'activité
              OutStream.Write(Buffer, BytesRead);
              LastTick := GetTickCount;
            end;
          end
          else
            BytesRead := 0;
 
          // Attend un court laps de temps pour savoir si le processus est terminé
          WaitRes := WaitForSingleObject(ProcInfo.hProcess, 50);
 
          // Si timeout configuré et pas d'activité depuis TimeoutMs, termine le processus
          if (TimeoutMs <> INFINITE) and (GetTickCount - LastTick > TimeoutMs)
          then
          begin
            TerminateProcess(ProcInfo.hProcess, DWORD($FFFFFFFD));
            raise Exception.Create('Timeout: no activity from process');
          end;
        until (BytesRead = 0) and (WaitRes <> WAIT_TIMEOUT);
 
        // Assure que le processus est terminé et récupère son code de sortie
        WaitForSingleObject(ProcInfo.hProcess, INFINITE);
        GetExitCodeProcess(ProcInfo.hProcess, ExitCode);
 
        // Conversion du contenu du stream en chaîne selon l'encodage demandé
        if OutStream.Size > 0 then
        begin
          SetLength(TmpBytes, OutStream.Size);
          Move(OutStream.Memory^, TmpBytes[0], OutStream.Size);
 
          if UseUtf8 then
          begin
            Output := TEncoding.UTF8.GetString(TmpBytes);
          end
          else
          begin
            Output := OEMBytesToString(@TmpBytes[0], Length(TmpBytes));
          end;
        end
        else
          Output := '';
 
        Result := True;
      finally
        OutStream.Free;
      end;
    finally
      // Ferme les handles du processus
      CloseHandle(ProcInfo.hProcess);
      CloseHandle(ProcInfo.hThread);
    end;
  finally
    // S'assure de fermer tous les handles ouverts (sécurise contre les fuites)
    if ReadStdOut <> 0 then
      CloseHandle(ReadStdOut);
    if WriteStdOut <> 0 then
      CloseHandle(WriteStdOut);
    if ReadStdIn <> 0 then
      CloseHandle(ReadStdIn);
    if WriteStdIn <> 0 then
      CloseHandle(WriteStdIn);
  end;
end;
 
// Méthode utilitaire pour exécuter des commandes depuis un TMemo source et afficher la sortie dans un TMemo destination
procedure TCmdPipeExecutor.ExecuteFromMemo(SourceMemo, DestMemo: TMemo;
  HiddenWindow: Boolean; UseUtf8: Boolean; TimeoutMs: Cardinal);
var
  OutStr: string;
  ExitCode: DWORD;
begin
  if (SourceMemo = nil) or (DestMemo = nil) then
    Exit;
 
  DestMemo.Lines.BeginUpdate;
  try
    DestMemo.Lines.Clear;
    DestMemo.Lines.Add('--- Execution started ---');
 
    // Appel principal qui exécute les commandes et capture la sortie
    if ExecuteCmdAndCapture(SourceMemo.Lines, OutStr, ExitCode, HiddenWindow,
      UseUtf8, TimeoutMs) then
    begin
      // Uniformise les sauts de ligne pour l'affichage dans TMemo
      OutStr := StringReplace(OutStr, #10, sLineBreak, [rfReplaceAll]);
      DestMemo.Lines.Add(OutStr);
      DestMemo.Lines.Add(Format('--- Execution finished (Exit code: %d) ---',
        [ExitCode]));
    end
    else
      DestMemo.Lines.Add('Erreur: impossible de lancer cmd.exe.');
  finally
    DestMemo.Lines.EndUpdate;
  end;
end;
 
end.
Exemple d’utilisation simple (dans une Form VCL)

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
uses
  UnitCmdPipeExecutor, System.Classes, Vcl.StdCtrls;
 
procedure TForm1.ButtonRunClick(Sender: TObject);
var
  Executor: TCmdPipeExecutor;
  Commands: TStringList;
  Output: string;
  ExitCode: DWORD;
begin
  Executor := TCmdPipeExecutor.Create;
  Commands := TStringList.Create;
  try
    // Exemple : liste de commandes batch
    Commands.Add('echo Début du script');
    Commands.Add('dir C:\Windows');        // commande montrant la sortie
    Commands.Add('echo Fin du script');
 
    // Exécute via cmd.exe, fenêtre cachée, encodage OEM (UseUtf8 = False), timeout 10s
    if Executor.ExecuteCmdAndCapture(Commands, Output, ExitCode, True, False, 10000) then
    begin
      ShowMessage(Format('Sortie (%d octets) - ExitCode=%d'#13#10'%s', [Length(Output), ExitCode, Output]));
    end
    else
      ShowMessage('Erreur: impossible de lancer cmd.exe.');
  finally
    Commands.Free;
    Executor.Free;
  end;
end;
Exemple avec TMemo (utilisation directe de ExecuteFromMemo)

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
procedure TForm1.ButtonRunFromMemoClick(Sender: TObject);
var
  Executor: TCmdPipeExecutor;
begin
  Executor := TCmdPipeExecutor.Create;
  try
    // SourceMemo contient les commandes (une par ligne)
    // DestMemo affichera la sortie et le code de retour
    Executor.ExecuteFromMemo(SourceMemo, DestMemo, True, False, 15000);
  finally
    Executor.Free;
  end;
end;
Exemple utilisant UTF-8 (pour commandes/texte accentué)

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
var
  Executor: TCmdPipeExecutor;
  Cmds: TStringList;
  OutStr: string;
  Code: DWORD;
begin
  Executor := TCmdPipeExecutor.Create;
  Cmds := TStringList.Create;
  try
    Cmds.Add('chcp 65001');                // optionnel : passe la console en UTF-8
    Cmds.Add('echo Café et accents: éàê');
    Cmds.Add('exit');
    if Executor.ExecuteCmdAndCapture(Cmds, OutStr, Code, True, True, 5000) then
      Memo1.Lines.Text := OutStr
    else
      Memo1.Lines.Text := 'Erreur d''exécution';
  finally
    Cmds.Free;
    Executor.Free;
  end;
end;