Question

我有一些关于睡眠功能的问题。我的应用程序执行带有一些选项的外部命令：

str := 'C:\BERN52\MENU\menu.exe C:\BERN52\GPS\PAN\DAILY.INP C:\GPSUSER52\WORK\MENUAUX_DAILY.INP';
WinExec(Pansichar(str), SW_Shownormal);

在此过程完成之后，我应该杀死它并继续其他事情。我做了以下事情：

Sleep(60000*StrToInt(Form1.Edit11.Text));
winexec('taskkill /F /IM menu.exe', SW_HIDE);
...

这个睡眠时间可以是4分钟，但也可以是2天。因为主窗口在此期间进入“无响应”模式。有人能告诉我如何以正确的方式做到这一点吗？

Answer 1

首先，自{32} Windows首次推出以来，WinExec()已被弃用。请改用ShellExecuteEx()或CreateProcess()。这还为您提供了一个进程句柄，您可以使用它来检测生成的进程何时终止，如果超时，也可以使用它来终止进程。

type
  PHandle = ^THandle;

function StartProcess(const CmdLine: string; ProcessHandle: PHandle = nil): boolean;
var
  si: TStartupInfo;
  pi: TProcessInformation;
  str: string;
begin
  Result := False;
  if ProcessHandle <> nil then ProcessHandle^ := 0;

  str := CmdLine;
  {$IFDEF UNICODE}
  UniqueString(str);
  {$ENDIF}

  ZeroMemory(@si, sizeof(si));
  si.cbSize := sizeof(si);
  si.dwFlags := STARTF_USESHOWWINDOW;
  si.wShowWindow := SW_SHOWNORMAL;

  Result := CreateProcess(nil, PChar(str), nil, nil, False, 0, nil, nil, si, pi);
  if Result then
  begin
    CloseHandle(pi.hThread);
    if ProcessHandle <> nil then
      ProcessHandle^ := pi.hProcess
    else
      CloseHandle(pi.hThread);
  end;
end;

如果绝对必须在等待时阻止调用代码，请在循环中使用MsgWaitForMultipleObjects()，这样您仍然可以为消息队列提供服务：

procedure TForm1.Start;
var
  hProcess: THandle;
  Timeout, StartTicks, Elapsed, Ret: DWORD;
begin
  Timeout := 60000 * StrToInt(Edit11.Text);

  if StartProcess('C:\BERN52\MENU\menu.exe C:\BERN52\GPS\PAN\DAILY.INP C:\GPSUSER52\WORK\MENUAUX_DAILY.INP', @hProcess) then
  try
    repeat
      StartTicks := GetTickCount;
      Ret := MsgWaitForMultipleObjects(1, hProcess, False, Timeout, QS_ALLINPUT);
      if Ret <> (WAIT_OBJECT_0+1) then Break;
      Application.ProcessMessages;
      Elapsed := GetTickCount - StartTicks;
      if Elapsed <= Timeout then
        Dec(Timeout, Elapsed)
      else
        Timeout := 0;
    until False;
    if Ret <> WAIT_OBJECT_0 then
      TerminateProcess(hProcess, 0);
  finally
    CloseHandle(hProcess);
  end;
end;

否则，请使用TTimer，以便不阻止主消息循环：

var
  hProcess: THandle = 0;

procedure TForm1.Start;
begin
  Timer1.Active := False;
  if StartProcess('C:\BERN52\MENU\menu.exe C:\BERN52\GPS\PAN\DAILY.INP C:\GPSUSER52\WORK\MENUAUX_DAILY.INP', @hProcess) then
  begin
    Timer1.Tag := StrToInt(Edit11.Text);
    Timer1.Interval := 1000;
    Timer1.Active := True;
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  Ret: DWORD;
begin
  Ret := WaitForSingleObject(hProcess, 0);
  if Ret = WAIT_TIMEOUT then
  begin
    Timer1.Tag := Timer1.Tag - 1;
    if Timer1.Tag > 0 then
      Exit;
  end;
  if Ret <> WAIT_OBJECT_0 then
    TerminateProcess(hProcess, 0);
  CloseHandle(hProcess);
  hProcess := 0;
  Timer1.Active := False;
end;

否则，请使用工作线程而不是计时器：

type
  TStartProcessThread = class(TThread)
  private
    fCmdLine: string;
    fTimeout: DWORD;
    fTermEvent: THandle;
  protected
    procedure Execute; override;
  public
    constructor Create(const CmdLine; Timeout: DWORD);
    destructor Destroy; override;
    procedure Stop;
  end;

function StartProcess(const CmdLine: string; ProcessHandle: PHandle = nil): boolean;
begin
  // as shown above...
end;

constructor TStartProcessThread.Create(const CmdLine; Timeout: DWORD);
begin
  inherited Create(True);
  fTermEvent := CreateEvent(nil, True, False, nil);
  if fTermEvent = 0 then RaiseLastOSError;
  fCmdLine := CmdLine;
  fTimeout := Timeout;
  FreeOnTerminate := True;
end;

destructor TStartProcessThread.Destroy;
begin
  if fTermEvent <> 0 then CloseHandle(fTermEvent);
  inherited;
end;

procedure TStartProcessThread.Stop;
begin
  Terminate;
  SetEvent(hTermEvent);
end;

procedure TStartProcessThread.Execute;
var
  H: array[0..1] of THandle;
begin
  if not StartProcess(fCmdLine, @H[0]) then Exit;
  H[1] := fTermEvent;

  if WaitForMultipleObjects(2, PWOHandleArray(@H), False, INFINITE) <> WAIT_OBJECT_0 then
    TerminateProcess(H[0], 0);

  CloseHandle(H[0]);
end;

var
  Thread: TStartProcessThread = nil;

procedure TForm1.Start;
begin
  Thread := TStartProcessThread.Create('C:\BERN52\MENU\menu.exe C:\BERN52\GPS\PAN\DAILY.INP C:\GPSUSER52\WORK\MENUAUX_DAILY.INP', 60000 * StrToInt(Edit11.Text));
  Thread.OnTerminate := ThreadTerminated;
  Thread.Start;
end;

procedure TForm1.ThreadTerminated(Sender: TObject);
begin
  Thread := nil;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if Thread <> nil then
  begin
    Thread.OnTerminate := nil;
    Thread.Stop;
  end;
end;

Answer 2

如果在UI线程中调用Sleep，则UI线程将无法再为其消息队列提供服务。 无响应消息是不可避免的。由此得出的明确结论是，您不得在UI线程中调用Sleep。

您可以启动另一个帖子并将Sleep电话放在那里。当对Sleep的调用返回时，您可以执行任何需要完成的操作。

其他一些评论：

睡眠这么长时间通常不是解决任何问题的最佳方法。也许你想安排一项任务。或者，您可能最好在程序中定期检测脉冲，检查超时是否已过期。
Winexec已被弃用，超过20年。使用CreateProcess启动外部流程。
如果您想要终止某个流程，请使用TerminateProcess。
终止似乎有点激烈。你还没有别的方法可以说服其他程序停止吗？

Delphi和睡眠功能

2 个答案: