Discussion :

[LaurentC33]

Bonjour à tous,

J'ai besoin pour mon appli de commander un api utilisable uniquement en DOS.
Pour cela j'essayer de créer une classe avec comme argument du constructeur mon Tmemo, et ensuite a chaque fois que j'appelle ma méthode add( commande ), automatiquement ça ajoute la commande au thread en cours.
Déjà, est ce que c'est bien utile que je passe ça dans un thread ? J'ai fait cela pour des commandes qui renvoie plusieurs lignes avec un certain délais.
Je patoge
J'ai récupéré du code pour la gestion de la commande dos, mais ce que j'aimerais c'est rester dans la même session de commande, et non a chaque commande avoir une nouvelle session.
Est ce possible ?

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
unit DosCommandUnit;
 
{
  Classe qui execute des commandes DOS dans un thread, visible dans un TMemo
 
  Ex :
 
  dosCommand := TDosCommand.Create(memo);
  dosCommand.add('cd C:\Apps');
  dosCommand.add('dir');
}
interface
uses Vcl.StdCtrls, Windows, System.Classes, Forms, Vcl.ComCtrls;
 
type
 
 
TThreadDosCommand = class(TThread)
  private
    commandLine: string;
    memo: TMemo;
    function add(CommandLine: string): string;
  protected
    procedure Execute; override;
  end;
 
TDosCommand = class
   private
      threadDC: TThreadDosCommand;
   public
      Constructor Create(memo: TMemo);
      procedure add(commandLine: string);
   end;
 
 
 
implementation
 
 
{ TThreadDosCommand }
function TThreadDosCommand.add(commandLine: string): string;
begin
  Self.commandLine := commandLine;
end;
 
procedure TThreadDosCommand.Execute;
var
  SA: TSecurityAttributes;
  SI: TStartupInfo;
  PI: TProcessInformation;
  StdOutPipeRead, StdOutPipeWrite: THandle;
  WasOK: Boolean;
  Buffer: array[0..255] of AnsiChar;
  BytesRead: Cardinal;
  WorkDir: string;
  Handle: Boolean;
begin
  inherited;
 
  with SA do begin
    nLength := SizeOf(SA);
    bInheritHandle := True;
    lpSecurityDescriptor := nil;
  end;
  CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SA, 0);
  try
    with SI do
    begin
      FillChar(SI, SizeOf(SI), 0);
      cb := SizeOf(SI);
      dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
      wShowWindow := SW_HIDE;
      hStdInput := GetStdHandle(STD_INPUT_HANDLE); // don't redirect stdin
      hStdOutput := StdOutPipeWrite;
      hStdError := StdOutPipeWrite;
    end;
    WorkDir := 'C:\';
    Handle := CreateProcess(nil, PChar('cmd.exe /C ' + CommandLine),
                            nil, nil, True, 0, nil,
                            PChar(WorkDir), SI, PI);
    CloseHandle(StdOutPipeWrite);
    if Handle then
      try
        repeat
          WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
          if BytesRead > 0 then
          begin
            Buffer[BytesRead] := #0;
            memo.Text := memo.Text + Buffer;
          end;
        until not WasOK or (BytesRead = 0);
        WaitForSingleObject(PI.hProcess, INFINITE);
      finally
        CloseHandle(PI.hThread);
        CloseHandle(PI.hProcess);
      end;
  finally
    CloseHandle(StdOutPipeRead);
  end;
end;
 
{ TDosCommand }
constructor TDosCommand.Create(memo: TMemo);
begin
  threadDC := TThreadDosCommand.Create(False);
  threadDC.memo := memo;
end;
 
procedure TDosCommand.add(CommandLine: string);
begin
  threadDC.add(CommandLine);
end;
 
end.

[ShaiLeTroll]

J'ai écrit ceci pour lancer des script PHP écrivant dans la console

Essaye d'avoir un code fonctionnel même sans thread !
Comme tu lances un processus parallèle, tu n'a pas besoin de thread pour écouter les Pipes

A mon avis, ton WaitForSingleObject en INFINITE n'est pas approprié pour un fil de l'eau en temps réel
Tu boucles trop sur ReadFile, laisse le processus travaillé un peu !

tu peux réutiliser mon code, il doit supporter les threads !
La seule chose à corriger serait que _ExportEvent utilise un TThread.Synchronize pour éviter de modifier un Memo depuis un Thread ce qui n'est pas prudent !

[LaurentC33]

Merci Shai une fois de plus

Je vais tester ça !

[ShaiLeTroll]

Sinon, pour ton histoire de session DOS, je n'avais pas vu ça !

Deux approches :
- Générer un .BAT qui s'auto-supprime en fin de script
- Gérer le ProcessID fourni par CreateProcess et lors de l'execution suivante, utiliser le Input pour envoyer la seconde commande

[LaurentC33]

Bonjour Shai.
Laisse tomber l'histoire de session DOS, ce n'est plus necessaire.
J'ai essayé ton code, mais assez complexe

