Discussion :

[XeGregory]

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;

[ShaiLeTroll]

C'est intéressant car justement, j'ai un code qui génère un BAT en fichier, l'execute et le BAT à la fin contient son auto-suppression, le code de XeGregory éviterait de passer par un fichier.
Un jour, je vais m'inspirer de ce code pour modifier TSLTModuleAutoUpdateByDOSBatchEngine pour utiliser la TStringList BatOp directement au lieu de créer le BAT en fichier.

Pour info, il y avait un Exemple MSDN dont j'ai perdu le lien d'origine
En voici un surement plus récent que celui que j'avais utilisé en D7 :
Creating a Child Process with Redirected Input and Output

En tout cas, il est nettement plus long qu'en 2008

Cela exécute un EXE ou un BAT mais pas une série de commande comme l'exemple ci-dessus.

• Version D7 : Redirection des entrées/sorties du process (ping)
• Version XE2 : TSLTShellExecuteWrapper

Version D10 :

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
 
{* -----------------------------------------------------------------------------
la fonction CallCmd permet de lancer un programme console, tout en récupérant en quasi temps-réel le contenu devant normalement s'y afficher
@param CmdDirectory Dossier contenant le Fichier CmdName
@param CmdName programme console à executer
@param CmdParam paramètres de la ligne de commande
@param CmdWorkDir Dossier de Travail
@param ExitCode Code de Sortie renvoyé par le programme console, -1 si non récupéré
@param OutputText chaine contenant tout ce qui aurait du s'afficher (canal sortie)
@param ErrorText chaine contenant tout ce qui a été signalé comme erreurs (canal erreur)
@param Delay indique le temps entre chaque cycle de lecture des canaux, détermine la fréquence de lancement de WaitEvent, par défaut, cela attend que le programme console se termine
@param WaitEvent procédure à lancer lorsque le Delay est écoulé, Output et Error contiennent les derniers éléments envoyés par le programme console sur les canaux depuis le dernier délai, AbortProcess indique si la processus doit être arrêté
@param PipeMaxSize défini la taille maximal que l'on lit à chaque chaque cycle de lecture des canaux, si zéro, taille non limitée par défaut
@return Indique si le programme a été lancé
------------------------------------------------------------------------------ }
class function TSLTShellExecuteWrapper.CallCmd(const CmdDirectory, CmdName, CmdParam, CmdWorkDir: string; out ExitCode: Int64; out OutputText: string; out ErrorText: string; Delay: Cardinal = INFINITE; WaitEvent: TSLTShellExecuteWrapperCallCmdEvent = nil; PipeMaxSize: Cardinal = 0): Boolean;
var
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  CommandLine: string; // utile pour le débogage, ne pas confondre CommandLine avec SysUtils.CmdLine
  SecurityAttr : TSecurityAttributes;
  hReadPipeInput, hWritePipeInput: NativeUInt;
  hReadPipeOutput, hWritePipeOutput: NativeUInt;
  hReadPipeError, hWritePipeError: NativeUInt;
  lpCurrentDirectory: PChar;
  Terminated: Boolean;
  AbortProcess: Boolean;
  HandleFunctionProcess: Cardinal;
 
  function ReadPipe(Handle: Cardinal; out Buf: string): Boolean;
  const
    MAX_INT: Cardinal = MaxInt;
  var
    PipeSize: Cardinal;
    PipeToRead, PipeReaded: Cardinal;
    PipeBuf: array of AnsiChar;
    AnsiBuf: AnsiString;
  begin
    PipeSize := GetFileSize(Handle, nil); // On oublie si cela dépasse 2Go ... normalement c'est 4Ko
    if (PipeMaxSize > 0) and (PipeSize > PipeMaxSize) then
      PipeToRead := PipeMaxSize
    else
      PipeToRead := PipeSize;
 
    Result := PipeToRead > 0;
    if Result then
    begin
      SetLength(PipeBuf, PipeToRead + 1); // + 1 Pour le Zero Terminal utilisé par OemToAnsi
      ZeroMemory(@PipeBuf[0], PipeToRead + 1);
      ReadFile(Handle, PipeBuf[0], PipeToRead, PipeReaded, nil);
 
      SetLength(AnsiBuf, PipeToRead);
      OemToAnsi(@PipeBuf[0], @AnsiBuf[1]);
      Buf := string(AnsiBuf);
    end;
  end;
 
  procedure ReadPipes();
  var
    DeltaOutputText: string;
    DeltaErrorText: string;
  begin
    if ReadPipe(hReadPipeOutput, DeltaOutputText) then
      OutputText := OutputText + DeltaOutputText;
    if ReadPipe(hReadPipeError, DeltaErrorText) then
      ErrorText := ErrorText + DeltaErrorText;
    try
      if Assigned(WaitEvent) then
        WaitEvent(DeltaOutputText, DeltaErrorText, AbortProcess);
    except
      on E: Exception do
        OutputDebugString(PChar(Format('s.CallCmd.ReadPipes.WaitEvent - "%s" : "%s"', [Self.ClassName(), E.ClassName(), E.Message])));
    end;
  end;
 
