2

Does anyone know of a function to call a commandline executable, allowing to pass it parameters (particularly a stringlist, or list of strings somehow, and waiting for execution to complete and return an error code (integer)?

The executable i am calling is a delphi app, which returns an error code. I did not write the app, and i do not have source to modify it in any way

thanx

2

1 Answer 1

7

This is the code that I use. You should be able to find what you need in here:

uses
  Windows, ShellAPI;

type
  TMethod = procedure of object;

procedure WaitUntilSignaled(Handle: THandle; const ProcessMessages: TMethod);
begin
  if Assigned(ProcessMessages) then begin
    ProcessMessages;//in case there are any messages are already waiting in the queue
    while MsgWaitForMultipleObjects(1, Handle, False, INFINITE, QS_ALLEVENTS)=WAIT_OBJECT_0+1 do begin
      ProcessMessages;
    end;
  end else begin
    WaitForSingleObject(Handle, INFINITE);
  end;
end;

function DefaultShellExecuteInfo(const Action, Filename, Parameters, Directory: string): TShellExecuteInfo;
begin
  ZeroMemory(@Result, SizeOf(Result));
  Result.cbSize := SizeOf(TShellExecuteInfo);
  Result.fMask := SEE_MASK_NOCLOSEPROCESS;
  if Assigned(Application.MainForm) then begin
    Result.Wnd := Application.MainFormHandle;
  end;
  Result.lpVerb := PChar(Action);
  Result.lpFile := PChar(Filename);
  Result.lpParameters := PChar(Parameters);
  Result.lpDirectory := PChar(Directory);
  Result.nShow := SW_SHOWNORMAL;
end;

function MyShellExecute(const ShellExecuteInfo: TShellExecuteInfo; out ExitCode: DWORD; Wait: Boolean; const ProcessMessages: TMethod): Boolean; overload;
begin
  Result := ShellExecuteEx(@ShellExecuteInfo);
  if Result and (ShellExecuteInfo.hProcess<>0) then begin
    Try
      if Wait then begin
        WaitUntilSignaled(ShellExecuteInfo.hProcess, ProcessMessages);
        GetExitCodeProcess(ShellExecuteInfo.hProcess, ExitCode);
      end;
    Finally
      CloseHandle(ShellExecuteInfo.hProcess);
    End;
  end;
end;

function MyShellExecute(const ShellExecuteInfo: TShellExecuteInfo; out ExitCode: DWORD; const ProcessMessages: TMethod): Boolean; overload;
begin
  Result := MyShellExecute(ShellExecuteInfo, ExitCode, True, ProcessMessages);
end;

function MyShellExecute(const ShellExecuteInfo: TShellExecuteInfo; Wait: Boolean; const ProcessMessages: TMethod): Boolean; overload;
var
  ExitCode: DWORD;
begin
  Result := MyShellExecute(ShellExecuteInfo, ExitCode, Wait, ProcessMessages);
end;

type
  TShellExecuteMessageHandler = record
  public
    procedure ProcessMessages;
  end;

procedure TShellExecuteMessageHandler.ProcessMessages;
begin
  Application.ProcessMessages;
  if Application.Terminated then begin
    Abort;
  end;
end;

function MyShellExecute(const Action, Filename, Parameters, Directory: string; Wait: Boolean): Boolean; overload;
var
  MessageHandler: TShellExecuteMessageHandler;
begin
  Try
    Result := MyShellExecute(
      DefaultShellExecuteInfo(Action, FileName, Parameters, Directory),
      Wait,
      MessageHandler.ProcessMessages
    );
  Except
    on EAbort do begin
      Result := False;//the wait has been terminated before the process signaled
    end;
  End;
end;
Sign up to request clarification or add additional context in comments.

Comments

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.