Delphi 和睡眠功能

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天。在此期间主要 window 进入 'not responding' 模式。谁能建议我如何以正确的方式做到这一点？

Answer 1

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

您可以启动另一个线程并将您的 Sleep 调用放在那里。当调用 Sleep returns 时，您可以做任何需要做的事情。

其他一些评论：

睡这么长时间通常不是解决任何问题的最佳方法。也许您想安排一项任务。或者你最好在你的程序中有一个周期性的 pulse 来检查超时是否已经过期。
Winexec 自 32 位 Windows 发布以来已弃用 20 多年。使用 CreateProcess 启动外部进程。
如果你想终止一个进程，使用TerminateProcess。
终止似乎有点过激。你有没有其他办法让这个其他程序停止？

Answer 2

首先，自首次引入 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;

Delphi 和睡眠功能

Delphi and sleep function

delphi

sleep

timer