Delphi and sleep function - delphi

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:
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.
Winexec has been deprecated since 32 bit Windows was released, over 20 years. Use CreateProcess to start an external process.
If you wish to kill a process, use TerminateProcess.
Termination seems a little drastic. Isn't there any other way for you to persuade this other program to stop?