Today, at work I attacked a long running nuisance in a minor application. An old application/script written by somebody else sometimes hangs, specially if the files it is supposed to parse have been hand edited.
It is a low prio item, and I worked around this by cleaning up and restarting, but today got fed up and decided to tackle it once and for all, so I tried quickly create a
simple and easy tprocess derivate with a simple timeout, and since it is also a demonstration of some of the new
FPC 3.2.0+ TProcess features, I thought I should share:
{$mode delphi}
uses classes,sysutils,process,dateutils;
Type
{ TProcessTimeout }
TProcessTimeout = class(TProcess)
public
timeoutperiod: TTime;
timedout : boolean;
started : TDateTime;
procedure LocalnIdleSleep(Sender,Context : TObject;status:TRunCommandEventCode;const message:string);
end;
procedure TProcessTimeout.LocalnIdleSleep(Sender,Context : TObject;status:TRunCommandEventCode;const message:string);
begin
if status=RunCommandIdle then
begin
if (now-started)>timeoutperiod then
begin
timedout:=true;
Terminate(255);
exit;
end;
sleep(RunCommandSleepTime);
end;
end;
function RunCommandTimeout(const exename:TProcessString;const commands:array of TProcessString;out outputstring:string; Options : TProcessOptions = [];SWOptions:TShowWindowOptions=swoNone;timeout:integer=60):boolean;
Var
p : TProcessTimeout;
i,
exitstatus : integer;
ErrorString : String;
begin
p:=TProcessTimeout.create(nil);
p.OnRunCommandEvent:=p.LocalnIdleSleep;
p.timeoutperiod:=timeout/SecsPerDay;
if Options<>[] then
P.Options:=Options - [poRunSuspended,poWaitOnExit];
p.options:=p.options+[poRunIdle]; // needed to run the RUNIDLE event. See User Changes 3.2.0
P.ShowWindow:=SwOptions;
p.Executable:=exename;
if high(commands)>=0 then
for i:=low(commands) to high(commands) do
p.Parameters.add(commands[i]);
p.timedout:=false;
p.started:=now;
try
// the core loop of runcommand() variants, originally based on the "large output" scenario in the wiki, but continously expanded over 5 years.
result:=p.RunCommandLoop(outputstring,errorstring,exitstatus)=0;
if p.timedout then
result:=false;
finally
p.free;
end;
if exitstatus<>0 then result:=false;
end;
// example use:
var s : string;
begin
for s in FileList do
begin
if not RunCommandTimeout('someexe',['-v',s,'--output','dest\'+s],err,[],swoNone,60) then
begin
// failed to run or timeout. Set it apart by movefile to a failed dir.
end
else
begin
// ok, move file to done directory.
end;
end;
end;
The moving of the files uses winapi movefileex() with several retries in case the file is locked (getlasterror=32). A bit like many operations to remove files and directories in fpmkunit are guarded with retries.
I only tested in on Windows, but most of it should be portable. The only potential problem is if the process being Terminate()'d cause problems in p.RunCommandLoop on some targets. It might need extra checks on e.g. p.running.