I am a Delphi developer in our company. We need a function which launches a command-line executable and get its return value.
The code I wrote, and all the examples I found on the Internet, do this via CreateProcess(), but my boss rejected this and told me that there MUST be a solution doing this via ShellExecute(). I can't find any example on the Internet doing this with ShellExecute(). All of them use CreateProcess().
Below are 3 methods I delivered to my boss. He did not like ShellExecute_AndGetReturnValue(). It's named "ShellExecute", but it does not use ShellExecute().
All of these 3 methods are working fine. But the first one is not using ShellExecute(). Instead it is using CreateProcess().
So, is it possible to solve/change the ShellExecute_AndGetReturnValue() method so that it will use ShellExecute() instead of CreateProcess()? All examples I found, all of them, use CreateProcess().
function ShellExecute_AndGetReturnValue(FileName : string; Params : string = ''; Show : Integer = SW_HIDE; WorkingDir : string = '') : string;
const
READ_BUFFER_SIZE = 2048;
var
Security: TSecurityAttributes;
readableEndOfPipe, writeableEndOfPipe, readableErrorEndOfPipe, writeableErrorEndOfPipe: THandle;
start: TStartUpInfo;
ProcessInfo: TProcessInformation;
Buffer: PAnsiChar;
BytesRead: DWORD;
AppRunning: DWORD;
ResultStdOutput : string;
ResultErrOutput : string;
lpDirectory : PAnsiChar;
CmdLine : string;
begin
Result := '';
Security.nLength := SizeOf(TSecurityAttributes);
Security.bInheritHandle := True;
Security.lpSecurityDescriptor := nil;
if CreatePipe(readableEndOfPipe, writeableEndOfPipe, @Security, 0) then
begin
Buffer := AllocMem(READ_BUFFER_SIZE 1);
FillChar(Start, Sizeof(Start), #0);
FillChar(ProcessInfo, SizeOf(ProcessInfo), #0);
start.cb := SizeOf(start);
start.dwFlags := start.dwFlags or STARTF_USESTDHANDLES;
start.hStdInput := GetStdHandle(STD_INPUT_HANDLE);
start.hStdOutput := writeableEndOfPipe;
CreatePipe(readableErrorEndOfPipe, writeableErrorEndOfPipe, @Security, 0);
start.hStdError := writeableErrorEndOfPipe;
start.hStdError := writeableEndOfPipe;
start.dwFlags := start.dwFlags STARTF_USESHOWWINDOW;
start.wShowWindow := Show;
UniqueString(FileName);
CmdLine := '"' FileName '" ' Params;
if WorkingDir <> '' then
begin
lpDirectory := PAnsiChar(WorkingDir);
end else
begin
lpDirectory := PAnsiChar(ExtractFilePath(FileName));
end;
if CreateProcess(nil, PChar(CmdLine), nil, nil, True, NORMAL_PRIORITY_CLASS, nil, lpDirectory, start, ProcessInfo) then
begin
repeat
Apprunning := WaitForSingleObject(ProcessInfo.hProcess, 100);
Application.ProcessMessages;
until (Apprunning <> WAIT_TIMEOUT);
ResultStdOutput := '';
ResultErrOutput := '';
//Must Close write Handles before reading (if the console application does not output anything)
CloseHandle(writeableEndOfPipe);
CloseHandle(writeableErrorEndOfPipe);
repeat
BytesRead := 0;
ReadFile(readableEndOfPipe, Buffer[0], READ_BUFFER_SIZE, BytesRead, nil);
Buffer[BytesRead]:= #0;
OemToAnsi(Buffer,Buffer);
ResultStdOutput := ResultStdOutput String(Buffer);
until (BytesRead < READ_BUFFER_SIZE);
if start.hStdOutput <> start.hStdError then
begin
BytesRead := 0;
ReadFile(readableErrorEndOfPipe, Buffer[0], READ_BUFFER_SIZE, BytesRead, nil);
Buffer[BytesRead]:= #0;
OemToAnsi(Buffer,Buffer);
ResultErrOutput := ResultErrOutput String(Buffer);
end;
end;
Result := ResultStdOutput;
FreeMem(Buffer);
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
CloseHandle(readableEndOfPipe);
CloseHandle(readableErrorEndOfPipe);
end;
end;
procedure ShellExecute_NoWait(FileName : string; Params : string = ''; Action : string = 'open'; Show : Integer = SW_SHOWNORMAL; WorkingDir : string = '');
var
exInfo: TShellExecuteInfo;
Ph: DWORD;
begin
FillChar(exInfo, SizeOf(exInfo), 0);
with exInfo do
begin
cbSize := SizeOf(exInfo);
fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT;
Wnd := GetActiveWindow();
lpVerb := PAnsiChar(Action);
lpParameters := PChar(Params);
lpFile := PChar(FileName);
nShow := Show;
if WorkingDir <> '' then
begin
lpDirectory := PAnsiChar(WorkingDir);
end else
begin
lpDirectory := PAnsiChar(ExtractFilePath(FileName));
end;
end;
if ShellExecuteEx(@exInfo) then
begin
Ph := exInfo.HProcess;
CloseHandle(Ph);
end;
end;
procedure ShellExecute_AndWait(FileName : string; Params : string = ''; Action : string = 'open'; Show : Integer = SW_SHOWNORMAL; WorkingDir : string = '');
var
exInfo: TShellExecuteInfo;
Ph: DWORD;
begin
FillChar(exInfo, SizeOf(exInfo), 0);
with exInfo do
begin
cbSize := SizeOf(exInfo);
fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT;
Wnd := GetActiveWindow();
lpVerb := PAnsiChar(Action);
lpParameters := PChar(Params);
lpFile := PChar(FileName);
nShow := Show;
if WorkingDir <> '' then
begin
lpDirectory := PAnsiChar(WorkingDir);
end else
begin
lpDirectory := PAnsiChar(ExtractFilePath(FileName));
end;
end;
if ShellExecuteEx(@exInfo) then
begin
Ph := exInfo.HProcess;
while WaitForSingleObject(ExInfo.hProcess, 50) <> WAIT_OBJECT_0 do
begin
Application.ProcessMessages;
end;
CloseHandle(Ph);
end;
end;
CodePudding user response：
If you need to specify input/output pipes (to control stdin and stdout of the called process) then ShellExecute cannot be used. It simply does not support specifying these. Neither does ShellExecuteEx.
So the only option you have if you must use ShellExecute is to ShellExecute the command processor (CMD.EXE) and ask it to perform the redirection of input and output. This will limit your redirection source and target to physical files on the disk, as that's the way CMD.EXE allows redirection (>StdOut <StdIn).
Othwewise, your approach with CreateProcess is the way forward. What does your boss give as reason that you must use ShellExecute?
If you don't need redirection support, you can use ShellExecuteEx and then after a successful execution, you can obtain the Handle to the running process in Info.hProcess (Info is the TShellExecuteInfo structure passed to ShellExecuteEx).
This value can then be used in GetExitCodeProcess to determine if the process is still running, or if it has terminated (and you have thus retrieved the "Return Value", if I have correctly understood your use of this expression - it's actually called an "ExitCode", or - in batch files - an "ERRORLEVEL").
Incomplete code:
FUNCTION ShellExecuteAndWait(....) : DWORD;
.
.
VAR Info : TShellExecuteInfo;
.
.
Info.fMask:=Info.fMask OR SEE_MASK_NOCLOSEPROCESS;
IF NOT ShellExecuteEx(Info) THEN EXIT($FFFF8000);
IF Info.hProcess=0 THEN EXIT($FFFF0000);
REPEAT
IF NOT GetExitCodeProcess(Info.hProcess,Result) THEN EXIT($FFFFFFFF)
UNTIL Result<>STILL_ACTIVE
.
.
The above code should demonstrate how to do this...
CodePudding user response：
Task from your boss is not fully correct. Problem is that the generic solution of ShellExecute – is not start cmd.exe, this command starts an application that is linked to this type of file and starts it. So, to make it work like you want – it needs a lot of work. One more thing – do you need to get the result of work of your program or console output of your program? Here is modified part of sources from jcl library to return return code:
function PCharOrNil(const S: string): PChar;
begin
Result := Pointer(S);
end;
// memory initialization
procedure ResetMemory(out P; Size: Longint);
begin
if Size > 0 then
begin
Byte(P) := 0;
FillChar(P, Size, 0);
end;
end;
function ShellExecAndWait(const FileName: string; const Parameters: string;
const Verb: string; CmdShow: Integer; const Directory: string): cardinal;
var
Sei: TShellExecuteInfo;
Res: LongBool;
Msg: tagMSG;
ShellResult : boolean;
begin
ResetMemory(Sei, SizeOf(Sei));
Sei.cbSize := SizeOf(Sei);
Sei.fMask := SEE_MASK_DOENVSUBST or SEE_MASK_FLAG_NO_UI or SEE_MASK_NOCLOSEPROCESS or
SEE_MASK_FLAG_DDEWAIT or SEE_MASK_NOASYNC;
Sei.lpFile := PChar(FileName);
Sei.lpParameters := PCharOrNil(Parameters);
Sei.lpVerb := PCharOrNil(Verb);
Sei.nShow := CmdShow;
Sei.lpDirectory := PCharOrNil(Directory);
{$TYPEDADDRESS ON}
ShellResult := ShellExecuteEx(@Sei);
{$IFNDEF TYPEDADDRESS_ON}
{$TYPEDADDRESS OFF}
{$ENDIF ~TYPEDADDRESS_ON}
if ShellResult then begin
WaitForInputIdle(Sei.hProcess, INFINITE);
while WaitForSingleObject(Sei.hProcess, 10) = WAIT_TIMEOUT do
repeat
Msg.hwnd := 0;
Res := PeekMessage(Msg, Sei.Wnd, 0, 0, PM_REMOVE);
if Res then
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
until not Res;
if not GetExitCodeProcess(Sei.hProcess, Result) then
raise Exception.Create('GetExitCodeProcess fail');
CloseHandle(Sei.hProcess);
end else begin
raise Exception.Create('ShellExecuteEx fail');
end;
end;
procedure TForm2.Button1Click(Sender: TObject);
var
xResult : cardinal;
begin
xResult := ShellExecAndWait('ping.exe', '', '', 1, ''); //xResult = 1
xResult := ShellExecAndWait('ping.exe', '8.8.8.8', '', 1, ''); //xResult = 0
end;