delphi - 执行带有参数的命令行可执行文件并等待错误代码(整数)？

Question

有谁知道调用命令行可执行文件的函数，允许向其传递参数(特别是字符串列表或字符串列表，并等待执行完成并返回错误代码(整数)？

我调用的可执行文件是一个delphi应用程序，它返回一个错误代码。我没有编写该应用程序，并且我没有以任何方式修改它的源代码

谢谢

Answer 1

这是我使用的代码。您应该能够在这里找到您需要的内容:

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;