{$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;