J'ai trouvé cela par contre :
http://thundaxsoftware.blogspot.fr/2...1_archive.html

J'ai trouvé cette procédure superbe, car elle utilise des callback (ce que je ne savais pas possible en delphi jusqu'à maintenant ).
Ca marche nickel, je l'ai un peu adapté à ma sauce :

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
 
unit DosCommandUnit;
 
 
interface
uses Vcl.StdCtrls, Windows, System.Classes, Forms, Vcl.ComCtrls;
 
type
    TArg<T> = reference to procedure(const Arg: T);
 
    ConsoleOutput = class
      private
        stopCapture: boolean;
        piProcess: TProcessInformation;
      public
        procedure Capture(const ACommand: String; CallBackRunTime, CallBackTerminate: TArg<PAnsiChar>; waitTimeout: integer = WAIT_TIMEOUT);
        procedure Stop;
    end;
 
implementation
 
{ ConsoleOutput }
 
procedure ConsoleOutput.Capture(const ACommand: String; CallBackRunTime, CallBackTerminate: TArg<PAnsiChar>; waitTimeout: integer = WAIT_TIMEOUT);
const
  CReadBuffer = 2400;
var
  saSecurity: TSecurityAttributes;
  hRead: THandle;
  hWrite: THandle;
  suiStartup: TStartupInfo;
  pBuffer: array [0 .. CReadBuffer] of AnsiChar;
  dBuffer: array [0 .. CReadBuffer] of AnsiChar;
  dRead: DWORD;
  dRunning: DWORD;
  dAvailable: DWORD;
