Question

我想从Delphi开始一个可能长时间运行的后台进程。我想让流程独立运行，但首先我要检查流程是否正常运行。

如果在启动时出现任何问题，我想捕获写入standardErr的任何输出并记录它。如果后台进程启动正常，我的程序需要能够退出并使生成的进程继续运行。

psuedo代码将是这样的：

process:=RunProgramInBackground('someCommand.exe');
sleep(1000); // Wait a bit to see if the program started OK
if process.Finished and process.ExitCode=FAIL then 
    Raise Exception.Create(process.ErrorStream);
process.Dispose; // Close any connection we may still have to the running process
Program.Exit; // Background process keeps running

我已经看了几件事（WinExec，CreateProcess，ShellExecute，JclMiscel），但找不到我正在尝试做的任何示例。这样做的最佳方式是什么？

我正在使用Delphi 2010

后台进程是我没有源代码的第三方程序。

Answer 1

查看此article。我引用：“这是一个更新和改进的代码版本，允许您在代码中选择调用应用程序是否等待其他程序关闭，然后继续或只是将新启动的程序保留到自己的设备”。

procedure ExecNewProcess(ProgramName : String; Wait: Boolean);
var
 StartInfo : TStartupInfo;
 ProcInfo : TProcessInformation;
 CreateOK : Boolean;

begin
 { fill with known state } 
 FillChar(StartInfo,SizeOf(TStartupInfo),#0);
 FillChar(ProcInfo,SizeOf(TProcessInformation),#0);
 StartInfo.cb := SizeOf(TStartupInfo);
 CreateOK := CreateProcess(nil, PChar(ProgramName), nil, nil,False,
                    CREATE_NEW_PROCESS_GROUP+NORMAL_PRIORITY_CLASS,
                    nil, nil, StartInfo, ProcInfo);
 { check to see if successful } 
 if CreateOK then
  begin
    //may or may not be needed. Usually wait for child processes 
   if Wait then
    WaitForSingleObject(ProcInfo.hProcess, INFINITE);
  end
 else
  begin
   ShowMessage('Unable to run '+ProgramName);
  end;

 CloseHandle(ProcInfo.hProcess);
 CloseHandle(ProcInfo.hThread);
end;

编辑：在阅读您的评论后，我建议您查看之前的question

Answer 2

我最终使用示例No'Am链接到，并添加代码以检查进程是否正常启动。此函数仅检查后台进程的退出代码，它不读取StdErr输出。

这是我做的：

/// <summary> Runs a new process in the background. Waits for a short period, then checks that the process started succesfully.
/// If the process has already finished, checks the exit status. Otherwise, leaves it to run. </summary>
/// <param> ProgramName The executable name, including any parameters.</param>
/// <param> TimeOut Milliseconds to wait before checking the process has executed correctly</param>
/// <param> Directory The full path of the working directory</param>
/// <exception> Exception If the process was not started correctly or if the process was started but returned
/// an error before the timeout.</exception>
procedure ExecBackgroundProcess(ProgramName : String; TimeOut: Integer; Directory:string);
var
    StartInfo : TStartupInfo;
    ProcInfo : TProcessInformation;
    CreateOK : Boolean;
    status: Cardinal;
    theExitCode: Cardinal;
begin
    FillChar(StartInfo,SizeOf(TStartupInfo),#0);
    FillChar(ProcInfo,SizeOf(TProcessInformation),#0);
    StartInfo.cb := SizeOf(TStartupInfo);
    UniqueString(ProgramName); // Required if a const string is passed in. Otherwise the program crashes.
    CreateOK := CreateProcess(nil, PChar(ProgramName), nil, nil,False,
              CREATE_NEW_PROCESS_GROUP+NORMAL_PRIORITY_CLASS+CREATE_NO_WINDOW,
              nil, PChar(Directory), StartInfo, ProcInfo);

    if CreateOK then
    begin
        status:=WaitForSingleObject(ProcInfo.hProcess, TimeOut);
        if status<> WAIT_TIMEOUT then
        begin
            // Program has exited. Get exit code.
            GetExitCodeProcess(ProcInfo.hProcess, theExitCode);
            if theExitCode<>0 then raise Exception.Create('Program '''+ProgramName+''' failed with exit code '+IntToStr(theExitCode));
        end
    end
    else
      Raise Exception.Create('Unable to run '+ProgramName+' in directory '+Directory);

    CloseHandle(ProcInfo.hProcess);
    CloseHandle(ProcInfo.hThread);
end;

启动长时间运行后台进程并检查状态

2 个答案: