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
| {* -----------------------------------------------------------------------------
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 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é
------------------------------------------------------------------------------ }
function CallCmd(const CmdDirectory, CmdName, CmdParam: string; out ExitCode: Int64; out OutputText: string; out ErrorText: string; Delay: Cardinal = INFINITE; WaitEvent: TCallCmdEvent = nil; PipeMaxSize: Cardinal = 0): Boolean;
var
StartupInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
CmdLine: string; // utile pour le débogage
SecurityAttr : TSecurityAttributes;
hReadPipeInput, hWritePipeInput: Cardinal;
hReadPipeOutput, hWritePipeOutput: Cardinal;
hReadPipeError, hWritePipeError: Cardinal;
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;
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(Buf, PipeToRead);
ZeroMemory(@Buf[1], PipeToRead);
ReadFile(Handle, Buf[1], PipeToRead, PipeReaded, nil);
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;
if Assigned(WaitEvent) then
WaitEvent(DeltaOutputText, DeltaErrorText, AbortProcess);
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));
CmdLine := Format('"%s%s" %s', [IncludeTrailingPathDelimiter(CmdDirectory), CmdName, CmdParam]);
Result := CreateProcess(nil, PChar(CmdLine), @SecurityAttr, @SecurityAttr, True, 0, nil, PChar(CmdDirectory), 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;
TULargeInteger(ExitCode).HighPart := 0;
if not GetExitCodeProcess(ProcessInfo.hProcess, TULargeInteger(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('epcWindows.CallCmd Error %s, Message : %s', [E.ClassName, E.Message])));
raise;
end;
end;
end; |
Partager