Delphi与睡眠功能

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

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天。

---

当然，在此期间主窗口将进入“无响应”模式。有谁能建议我如何正确地执行此操作吗？

如果在UI线程中调用

Sleep

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

Sleep

你可以打开另一个线程，把你的

睡眠

呼叫放在那里。当对

Sleep

的调用返回时，您可以执行任何需要执行的操作

其他一些评论：

睡这么长时间通常不是解决任何问题的最好办法。也许你想安排一项任务。或者，您最好在程序中设置一个周期性脉冲，检查超时是否已过期

Winexec

自从32位Windows发布以来，20多年来一直被弃用。使用

CreateProcess

启动外部进程

如果要终止进程，请使用

TerminateProcess

终止似乎有点激烈。你没有别的办法说服这个项目停止吗

首先，自从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;

否则，请使用

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;

var
hProcess:THandle=0；
程序TForm1.启动；
开始
Timer1.Active:=假；
如果启动进程（'C:\BERN52\MENU\MENU.exe C:\BERN52\GPS\PAN\DAILY.INP C:\GPSUSER52\WORK\MENUAUX\u DAILY.INP'，@hProcess），则
开始
Timer1.Tag:=stroint（Edit11.Text）；
定时器1.间隔：=1000；
Timer1.Active:=真；
结束；
结束；
程序TForm1.Timer1Timer（发送方：TObject）；
变量
雷特：德沃德；
开始
Ret:=WaitForSingleObject（HPProcess，0）；
如果Ret=等待\u超时，则
开始
Timer1.Tag:=Timer1.Tag-1；
如果Timer1.Tag>0，则
出口
结束；
如果Ret WAIT_OBJECT_0，则
终止进程（hProcess，0）；
CloseHandle（hProcess）；
hProcess:=0；
Timer1.Active:=假；
结束；

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

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;

类型
TStartProcessThread=class（TThread）
私有的
fCmdLine：字符串；
fTimeout:DWORD；
fTermEvent:THandle；
受保护的
程序执行；推翻
公众的
构造函数创建（const CmdLine；超时：DWORD）；
毁灭者毁灭；推翻
程序停止；
结束；
函数StartProcess（const-CmdLine:string；ProcessHandle:PHandle=nil）：布尔；
开始
//如上所示。。。
结束；
构造函数TStartProcessThread.Create（const CmdLine；超时：DWORD）；
开始
继承创建（True）；
fterMeEvent:=CreateEvent（无、真、假、无）；
如果fTermEvent=0，则RAISELASTERROR；
fCmdLine:=CmdLine；
fTimeout:=超时；
FreeOnTerminate:=真；
结束；
析构函数TStartProcessThread.Destroy；
开始
如果fTermEvent为0，则关闭手柄（fTermEvent）；
继承；
结束；
程序TStartProcessThread.Stop；
开始
终止
SetEvent（HterEvent）；
结束；
过程TStartProcessThread.Execute；
变量
H:THandle的数组[0..1]；
开始
如果未启动进程（fCmdLine，@H[0]），则退出；
H[1]：=fTermEvent；
如果WaitForMultipleObjects（2，PWOHandleArray（@H），False，无限）等待\u OBJECT\u 0，则
终止进程（H[0]，0）；
闭柄（H[0]）；
结束；
变量
线程：TStartProcessThread=nil；
程序TForm1.启动；
开始
线程：=TStartProcessThread.Create（'C:\BERN52\MENU\MENU.exe C:\BERN52\GPS\PAN\DAILY.INP C:\GPSUSER52\WORK\MENUAUX\u DAILY.INP'，60000*stroint（Edit11.Text））；
Thread.OnTerminate:=threadterminate；
线程。开始；
结束；
程序TForm1.ThreadTerminated（发送方：TObject）；
开始
线程：=零；
结束；
过程TForm1.FormClose（发送方：TObject；var操作：TCloseAction）；
开始
如果线程为零，则
开始
Thread.OnTerminate:=nil；
线程。停止；
结束；
结束；

当然可以。忘记Delphi应用程序，在任务计划程序中创建任务。不可能，应该在Delphi中等待。为什么要强制终止启动的应用程序（menu.exe）？或者更好的问题。什么时候你声称当某个过程完成时？什么过程？你怎么知道它已经完成了？这些都是我们需要的重要信息。这个menu.exe是一个计算GPS数据的软件。计算时间取决于此数据的数量。我有计划-每天，每周，每月和每年的计算。我知道这个过程需要多少时间。以及我终止此menu.exe的原因-当它完成时，应在下一次启动前关闭它。如果我理解正确，您是在根据需要处理的数据量估计进程完成工作的时间。听听我的建议。不要！为什么？因为有很多事情可能会影响处理数据所需的时间，就像其他使用大部分CPU功率的进程一样。因此，如果您在应用程序实际完成工作之前强行杀死它，可能会造成数据损坏。谢谢。我可以通过按下按钮关闭此软件，但我需要完全自动化的过程。如果另一个过程有GUI，您应该向它发布

WM_QUIT

消息，这样它就可以打破消息循环并干净地退出。谢谢David！我是按照你的建议做的。现在它运转良好，什么也没发生。线不见了。但是中止WaitForSingleObject（）的唯一方法<

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;