Execute a command-line Application via ShellExecute() and get its return value-CodePudding

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：

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;

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...