begin
  (*
  Result := True;
  OutputText := 'Dummy Output';
  ErrorText := 'Dummy Error';
  ErrorCode := 0;
  Exit;
  *)
  OutputText := '';
  ErrorText := '';
  try
    SecurityAttr.nLength := SizeOf(TSecurityAttributes);
    SecurityAttr.lpSecurityDescriptor := nil;
    SecurityAttr.bInheritHandle := True;
    if CreatePipe(hReadPipeInput, hWritePipeInput, @SecurityAttr, 0) and
      CreatePipe(hReadPipeOutput, hWritePipeOutput, @SecurityAttr, 0) and
      CreatePipe(hReadPipeError, hWritePipeError, @SecurityAttr, 0) then
    begin
      try
        ZeroMemory(@StartupInfo, SizeOf(StartupInfo)); // GetStartupInfo(StartupInfo);
        StartupInfo.cb := SizeOf(StartupInfo);
        StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES; // Active wShowWindow et hStdOutput/hStdError
        StartupInfo.wShowWindow := SW_HIDE;
        StartupInfo.hStdInput := hReadPipeInput;
        StartupInfo.hStdOutput := hWritePipeOutput;
        StartupInfo.hStdError := hWritePipeError;
        ZeroMemory(@ProcessInfo, SizeOf(ProcessInfo));
 
        if CmdDirectory <> '' then
        begin
          CommandLine := Format('"%s%s" %s', [IncludeTrailingPathDelimiter(CmdDirectory), CmdName, CmdParam]);
          if CmdWorkDir <> '' then
            lpCurrentDirectory := PChar(CmdWorkDir)
          else
            lpCurrentDirectory := PChar(CmdDirectory);
        end
        else
        begin
          CommandLine := Format('%s %s', [CmdName, CmdParam]);
          lpCurrentDirectory := PChar(CmdWorkDir);
        end;
 
        Result := CreateProcess(nil, PChar(CommandLine), @SecurityAttr, @SecurityAttr, True, 0, nil, lpCurrentDirectory, StartupInfo, ProcessInfo);
        if Result then
        begin
          try
            Terminated := False;
            AbortProcess := False;
            while not Terminated do
            begin
              case WaitForSingleObject(ProcessInfo.hProcess, Delay) of
                WAIT_OBJECT_0 :
                  begin
                    ReadPipes();
                    Terminated := True;
                  end;
                WAIT_ABANDONED : Terminated := True;
                WAIT_TIMEOUT :
                  begin
                    ReadPipes();
                    Terminated := Delay = INFINITE;
                  end;
                WAIT_FAILED: Abort;
              else
                Terminated := True;
              end;
 
              if AbortProcess then
              begin
               HandleFunctionProcess := OpenProcess(PROCESS_TERMINATE, False, ProcessInfo.dwProcessId);
               if HandleFunctionProcess > 0 then
               begin
                 TerminateProcess(HandleFunctionProcess, 0);
                 CloseHandle(HandleFunctionProcess);
               end;
              end;
            end;
 
            ULARGE_INTEGER(ExitCode).HighPart := 0;
            if not GetExitCodeProcess(ProcessInfo.hProcess, ULARGE_INTEGER(ExitCode).LowPart) then
              ExitCode := -1;
          finally
            CloseHandle(ProcessInfo.hThread);
            CloseHandle(ProcessInfo.hProcess); // The handles for both the process and the main thread must be closed through calls to CloseHandle
          end;
        end;
      finally
        CloseHandle(hReadPipeInput);
        CloseHandle(hWritePipeInput);
        CloseHandle(hReadPipeOutput);
        CloseHandle(hWritePipeOutput);
        CloseHandle(hReadPipeError);
        CloseHandle(hWritePipeError);
      end;
    end
    else
      raise Exception.Create('Impossible de créer les Pipes');
  except
    on E: Exception do
    begin
      OutputDebugString(PChar(Format('%s.CallCmd Error %s, Message : %s', [Self.ClassName(), E.ClassName(), E.Message])));
      raise;
    end;
  end;
end;

[XeGregory]

Pour info, il y avait un Exemple MSDN dont j'ai perdu le lien d'origine

Sur Internet, je suis tombé sur une copie en Markdown de l’article Microsoft Learn « Creating a Child Process with Redirected Input and Output ».

https://github.com/MicrosoftDocs/win...-and-output.md

https://github.com/MicrosoftDocs/win...put.md?plain=1

le code de XeGregory éviterait de passer par un fichier.

L’essayer, c’est l’adopter . Oui, c’est bien plus pratique que de créer un fichier temporaire, exécuter le .bat puis le supprimer.

Puis, le côté pratique sait automatiser des tâches externes.
Exemple : appeler des outils CLI (ffmpeg, 7zip, git, scripts batch, utilitaires système) depuis l’application.

[Papy214]

Joli !

Et c'est compatible à partir de quelle version de Delphi stp ?

[XeGregory]

Joli !

Et c'est compatible à partir de quelle version de Delphi stp ?

Delphi 2009 et toutes les versions ultérieures.

[Andnotor]

j'ai un code qui génère un BAT en fichier, l'execute et le BAT à la fin contient son auto-suppression

Ne pas oublier que cmd.exe accepte des commandes en paramètres. C'est d'ailleurs ainsi que doit procéder l'IDE en pré(post)-compilation.

cmd.exe /C echo Hello World! > d:\test.txt && copy d:\test.txt d:\test2.txt

[XeGregory]

Bat :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
@echo off
echo Nettoyage du dossier Temp de l'utilisateur...
set "TEMP_FOLDER=%TEMP%"
 
echo Suppression des fichiers...
del /f /s /q "%TEMP_FOLDER%\*.*"
echo Suppression des dossiers...
for /d %%D in ("%TEMP_FOLDER%\*") do rd /s /q "%%D"
 
echo Terminé.

PowerShell

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
@echo off
 powershell.exe -NoProfile -ExecutionPolicy Bypass -Command ^
 "Get-ChildItem -Path 'C:\Windows\System32' -File | Sort-Object Name | Format-Table Name,Length,LastWriteTime -AutoSize"