Delphi and sleep function

Question

I am having some issues regarding the sleep function. I have my application which executes an external command with some options:

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

After that when this process is finished I should kill it and continue with another things. I did the following:

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

This sleeping time can be 4 minutes but also can be 2 days. Of cause the main window going to the 'not responding' mode during this time. Could anyone suggest to me how to do this in a proper way?

Answer 1

First off, WinExec() has been deprecated since 32bit Windows was first introduced. Use ShellExecuteEx() or CreateProcess() instead. This also provides you with a process handle that you can use to detect when the spawned process terminates, and you can also use it to kill the process if your timeout elapses.

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;

If you absolutely must block your calling code while waiting, use MsgWaitForMultipleObjects() in a loop so you can still service the message queue:

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;

Otherwise, use a TTimer so the main message loop is not blocked:

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;

Otherwise, use a worker thread instead of a timer:

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

If you call Sleep in the UI thread, then the UI thread is no longer able to service its message queue. The not responding message is inevitable. The clear conclusion from this is that you must not call Sleep in the UI thread.

You could spin up another thread and put your Sleep call there. When that call to Sleep returns you can then do whatever needs to be done.

Some other comments:

1. Sleeping for such a long time is usually not the best solution to any problem. Perhaps you want to schedule a task. Or perhaps you'd be better having a periodic pulse in your program that checked whether the timeout had expired.
2. Winexec has been deprecated since 32 bit Windows was released, over 20 years. Use CreateProcess to start an external process.
3. If you wish to kill a process, use TerminateProcess.
4. Termination seems a little drastic. Isn't there any other way for you to persuade this other program to stop?