begin
  stopCapture := false;
  saSecurity.nLength := SizeOf(TSecurityAttributes);
  saSecurity.bInheritHandle := true;
  saSecurity.lpSecurityDescriptor := nil;
  if CreatePipe(hRead, hWrite, @saSecurity, 0) then
    try
      FillChar(suiStartup, SizeOf(TStartupInfo), #0);
      suiStartup.cb := SizeOf(TStartupInfo);
      suiStartup.hStdInput := hRead;
      suiStartup.hStdOutput := hWrite;
      suiStartup.hStdError := hWrite;
      suiStartup.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
      suiStartup.wShowWindow := SW_HIDE;
      if CreateProcess(nil,PChar('cmd.exe /C ' + ACommand), @saSecurity, @saSecurity, true, NORMAL_PRIORITY_CLASS, nil, nil, suiStartup,
        piProcess) then
        try
          repeat
            dRunning := WaitForSingleObject(piProcess.hProcess, 100);
            PeekNamedPipe(hRead, nil, 0, nil, @dAvailable, nil);
            if (dAvailable > 0) then
              repeat
                dRead := 0;
                ReadFile(hRead, pBuffer[0], CReadBuffer, dRead, nil);
                pBuffer[dRead] := #0;
                OemToCharA(pBuffer, dBuffer);
                CallBackRunTime(dBuffer);
              until (dRead < CReadBuffer) OR (stopCapture = true);
            Application.ProcessMessages;
          until (dRunning <> waitTimeout) OR (stopCapture = true);
        finally
          CloseHandle( piProcess.hProcess );
          CloseHandle( piProcess.hThread );
        end;
    finally
      CloseHandle(hRead);
      CloseHandle(hWrite);
      CallBackTerminate(nil);
    end;
end;
 
 
procedure ConsoleOutput.Stop;
begin
  stopCapture := true;
end;
 
end.

Par contre j'ai deux problèmes.
Si on ferme l'application, même en passant par la méthode Stop, j'ai des processus cmd.exe qui restent actifs.
Pas hyper important dans l'immédiat, mais il faut que je modifie ma classe pour que tous les process soit supprimés en cas de fermeture de l'appli. Peux être stocker chaque TProcessInformation dans une variable "statique" afin de les fermer tous.

Truc plus important : Dans la méthode Capture, j'ai un paramètre waitTimeout. J'ai fait ceci afin de pouvoir avoir un appel de Capture qui ne ce ferme pas en cas de commande (ACommand) qui ne renvois pas d'infos depuis un délais conséquent. Mais ça ne marche pas...Ca ferme quand même, avec n'importe quelle valeur de waitTimeout

[LaurentC33]

Nouvelle version mais rien de mieux

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
 
unit DosCommandUnit;
 
 
interface
uses Vcl.StdCtrls, Windows, System.Classes, Forms, Vcl.ComCtrls;
 
type
    TArg<T> = reference to procedure(const Arg: T);
 
    ConsoleOutputThread = class( TThread )
      private
 
      protected
        procedure Execute;  override;
      public
        ACommand: string;
        CallBackRunTime, CallBackTerminate: TArg<String>;
    end;
 
 
    function startConsole(_ACommand: String; _CallBackRunTime, _CallBackTerminate: TArg<String>) : ConsoleOutputThread;
    procedure stopConsole(OutputThreadHandle  : ConsoleOutputThread);
 
implementation
 
{ ConsoleOutput }
procedure ConsoleOutputThread.Execute;
const
  CReadBuffer = 2400;
var
  saSecurity: TSecurityAttributes;
  hRead: THandle;
  hWrite: THandle;
  suiStartup: TStartupInfo;
  piProcess: TProcessInformation;
  pBuffer: array [0 .. CReadBuffer] of AnsiChar;
  dBuffer: array [0 .. CReadBuffer] of AnsiChar;
  dRead: DWORD;
  dRunning: DWORD;
  dAvailable: DWORD;
begin
  saSecurity.nLength := SizeOf(TSecurityAttributes);
  saSecurity.bInheritHandle := true;
  saSecurity.lpSecurityDescriptor := nil;
  if CreatePipe(hRead, hWrite, @saSecurity, 0) then
    try
      FillChar(suiStartup, SizeOf(TStartupInfo), #0);
      suiStartup.cb           := SizeOf(TStartupInfo);
      suiStartup.hStdInput    := hRead;
      suiStartup.hStdOutput   := hWrite;
      suiStartup.hStdError    := hWrite;
      suiStartup.dwFlags      := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
      suiStartup.wShowWindow  := SW_HIDE;
 
      if CreateProcessW(
          nil,
          PChar('cmd.exe /C ' + ACommand),
          @saSecurity,
          @saSecurity,
          true,
          NORMAL_PRIORITY_CLASS,
          nil,
          nil,
          suiStartup,
      piProcess) then
        try
          repeat
            dRunning := WaitForSingleObject(piProcess.hProcess, 100);
            PeekNamedPipe(hRead, nil, 0, nil, @dAvailable, nil);
            if (dAvailable > 0) then
              repeat
                dRead := 0;
                ReadFile(hRead, pBuffer[0], CReadBuffer, dRead, nil);
                pBuffer[dRead] := #0;
                OemToCharA(pBuffer, dBuffer);
                CallBackRunTime(dBuffer);
              until dRead < CReadBuffer;
            Application.ProcessMessages;
          until dRunning <> WAIT_TIMEOUT;
        finally
          CloseHandle( piProcess.hProcess );
          CloseHandle( piProcess.hThread );
        end;
 
    finally
      CloseHandle(hRead);
      CloseHandle(hWrite);
      CallBackTerminate('');
    end;
end;
 
 
function startConsole(_ACommand: String; _CallBackRunTime, _CallBackTerminate: TArg<String>) : ConsoleOutputThread;
var
    consoleOThrd: ConsoleOutputThread;
begin
    consoleOThrd := ConsoleOutputThread.Create(true);
 
    with consoleOThrd do begin
      ACommand := _ACommand;
      CallBackRunTime := _CallBackRunTime;
      CallBackTerminate := _CallBackTerminate;
      FreeOnTerminate := TRUE;
      Resume;
    end;
 
    Result := consoleOThrd;
end;
 
 
procedure stopConsole(OutputThreadHandle  : ConsoleOutputThread);
begin
     OutputThreadHandle.Terminate;
     while not(OutputThreadHandle.Terminated) do sleep (100);
end;
 
 
end.

[ShaiLeTroll]

J'ai trouvé cette procédure superbe, car elle utilise des callback (ce que je ne savais pas possible en delphi jusqu'à maintenant ).

En fait, a peu de chose, si l'on retire les génériques, c'est la même chose que mon code !
Et des CallBack, c'est juste une technique d'appel de procédure, sans t'en rendre compte, tu en utilises tout le temps, tout Event Delphi est un CallBack

Dans mon code, c'est TCallCmdEvent qui est en fait le CallBack

Sinon, la gestion des Pipes dans ce code de Lübbe Onken et Lars Fosdal ressemble à l'erreur classique d'utiliser le même Pipe pour hStdInput et hStdOutput, je l'ai aussi faite avant de reprendre l'exemple de la MSDN Comment faire pour le déploiement de processus de console avec des poignées standard redirigées

Mon code est aussi plus long car il inclu justement le TerminateProcess pour gérer le cas du Abort qui résoudra ton problème de processus qui traine !

Pour le TimeOut, je n'ai compris ton code !

WAIT_TIMEOUT est une valeur retourné quand WaitForSingleObject relache son attente (dans ton cas 100ms)
Comme on surveille un processus, WAIT_TIMEOUT sera la valeur que l'on obtiendra à 99.99% du temps
Lorsque le processus est terminé cela renverra un WAIT_OBJECT_0
Les autres valeurs sont testé dans mon code pour prévoir d'eventuelles erreurs

[LaurentC33]

Laisse tomber, j'ai du faire le boulot je vérifierais (c'est sur l'output du WaitEvent et non celui retourné par la méthode)

En tout cas un grand merci !
(je pensais avoir mis résolu depuis la semaine dernière )