function FindProcess(Executable:
string): LongWord;
var
Snapshot: THandle;
Entry32: TProcessEntry32;
begin
Result := 0;
Snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
Entry32.dwSize := SizeOf(Entry32);
if Process32First(Snapshot, Entry32)
then
repeat
if AnsiSameText(ExtractFileName(Entry32.szExeFile), Executable)
then begin
Result := Entry32.th32ProcessID;
Break;
end;
until not Process32Next(Snapshot, Entry32);
CloseHandle(Snapshot);
end;
function ExecuteProcess(Executable:
string; Parameters, Input:
string; Output: PString;
ProcessID: PLongWord; Control: PExecuteControl; Timeout: LongWord;
HideWindow: Boolean; ConsoleTitle:
string; WindowPosition: PSize; WindowSize: PSize): HRESULT;
var
StartupInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
Application:
string;
CommandLine:
string;
CurrControl: TExecuteControl;
begin
if Assigned(Output)
then
Output^ := '
';
if Assigned(ProcessID)
then
ProcessID^ := 0;
CurrControl.Initialize;
try
if Assigned(Control)
then begin
CurrControl.InputHandler := Control.InputHandler;
CurrControl.Input := Control.Input;
CurrControl.OutputHandler := Control.OutputHandler;
CurrControl.Output := Control.Output;
CurrControl.ErrorOutputHandler := Control.ErrorOutputHandler;
CurrControl.ErrorOutput := Control.ErrorOutput;
end;
if (Input <> '
')
and not CurrControl.IsHandleAssigned(ehInput, False)
then
CurrControl.CreateLocalHandle(ehInput);
if CurrControl.IsHandleAssigned(ehInput, False)
or CurrControl.IsHandleAssigned(ehOutput, False)
or CurrControl.IsHandleAssigned(ehError, False)
then begin
if not CurrControl.IsHandleAssigned(ehInput, False)
then
CurrControl.SetStandardHandle(ehInput);
if not CurrControl.IsHandleAssigned(ehOutput, False)
then
CurrControl.SetStandardHandle(ehOutput);
if not CurrControl.IsHandleAssigned(ehError, False)
then
CurrControl.SetStandardHandle(ehError);
end;
FillChar(StartupInfo, SizeOf(StartupInfo), 0);
StartupInfo.cb := SizeOf(StartupInfo);
StartupInfo.lpTitle := Pointer(ConsoleTitle);
if Assigned(WindowPosition)
then begin
StartupInfo.dwX := WindowPosition.cx;
StartupInfo.dwY := WindowPosition.cy;
end;
if Assigned(WindowSize)
then begin
StartupInfo.dwXSize := WindowSize.cx;
StartupInfo.dwYSize := WindowSize.cy;
end;
StartupInfo.wShowWindow := IfThen(HideWindow, SW_SHOWMINIMIZED, SW_SHOWNOACTIVATE);
if CurrControl.IsHandleAssigned(ehInput, False)
then begin
StartupInfo.hStdInput := CurrControl.Input;
StartupInfo.hStdOutput := CurrControl.Output;
StartupInfo.hStdError := CurrControl.ErrorOutput;
end;
StartupInfo.dwFlags := STARTF_FORCEONFEEDBACK
or STARTF_USESHOWWINDOW
or IfThen(Assigned(WindowPosition), STARTF_USEPOSITION, 0)
or IfThen(Assigned(WindowSize), STARTF_USESIZE, 0)
or IfThen(CurrControl.IsHandleAssigned(ehInput, False), STARTF_USESTDHANDLES, 0);
if Parameters <> '
'
then
CommandLine := '
"' + Executable + '
" ' + Parameters + StringOfChar(#0, 32*1024)
else
Application := Executable;
OutputDebugString(PChar('
ExecuteAndWait: ' + CommandLine + Application + IfThen(Input <> '
', '
<< ' + Input, '
')));
if not CreateProcess(Pointer(Application), Pointer(CommandLine),
nil,
nil, StartupInfo.dwFlags
and STARTF_USESTDHANDLES <> 0,
CREATE_DEFAULT_ERROR_MODE
or NORMAL_PRIORITY_CLASS
or IfThen(HideWindow, CREATE_NO_WINDOW, CREATE_NEW_CONSOLE)
or IfThen(SizeOf(Char) = 2, CREATE_UNICODE_ENVIRONMENT, 0),
nil, PChar(ExtractFileDir(Executable)), StartupInfo, ProcessInfo)
then
RaiseLastOSError(GetLastError, '
.'#10'
ExecuteAndWait.CreateProcess');
CloseHandle(CurrControl.Input);
CloseHandle(CurrControl.Output);
if CurrControl.ErrorOutput <> CurrControl.Output
then
CloseHandle(CurrControl.ErrorOutput);
CurrControl.Input := 0;
CurrControl.Output := 0;
CurrControl.ErrorOutput := 0;
CurrControl.ProcessID := ProcessInfo.dwProcessId;
CurrControl.Process := ProcessInfo.hProcess;
CurrControl.MainThreadID := ProcessInfo.hThread;
CurrControl.MainThread := ProcessInfo.dwThreadId;
CurrControl.ExitCode := S_OK;
if LongInt(Timeout) < 0
then
Timeout := INFINITE;
case WaitForInputIdle(CurrControl.Process, Timeout)
of
0: ;
WAIT_TIMEOUT: RaiseLastOSError(WAIT_TIMEOUT, '
.'#10'
ExecuteAndWait.WaitForInputIdle');
WAIT_FAILED: ;
//RaiseLastOSError(554{ERROR_CANT_WAIT}, '.'#10'ExecuteAndWait.WaitForInputIdle');
else RaiseLastOSError(GetLastError, '
.'#10'
ExecuteAndWait.WaitForInputIdle');
end;
if Input <> '
'
then
CurrControl.WriteLn(Input);
if (Timeout > 0)
and not Assigned(Control)
then
if not CurrControl.Wait(Timeout)
then
RaiseLastOSError(WAIT_TIMEOUT, '
.'#10'
ExecuteAndWait.Wait');
if not Assigned(Control)
then
CurrControl.CloseHandles;
except
on E: EOSError
do begin
OutputDebugString(PChar('
ExecuteAndWait.' + E.ClassName + '
(' + E.ErrorCode.ToString + '
): ' + E.
Message));
CurrControl.CloseHandles;
CurrControl.ExitCode := E.ErrorCode;
if Assigned(Control)
then
Control^ := CurrControl;
raise;
end;
on E:
Exception do begin
OutputDebugString(PChar('
ExecuteAndWait.' + E.ClassName + '
: ' + E.
Message));
CurrControl.CloseHandles;
CurrControl.ExitCode := S_FALSE;
if Assigned(Control)
then
Control^ := CurrControl;
raise;
end;
end;
Result := CurrControl.ExitCode;
if Assigned(Control)
then
Control^ := CurrControl;
if Assigned(ProcessID)
then
ProcessID^ := CurrControl.ProcessID;
if Assigned(Output)
then begin
Output^ := CurrControl.
Read;
if Assigned(Control)
then
SetLength(Control^.OutputCache, Length(Control^.OutputCache));
// make Unique (Output^ does not clear the Cache)
end;
end;
{ TExecuteControl }
function TExecuteControl.CloseHandles: HRESULT;
begin
if Process <> 0
then begin
if IsHandleAssigned(ehOutput, True)
then
try DoRead(OutputCache, OutputHandler, '
');
except end;
if not GetExitCodeProcess(Process, ExitCode)
then // ExitCode=STILL_ACTIVE if process is active
ExitCode := ERROR_PROCESS_ABORTED;
end;
CloseHandle(Process);
CloseHandle(MainThread);
ProcessID := 0;
Process := 0;
MainThreadID := 0;
MainThread := 0;
FreeHandle(ehInput);
FreeHandle(ehOutput);
FreeHandle(ehError);
Result := ExitCode;
end;
procedure TExecuteControl.CloseProcess(Timeout: LongWord);
begin
if not IsRunning
then
Exit;
if not PostThreadMessage(MainThreadID, WM_QUIT, 0, 0)
then
if GetLastError = ERROR_NOT_ENOUGH_QUOTA
then begin
if not GenerateConsoleCtrlEvent(CTRL_BREAK_EVENT
{CTRL_CLOSE_EVENT CTRL_C_EVENT}, ProcessID)
then // for CTRL_C_EVENT use CreateProcess+CREATE_NEW_PROCESS_GROUP
RaiseLastOSError(GetLastError, '
.'#10'
ExecuteAndWait.CloseProcess');
end else
RaiseLastOSError(GetLastError, '
.'#10'
ExecuteAndWait.CloseProcess');
Wait(Timeout);
end;
procedure TExecuteControl.CreateDuplicateHandle(
Handle: TExecuteHandle);
begin
if Handle <> ehError
then
RaiseLastOSError(ERROR_INVALID_PARAMETER, '
.'#10'
ExecuteAndWait.CreateDuplicateHandle');
FreeHandle(ehError);
if Output = GetStdHandle(STD_OUTPUT_HANDLE)
then
Exit;
if not IsHandleAssigned(ehOutput, False)
then
RaiseLastOSError(ERROR_INVALID_HANDLE, '
.'#10'
ExecuteAndWait.CreateDuplicateHandle');
if not DuplicateHandle(GetCurrentProcess, Output, GetCurrentProcess, @ErrorOutput, 0, True, DUPLICATE_SAME_ACCESS)
then;
RaiseLastOSError(GetLastError, '
.'#10'
ExecuteAndWait.CreateDuplicateHandle');
ErrorOutputHandler := OutputHandler;
end;
procedure TExecuteControl.CreateFileHandle(
Handle: TExecuteHandle; Filename:
string);
var
S: TSecurityAttributes;
H: THandle;
begin
if Handle > ehError
then
RaiseLastOSError(ERROR_INVALID_PARAMETER, '
.'#10'
ExecuteAndWait.CreateFileHandle');
FreeHandle(
Handle);
S.nLength := SizeOf(S);
S.lpSecurityDescriptor :=
nil;
S.bInheritHandle := True;
H := CreateFile(PChar(Filename), IfThen(
Handle = ehInput, GENERIC_READ, GENERIC_WRITE), FILE_SHARE_READ
or FILE_SHARE_WRITE, @S, IfThen(
Handle = ehInput, OPEN_EXISTING, CREATE_ALWAYS), FILE_ATTRIBUTE_NORMAL, 0);
if H = INVALID_HANDLE_VALUE
then
RaiseLastOSError(GetLastError, '
.'#10'
ExecuteAndWait.CreateFileHandle');
case Handle of
ehInput: Input := H;
ehOutput: Output := H;
ehError: ErrorOutput := H;
end;
end;
procedure TExecuteControl.CreateLocalHandle(
Handle: TExecuteHandle);
var
S: TSecurityAttributes;
B: Boolean;
begin
if Handle > ehError
then
RaiseLastOSError(ERROR_INVALID_PARAMETER, '
.'#10'
ExecuteAndWait.CreateLocalHandle');
FreeHandle(
Handle);
S.nLength := SizeOf(S);
S.lpSecurityDescriptor :=
nil;
S.bInheritHandle := True;
case Handle of
ehInput: B := CreatePipe(Input, InputHandler, @S, 0);
ehOutput: B := CreatePipe(OutputHandler, Output, @S, 0);
ehError: B := CreatePipe(ErrorOutputHandler, ErrorOutput, @S, 0);
end;
if not B
then
RaiseLastOSError(GetLastError, '
.'#10'
ExecuteAndWait.CreateLocalHandle');
end;
procedure TExecuteControl.DoRead(
var B: TBytes; H: THandle;
Name:
string);
var
L: Integer;
E, R: LongWord;
begin
if (H = 0)
or (H = INVALID_HANDLE_VALUE)
then
Exit;
if PeekNamedPipe(H,
nil, 0,
nil, @R,
nil)
then begin
if L > 0
then begin
L := Length(B);
SetLength(B, L + R);
if not ReadFile(H, B[L], 1024, R,
nil)
then begin
E := GetLastError;
SetLength(B, L);
RaiseLastOSError(E,
Name);
end;
SetLength(B, L + R);
end;
end else
repeat
L := Length(B);
SetLength(B, L + 1024);
if not ReadFile(H, B[L], 1024, R,
nil)
then begin
E := GetLastError;
SetLength(B, L);
RaiseLastOSError(E,
Name);
end;
Inc(L, R);
SetLength(B, L);
until L <> 0;
end;
procedure TExecuteControl.FreeHandle(
Handle: TExecuteHandle);
begin
case Handle of
ehInput:
begin
if IsHandleAssigned(ehInput, True)
then
CloseHandle(InputHandler);
if IsHandleAssigned(ehInput, False)
then
CloseHandle(Input);
InputHandler := 0;
Input := 0;
end;
ehOutput:
begin
if (ErrorOutputHandler = OutputHandler)
and IsHandleAssigned(ehError, True)
then
FreeHandle(ehError);
if IsHandleAssigned(ehOutput, True)
then
CloseHandle(OutputHandler);
if IsHandleAssigned(ehOutput, False)
then
CloseHandle(Output);
OutputHandler := 0;
Output := 0;
end;
ehError:
begin
if IsHandleAssigned(ehError, True)
and (ErrorOutputHandler <> OutputHandler)
then
CloseHandle(ErrorOutputHandler);
if IsHandleAssigned(ehError, False)
then
CloseHandle(ErrorOutput);
ErrorOutputHandler := 0;
ErrorOutput := 0;
end;
else
RaiseLastOSError(ERROR_INVALID_PARAMETER, '
.'#10'
ExecuteAndWait.FreeHandle');
end;
end;
procedure TExecuteControl.Initialize(Handles: TExecuteHandles; InputFile, OutputFile:
string);
begin
Finalize(Self);
FillChar(Self, SizeOf(Self), 0);
if Handles
in [ehAllHandles, ehNoErrorHandle, ehOnlyInputHandle]
then
if InputFile <> '
'
then
CreateFileHandle(ehInput, InputFile)
else
CreateLocalHandle(ehInput);
if Handles
in [ehAllHandles, ehNoErrorHandle]
then
if OutputFile <> '
'
then
CreateFileHandle(ehOutput, OutputFile)
else
CreateLocalHandle(ehOutput);
if Handles
in [ehAllHandles]
then
if OutputFile <> '
'
then
CreateDuplicateHandle(ehError)
else
CreateLocalHandle(ehError);
ExitCode := S_FALSE;
end;
function TExecuteControl.IsHandleAssigned(
Handle: TExecuteHandle; CheckHandler: Boolean): Boolean;
begin
Result := ((
Handle = ehInput)
and CheckHandler
and (InputHandler <> 0)
and (InputHandler <> INVALID_HANDLE_VALUE))
or ((
Handle = ehInput)
and not CheckHandler
and (Input <> 0)
and (Input <> INVALID_HANDLE_VALUE)
and (Input <> GetStdHandle(STD_INPUT_HANDLE)))
or ((
Handle = ehOutput)
and CheckHandler
and (OutputHandler <> 0)
and (OutputHandler <> INVALID_HANDLE_VALUE))
or ((
Handle = ehOutput)
and not CheckHandler
and (Output <> 0)
and (Output <> INVALID_HANDLE_VALUE)
and (Output <> GetStdHandle(STD_OUTPUT_HANDLE)))
or ((
Handle = ehError)
and CheckHandler
and (ErrorOutputHandler <> 0)
and (ErrorOutputHandler <> INVALID_HANDLE_VALUE))
or ((
Handle = ehError)
and not CheckHandler
and (ErrorOutput <> 0)
and (ErrorOutput <> INVALID_HANDLE_VALUE)
and (ErrorOutput <> GetStdHandle(STD_ERROR_HANDLE)))
end;
function TExecuteControl.IsRunning: Boolean;
var
C: LongWord;
begin
Result := (Process <> 0)
and GetExitCodeProcess(Process, C)
and (C = STILL_ACTIVE);
end;
function TExecuteControl.
Read(Count: Integer):
string;
begin
//if not IsHandleAssigned(ehOutput, True) then
// RaiseLastOSError(ERROR_INVALID_HANDLE, '.'#10'ExecuteAndWait.Read');
DoRead(OutputCache, OutputHandler, '
.'#10'
ExecuteAndWait.Read');
with TEncoding.GetEncoding(CP_OEMCP)
do
try
if Count < 0
then begin
Result := GetString(OutputCache);
OutputCache :=
nil;
end else begin
Result := GetString(OutputCache, 0, Min(Count, Length(OutputCache)));
TArray.Copy<Byte>(OutputCache, OutputCache, Length(Result), 0, Length(OutputCache) - Length(Result));
SetLength(OutputCache, Length(OutputCache) - Length(Result));
end;
finally
Free;
end;
end;
function TExecuteControl.ReadBytes(Count: Integer): TBytes;
begin
//if not IsHandleAssigned(ehOutput, True) then
// RaiseLastOSError(ERROR_INVALID_HANDLE, '.'#10'ExecuteAndWait.Read');
DoRead(OutputCache, OutputHandler, '
.'#10'
ExecuteAndWait.Read');
if Count < 0
then begin
Result := OutputCache;
OutputCache :=
nil;
end else begin
SetLength(Result, Min(Count, Length(OutputCache)));
TArray.Copy<Byte>(OutputCache, Result, Length(Result));
TArray.Copy<Byte>(OutputCache, OutputCache, Length(Result), 0, Length(OutputCache) - Length(Result));
SetLength(OutputCache, Length(OutputCache) - Length(Result));
end;
end;
function TExecuteControl.ReadError:
string;
var
B: TBytes;
L, R: Integer;
begin
if (ErrorOutputHandler = OutputHandler)
or not IsHandleAssigned(ehError, True)
then
RaiseLastOSError(ERROR_INVALID_HANDLE, '
.'#10'
ExecuteAndWait.ReadError');
DoRead(B, ErrorOutputHandler, '
.'#10'
ExecuteAndWait.ReadError');
with TEncoding.GetEncoding(CP_OEMCP)
do
try
Result := GetString(B);
finally
Free;
end;
end;
function TExecuteControl.ReadLn:
string;
var
L, i: Integer;
begin
//if not IsHandleAssigned(ehOutput, True) then
// RaiseLastOSError(ERROR_INVALID_HANDLE, '.'#10'ExecuteAndWait.Read');
repeat
DoRead(OutputCache, OutputHandler, '
.'#10'
ExecuteAndWait.Read');
L := Length(OutputCache);
i := 0;
while (i < L)
and not (OutputCache[i]
in [0, 10, VK_RETURN])
do
Inc(i);
if ((i < L)
and (OutputCache[i]
in [0, 10, VK_RETURN]))
or not IsRunning
then begin
Result :=
Read(i);
L := Length(OutputCache);
i := 0;
if (i < L)
and (OutputCache[i] = VK_RETURN)
then
Inc(i);
if (i < L)
and (OutputCache[i] = 10)
then
Inc(i);
TArray.Copy<Byte>(OutputCache, OutputCache, i, 0, Length(OutputCache) - i);
SetLength(OutputCache, Length(OutputCache) - i);
Break;
end;
Sleep(100);
until False;
end;
function TExecuteControl.ReadWord:
string;
var
L, i, i2: Integer;
begin
//if not IsHandleAssigned(ehOutput, True) then
// RaiseLastOSError(ERROR_INVALID_HANDLE, '.'#10'ExecuteAndWait.Read');
repeat
DoRead(OutputCache, OutputHandler, '
.'#10'
ExecuteAndWait.Read');
L := Length(OutputCache);
i := 0;
while (i < L)
and not (OutputCache[i]
in [0, VK_TAB, 10, VK_RETURN, VK_SPACE])
do
Inc(i);
i2 := i;
while (i2 < L)
and (OutputCache[i2]
in [VK_TAB, VK_SPACE])
do
Inc(i2);
if ((i2 < L)
and (OutputCache[i2]
in [0, 10, VK_RETURN]))
or not IsRunning
then begin
Result := TrimRight(
Read(i2));
Break;
end;
Sleep(100);
until False;
end;
function TExecuteControl.RunTime: TDateTime;
var
CreationTime, ExitTime, KernelTime, UserTime, CurrentTime: TFileTime;
begin
if Process = 0
then
Exit(0);
if not GetProcessTimes(Process, CreationTime, ExitTime, KernelTime, UserTime)
then
RaiseLastOSError(GetLastError, '
.'#10'
ExecuteAndWait.RunTime');
if IsRunning
then begin
GetSystemTimeAsFileTime(CurrentTime);
Result := (UInt64(CurrentTime) - UInt64(CreationTime))
div 10000;
end else
Result := (UInt64(ExitTime) - UInt64(CreationTime))
div 10000;
end;
function TExecuteControl.RunTimeCPU: TDateTime;
var
CreationTime, ExitTime, KernelTime, UserTime: TFileTime;
begin
if Process = 0
then
Exit(0);
if not GetProcessTimes(Process, CreationTime, ExitTime, KernelTime, UserTime)
then
RaiseLastOSError(GetLastError, '
.'#10'
ExecuteAndWait.RunTime');
Result := (UInt64(KernelTime) + UInt64(UserTime))
div 10000;
end;
function TExecuteControl.RunTimeKernel: TDateTime;
var
CreationTime, ExitTime, KernelTime, UserTime: TFileTime;
begin
if Process = 0
then
Exit(0);
if not GetProcessTimes(Process, CreationTime, ExitTime, KernelTime, UserTime)
then
RaiseLastOSError(GetLastError, '
.'#10'
ExecuteAndWait.RunTime');
Result := UInt64(KernelTime)
div 10000;
end;
procedure TExecuteControl.SetStandardHandle(
Handle: TExecuteHandle);
begin
if Handle > ehError
then
RaiseLastOSError(ERROR_INVALID_PARAMETER, '
.'#10'
ExecuteAndWait.CreateDuplicateHandle');
FreeHandle(
Handle);
case Handle of
ehInput: Input := GetStdHandle(STD_INPUT_HANDLE);
ehOutput: Output := GetStdHandle(STD_OUTPUT_HANDLE);
ehError: ErrorOutput := GetStdHandle(STD_ERROR_HANDLE);
end;
end;
procedure TExecuteControl.TerminateProcess;
var
DoAbort: Boolean;
begin
DoAbort := IsRunning;
try
if DoAbort
and not Winapi.Windows.TerminateProcess(Process, ERROR_PROCESS_ABORTED)
then
RaiseLastOSError(GetLastError, '
.'#10'
ExecuteAndWait.Terminate');
finally
CloseHandles;
if DoAbort
then
ExitCode := ERROR_PROCESS_ABORTED;
end;
end;
function TExecuteControl.Wait(Timeout: LongWord
{; OtherSignal: THandle}): Boolean;
begin
if Process = 0
then
Exit(True);
case WaitForSingleObject(Process, Timeout)
of
WAIT_OBJECT_0, WAIT_ABANDONED:
Result := True;
WAIT_TIMEOUT:
Result := False;
WAIT_FAILED:
RaiseLastOSError(GetLastError, '
.'#10'
ExecuteAndWait.WriteEOF');
else
RaiseLastOSError(ERROR_INVALID_FUNCTION, '
.'#10'
ExecuteAndWait.WriteEOF');
end;
end;
procedure TExecuteControl.
Write(S:
string);
begin
with TEncoding.GetEncoding(CP_OEMCP)
do
try
WriteBytes(GetBytes(S));
finally
Free;
end;
end;
procedure TExecuteControl.WriteBytes(B: TBytes);
var
L: LongWord;
begin
if not IsHandleAssigned(ehInput, True)
then
RaiseLastOSError(ERROR_INVALID_HANDLE, '
.'#10'
ExecuteAndWait.Write');
if Assigned(B)
and not WriteFile(InputHandler, B[0], Length(B), L,
nil)
then
RaiseLastOSError(GetLastError, '
.'#10'
ExecuteAndWait.Write');
if Length(B) <> L
then
RaiseLastOSError(ERROR_WRITE_FAULT, '
.'#10'
ExecuteAndWait.WriteEOF');
end;
procedure TExecuteControl.WriteLn(S:
string);
begin
Write(S + #13);
end;