You've already forked lazarus-ccr
lazMapViewer: Initial commit to CCR (based on Maciej Kaczkowski (https://github.com/maciejkaczkowski/mapviewer) and ti-dic's (https://sourceforge.net/p/roadbook/code/ci/master/tree/mapviewer/) MapViewer components. Removed dependence on RGB_Graphics. Rename TMapViewer to TMapView and TMVGLGeonames to TMvGeoNames to avoid naming conflicts with original packages.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6307 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
803
components/lazmapviewer/source/mvjobqueue.pas
Normal file
803
components/lazmapviewer/source/mvjobqueue.pas
Normal file
@@ -0,0 +1,803 @@
|
||||
{
|
||||
Multi thread Queue,witch can be used without multi-thread (c) 2014 ti_dic
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the terms of the GNU Library General Public License as published by
|
||||
the Free Software Foundation; either version 2 of the License, or (at your
|
||||
option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but WITHOUT
|
||||
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
||||
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
|
||||
for more details.
|
||||
|
||||
You should have received a copy of the GNU Library General Public License
|
||||
along with this library; if not, write to the Free Software Foundation,
|
||||
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
}
|
||||
unit mvJobQueue;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,syncobjs,contnrs,forms;
|
||||
|
||||
const ALL_TASK_COMPLETED = -1;
|
||||
NO_MORE_TASK = 0;
|
||||
|
||||
type
|
||||
TjobQueue = class;
|
||||
|
||||
{ TJob }
|
||||
|
||||
TJob = Class
|
||||
private
|
||||
FLauncher : TObject;
|
||||
FCancelled : Boolean;
|
||||
FName: String;
|
||||
protected
|
||||
Queue : TJobQueue;
|
||||
|
||||
procedure DoCancel;virtual;
|
||||
Procedure WaitForResultOf(aJob : TJob);
|
||||
Procedure EnterCriticalSection;
|
||||
procedure LeaveCriticalSection;
|
||||
|
||||
//should be called inside critical section
|
||||
function pGetTask : integer;virtual;
|
||||
procedure pTaskStarted(aTask: integer);virtual;abstract;
|
||||
procedure pTaskEnded(aTask : integer;aExcept : Exception);virtual;abstract;
|
||||
property Launcher : TObject read FLauncher;
|
||||
public
|
||||
procedure ExecuteTask(aTask : integer;FromWaiting : boolean);virtual;abstract;
|
||||
function Running : boolean;virtual;abstract;
|
||||
procedure Cancel;
|
||||
property Cancelled : boolean read FCancelled;
|
||||
property Name : String read FName write FName;
|
||||
end;
|
||||
|
||||
TJobArray = Array of TJob;
|
||||
|
||||
{ TjobQueue }
|
||||
|
||||
TjobQueue = Class
|
||||
private
|
||||
FMainThreadId : TThreadID;
|
||||
FOnIdle: TNotifyEvent;
|
||||
waitings : TStringList;
|
||||
FNbThread : integer;
|
||||
TerminatedThread : integer;
|
||||
FSect : TCriticalSection;
|
||||
FEvent,TerminateEvent : TEvent;
|
||||
FUseThreads: boolean;
|
||||
Threads : TList;
|
||||
Jobs : TObjectList;
|
||||
procedure pJobCompleted(var aJob: TJob);
|
||||
procedure SetUseThreads(AValue: boolean);
|
||||
procedure ClearWaitings;
|
||||
protected
|
||||
Procedure InitThreads;
|
||||
Procedure FreeThreads;
|
||||
Procedure EnterCriticalSection;
|
||||
procedure LeaveCriticalSection;
|
||||
Procedure DoWaiting(E : Exception;TaskId : integer);
|
||||
|
||||
//Should be called inside critical section
|
||||
procedure pAddWaiting(aJob : TJob;aTask : integer;JobId : String);
|
||||
procedure pTaskStarted(aJob : TJob;aTask : integer);
|
||||
procedure pTaskEnded(var aJob : TJob;aTask : integer;aExcept : Exception);
|
||||
function pGetJob(out TaskId : integer;out Restart : boolean) : TJob;
|
||||
function pFindJobByName(const aName : string;ByLauncher: TObject) : TJobArray;
|
||||
procedure pNotifyWaitings(aJob : TJob);
|
||||
Function IsMainThread : boolean;
|
||||
public
|
||||
constructor Create(NbThread : integer = 5);
|
||||
destructor Destroy;override;
|
||||
procedure QueueAsyncCall(const AMethod: TDataEvent; Data: PtrInt);
|
||||
procedure QueueSyncCall(const AMethod: TDataEvent; Data: PtrInt);
|
||||
property UseThreads : boolean read FUseThreads write SetUseThreads;
|
||||
Procedure AddJob(aJob : TJob;Launcher : TObject);
|
||||
function AddUniqueJob(aJob : TJob;Launcher : TObject) : boolean;
|
||||
function CancelAllJob(ByLauncher: TObject) : TJobArray;
|
||||
function CancelJobByName(aJobName : String;ByLauncher: TObject) : boolean;
|
||||
Procedure WaitForTerminate(const lstJob : TJobArray);
|
||||
Procedure WaitAllJobTerminated(ByLauncher: TObject);
|
||||
property OnIdle : TNotifyEvent read FOnIdle write FOnIdle;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
const
|
||||
WAIT_TIME = 3000;
|
||||
TERMINATE_TIMEOUT = 1000;
|
||||
|
||||
|
||||
Type
|
||||
|
||||
{ EWaiting }
|
||||
|
||||
EWaiting = Class(Exception)
|
||||
private
|
||||
FLauncher : TJob;
|
||||
FNewJob : TJob;
|
||||
public
|
||||
constructor Create(launcher : TJob;NewJob : TJob);
|
||||
end;
|
||||
|
||||
{ TRestartTask }
|
||||
|
||||
TRestartTask = Class(TJob)
|
||||
private
|
||||
FStarted : Boolean;
|
||||
FJob : TJob;
|
||||
FTask : integer;
|
||||
protected
|
||||
procedure DoCancel;override;
|
||||
procedure pTaskStarted(aTask: integer);override;
|
||||
procedure pTaskEnded(aTask : integer;aExcept : Exception);override;
|
||||
function pGetTask : integer;override;
|
||||
public
|
||||
constructor Create(aJob : TJob;aTask : integer);
|
||||
procedure ExecuteTask(aTask : integer;FromWaiting : boolean);override;
|
||||
function Running : boolean;override;
|
||||
end;
|
||||
|
||||
{ TQueueThread }
|
||||
|
||||
TQueueThread = Class(TThread)
|
||||
private
|
||||
MyQueue : TJobqueue;
|
||||
function ProcessJob : boolean;
|
||||
public
|
||||
constructor Create(aQueue: TJobQueue);
|
||||
procedure Execute; override;
|
||||
end;
|
||||
|
||||
{ TRestartTask }
|
||||
|
||||
procedure TRestartTask.DoCancel;
|
||||
begin
|
||||
FJob.Cancel;
|
||||
end;
|
||||
|
||||
procedure TRestartTask.pTaskStarted(aTask: integer);
|
||||
begin
|
||||
FStarted := true;
|
||||
end;
|
||||
|
||||
procedure TRestartTask.pTaskEnded(aTask: integer; aExcept: Exception);
|
||||
begin
|
||||
Queue.pTaskEnded(FJob,FTask,aExcept);
|
||||
end;
|
||||
|
||||
function TRestartTask.pGetTask: integer;
|
||||
begin
|
||||
if FStarted then
|
||||
Result:=inherited pGetTask
|
||||
else
|
||||
Result:=1;
|
||||
end;
|
||||
|
||||
constructor TRestartTask.Create(aJob: TJob; aTask: integer);
|
||||
begin
|
||||
FJob:=aJob;
|
||||
FTask:=aTask;
|
||||
end;
|
||||
|
||||
procedure TRestartTask.ExecuteTask(aTask: integer; FromWaiting: boolean);
|
||||
begin
|
||||
FJob.ExecuteTask(FTask,true);
|
||||
end;
|
||||
|
||||
function TRestartTask.Running: boolean;
|
||||
begin
|
||||
Result:=Fstarted;
|
||||
end;
|
||||
|
||||
{ EWaiting }
|
||||
|
||||
constructor EWaiting.Create(launcher: TJob; NewJob: TJob);
|
||||
begin
|
||||
FLauncher:=launcher;
|
||||
FNewJob:=NewJob;
|
||||
end;
|
||||
|
||||
{ TQueueThread }
|
||||
|
||||
function TQueueThread.ProcessJob : boolean;
|
||||
var aJob : TJob;
|
||||
TaskId : Integer;
|
||||
|
||||
Procedure SetRes(e : Exception);
|
||||
Begin
|
||||
MyQueue.EnterCriticalSection;
|
||||
Try
|
||||
MyQueue.pTaskEnded(aJob,TaskId,nil);
|
||||
finally
|
||||
MyQueue.LeaveCriticalSection;
|
||||
end;
|
||||
end;
|
||||
var RestartTask : boolean;
|
||||
SomeJob : Boolean;
|
||||
begin
|
||||
Result:=false;
|
||||
Repeat
|
||||
SomeJob:=false;
|
||||
MyQueue.EnterCriticalSection;
|
||||
Try
|
||||
result:=result or (MyQueue.Jobs.Count>0);
|
||||
aJob:=MyQueue.pGetJob(TaskId,RestartTask);
|
||||
if Assigned(aJob) then
|
||||
Begin
|
||||
if TaskId=ALL_TASK_COMPLETED then
|
||||
begin
|
||||
MyQueue.pJobCompleted(aJob);
|
||||
SomeJob := true;
|
||||
end
|
||||
else
|
||||
Begin
|
||||
MyQueue.FEvent.ResetEvent;
|
||||
if not(RestartTask) then
|
||||
MyQueue.pTaskStarted(aJob,TaskId);
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
MyQueue.LeaveCriticalSection;
|
||||
end;
|
||||
if Assigned(aJob) then
|
||||
Begin
|
||||
SomeJob:=true;
|
||||
Try
|
||||
aJob.ExecuteTask(TaskId,RestartTask);
|
||||
SetRes(nil);
|
||||
Except
|
||||
on e : Exception do
|
||||
if e.InheritsFrom(EWaiting) then
|
||||
MyQueue.DoWaiting(e,TaskId)
|
||||
else
|
||||
SetRes(e);
|
||||
end;
|
||||
end;
|
||||
until SomeJob=false;
|
||||
end;
|
||||
|
||||
constructor TQueueThread.Create(aQueue: TJobQueue);
|
||||
begin
|
||||
MyQueue := aQueue;
|
||||
inherited Create(False);
|
||||
end;
|
||||
|
||||
procedure TQueueThread.Execute;
|
||||
var wRes : TWaitResult;
|
||||
begin
|
||||
while not Terminated do
|
||||
begin
|
||||
wRes:=MyQueue.FEvent.WaitFor(WAIT_TIME);
|
||||
if not(Terminated) then
|
||||
Begin
|
||||
if not(ProcessJob) then
|
||||
if wRes=wrTimeout then
|
||||
if Assigned(MyQueue.OnIdle) then
|
||||
MyQueue.OnIdle(self);
|
||||
end;
|
||||
end;
|
||||
MyQueue.EnterCriticalSection;
|
||||
Try
|
||||
inc(MyQueue.TerminatedThread);
|
||||
if Assigned(MyQueue.TerminateEvent) then
|
||||
if MyQueue.TerminatedThread=MyQueue.Threads.count then
|
||||
MyQueue.TerminateEvent.SetEvent;
|
||||
finally
|
||||
MyQueue.LeaveCriticalSection;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TjobQueue }
|
||||
|
||||
procedure TjobQueue.SetUseThreads(AValue: boolean);
|
||||
begin
|
||||
if FUseThreads=AValue then
|
||||
Exit;
|
||||
FUseThreads:=AValue;
|
||||
if Fusethreads then
|
||||
InitThreads
|
||||
else
|
||||
FreeThreads;
|
||||
end;
|
||||
|
||||
procedure TjobQueue.ClearWaitings;
|
||||
var i : integer;
|
||||
begin
|
||||
For i:=0 to pred(Waitings.count) do
|
||||
Waitings.Objects[i].Free;
|
||||
Waitings.Clear;
|
||||
end;
|
||||
|
||||
procedure TjobQueue.InitThreads;
|
||||
var i : integer;
|
||||
begin
|
||||
Jobs:=TObjectList.Create(true);
|
||||
Threads:=TObjectList.Create(true);
|
||||
FEvent:=TEvent.Create(nil,true,false,'');
|
||||
FSect:=TCriticalSection.Create;
|
||||
TerminatedThread := 0;
|
||||
For i:=1 to FNbThread do
|
||||
Threads.Add(TQueueThread.Create(self));
|
||||
end;
|
||||
|
||||
procedure TjobQueue.FreeThreads;
|
||||
var i : integer;
|
||||
begin
|
||||
if Assigned(Threads) then
|
||||
Begin
|
||||
TerminateEvent := TEvent.Create(nil,false,false,'');
|
||||
Try
|
||||
FEvent.SetEvent;
|
||||
TerminatedThread:=0;
|
||||
For i:=0 to pred(Threads.Count) do
|
||||
TQueueThread(Threads[i]).Terminate;
|
||||
TerminateEvent.WaitFor(TERMINATE_TIMEOUT);
|
||||
FreeAndNil(FSect);
|
||||
FreeAndNil(FEvent);
|
||||
FreeAndNil(Threads);
|
||||
finally
|
||||
FreeAndNil(TerminateEvent);
|
||||
end;
|
||||
FreeAndNil(Jobs);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TjobQueue.EnterCriticalSection;
|
||||
begin
|
||||
if Assigned(FSect) and UseThreads then
|
||||
FSect.Enter;
|
||||
end;
|
||||
|
||||
procedure TjobQueue.LeaveCriticalSection;
|
||||
begin
|
||||
if Assigned(FSect) and UseThreads then
|
||||
FSect.Leave;
|
||||
end;
|
||||
|
||||
procedure TjobQueue.DoWaiting(E : Exception;TaskId : integer);
|
||||
var we : EWaiting;
|
||||
begin
|
||||
EnterCriticalSection;
|
||||
try
|
||||
we:=EWaiting(e);
|
||||
pAddWaiting(we.FLauncher,TaskId,we.FNewJob.Name);
|
||||
AddUniqueJob(we.FNewJob,we.FLauncher.FLauncher);
|
||||
finally
|
||||
LeaveCriticalSection;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TjobQueue.pAddWaiting(aJob: TJob; aTask: integer; JobId: String);
|
||||
begin
|
||||
Waitings.AddObject(JobId,TRestartTask.Create(aJob,aTask));
|
||||
end;
|
||||
|
||||
procedure TjobQueue.pTaskStarted(aJob: TJob; aTask: integer);
|
||||
begin
|
||||
aJob.pTaskStarted(aTask);
|
||||
end;
|
||||
|
||||
procedure TjobQueue.pJobCompleted(var aJob: TJob);
|
||||
Begin
|
||||
pNotifyWaitings(aJob);
|
||||
if FuseThreads then
|
||||
Begin
|
||||
Jobs.Remove(aJob);
|
||||
aJob:=nil;
|
||||
end
|
||||
else
|
||||
FreeAndNil(aJob);
|
||||
end;
|
||||
|
||||
procedure TjobQueue.pTaskEnded(var aJob: TJob; aTask: integer; aExcept: Exception);
|
||||
begin
|
||||
aJob.pTaskEnded(aTask,aExcept);
|
||||
if (aJob.pGetTask=ALL_TASK_COMPLETED) then
|
||||
Begin
|
||||
pJobcompleted(aJob);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TjobQueue.pGetJob(out TaskId : integer;out Restart : boolean): TJob;
|
||||
var iJob : integer;
|
||||
aJob : TJob;
|
||||
begin
|
||||
Restart:=false;
|
||||
Result:=nil;
|
||||
For iJob:=0 to pred(Jobs.Count) do
|
||||
Begin
|
||||
aJob:=TJob(Jobs[iJob]);
|
||||
if aJob.InheritsFrom(TRestartTask) then
|
||||
Begin
|
||||
result:=TRestartTask(aJob).FJob;
|
||||
TaskId:=TRestartTask(aJob).FTask;
|
||||
Restart:=true;
|
||||
Jobs.Delete(iJob);
|
||||
Exit;
|
||||
end;
|
||||
TaskId:=aJob.pGetTask;
|
||||
if (TaskId>NO_MORE_TASK) or (TaskId=ALL_TASK_COMPLETED) then
|
||||
Begin
|
||||
Result:=aJob;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
if not(assigned(result)) then
|
||||
TaskId:=NO_MORE_TASK;
|
||||
end;
|
||||
|
||||
function TjobQueue.pFindJobByName(const aName: string;ByLauncher: TObject): TJobArray;
|
||||
var iRes,i : integer;
|
||||
begin
|
||||
SetLength(result,Jobs.count);
|
||||
iRes:=0;
|
||||
For i:=0 to pred(Jobs.Count) do
|
||||
Begin
|
||||
if TJob(Jobs[i]).Name=aName then
|
||||
begin
|
||||
if (ByLauncher=nil) or (TJob(Jobs[i]).FLauncher=ByLauncher) then
|
||||
Begin
|
||||
Result[iRes]:=TJob(Jobs[i]);
|
||||
inc(iRes);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
SetLength(result,iRes);
|
||||
end;
|
||||
|
||||
procedure TjobQueue.pNotifyWaitings(aJob: TJob);
|
||||
var JobId : String;
|
||||
ObjRestart : TRestartTask;
|
||||
idx : integer;
|
||||
begin
|
||||
JobId:=aJob.Name;
|
||||
Repeat
|
||||
idx:=waitings.IndexOf(JobId);
|
||||
if idx<>-1 then
|
||||
Begin
|
||||
ObjRestart:=TRestartTask(waitings.Objects[idx]);
|
||||
waitings.Delete(idx);
|
||||
Jobs.Add(ObjRestart);
|
||||
end;
|
||||
until idx=-1;
|
||||
end;
|
||||
|
||||
function TjobQueue.IsMainThread: boolean;
|
||||
begin
|
||||
Result:=GetCurrentThreadId=FMainThreadID;
|
||||
end;
|
||||
|
||||
constructor TjobQueue.Create(NbThread: integer);
|
||||
begin
|
||||
waitings:=TStringList.create;
|
||||
FNbThread:=NbThread;
|
||||
FMainThreadId:=GetCurrentThreadId;
|
||||
end;
|
||||
|
||||
destructor TjobQueue.Destroy;
|
||||
begin
|
||||
FreeThreads;
|
||||
ClearWaitings;
|
||||
FreeAndNil(Waitings);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TjobQueue.QueueAsyncCall(const AMethod: TDataEvent; Data: PtrInt);
|
||||
begin
|
||||
if UseThreads then
|
||||
Application.QueueAsyncCall(aMethod,Data)
|
||||
else
|
||||
AMethod(Data);
|
||||
end;
|
||||
|
||||
|
||||
Type
|
||||
|
||||
{ TSyncCallData }
|
||||
|
||||
TSyncCallData = Class
|
||||
private
|
||||
FMethod : TDataEvent;
|
||||
FData : PtrInt;
|
||||
public
|
||||
Constructor Create(AMethod : TDataEvent;AData : PtrInt);
|
||||
Procedure SyncCall;
|
||||
End;
|
||||
|
||||
{ TSyncCallData }
|
||||
|
||||
constructor TSyncCallData.Create(AMethod: TDataEvent; AData: PtrInt);
|
||||
begin
|
||||
FMethod:=AMethod;
|
||||
FData:=AData;
|
||||
|
||||
end;
|
||||
|
||||
procedure TSyncCallData.SyncCall;
|
||||
begin
|
||||
FMethod(FData);
|
||||
end;
|
||||
|
||||
procedure TjobQueue.QueueSyncCall(const AMethod: TDataEvent; Data: PtrInt);
|
||||
var tmp : TSyncCallData;
|
||||
begin
|
||||
tmp := TSyncCallData.Create(AMethod,Data);
|
||||
Try
|
||||
TThread.Synchronize(nil,@tmp.SyncCall);
|
||||
finally
|
||||
tmp.free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TjobQueue.AddJob(aJob: TJob;Launcher : TObject);
|
||||
var TaskId : Integer;
|
||||
restart : boolean;
|
||||
begin
|
||||
aJob.FLauncher:=Launcher;
|
||||
aJob.Queue:=self;
|
||||
if Usethreads then
|
||||
Begin
|
||||
EnterCriticalSection;
|
||||
Try
|
||||
Jobs.add(aJob);
|
||||
finally
|
||||
LeaveCriticalSection;
|
||||
end;
|
||||
FEvent.SetEvent;
|
||||
end
|
||||
Else
|
||||
Begin
|
||||
Try
|
||||
Repeat
|
||||
TaskId:=aJob.pGetTask;
|
||||
restart:=false;
|
||||
if TaskId>NO_MORE_TASK then
|
||||
Begin
|
||||
pTaskStarted(aJob,TaskId);
|
||||
Try
|
||||
aJob.ExecuteTask(TaskId,restart);
|
||||
pTaskEnded(aJob,TaskId,nil);
|
||||
except
|
||||
on e : Exception do
|
||||
Begin
|
||||
if not(e.InheritsFrom(EWaiting)) then
|
||||
pTaskEnded(aJob,TaskId,e)
|
||||
else
|
||||
DoWaiting(e,TaskId);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
if not(Assigned(aJob)) then
|
||||
TaskId:=ALL_TASK_COMPLETED;
|
||||
until TaskId=ALL_TASK_COMPLETED;
|
||||
finally
|
||||
aJob.Free;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TjobQueue.AddUniqueJob(aJob: TJob; Launcher: TObject): boolean;
|
||||
var lst : TJobArray;
|
||||
begin
|
||||
Result:=true;
|
||||
if FUseThreads then
|
||||
Begin
|
||||
aJob.Queue:=self;
|
||||
aJob.FLauncher:=Launcher;
|
||||
EnterCriticalSection;
|
||||
Try
|
||||
lst:=pFindJobByName(aJob.Name,Launcher);
|
||||
if length(lst)=0 then
|
||||
Jobs.add(aJob)
|
||||
else
|
||||
Result:=false;
|
||||
finally
|
||||
LeaveCriticalSection;
|
||||
end;
|
||||
FEvent.SetEvent;;
|
||||
end
|
||||
Else
|
||||
AddJob(aJob,Launcher);
|
||||
end;
|
||||
|
||||
function TjobQueue.CancelAllJob(ByLauncher: TObject) : TJobArray;
|
||||
var i,iJob : integer;
|
||||
begin
|
||||
SetLength(Result,0);
|
||||
if FUseThreads then
|
||||
Begin
|
||||
EnterCriticalSection;
|
||||
Try
|
||||
SetLEngth(Result,Jobs.Count);
|
||||
iJob:=0;
|
||||
For i:=pred(Jobs.Count) downto 0 do
|
||||
Begin
|
||||
if (ByLauncher=nil) or (TJob(Jobs[i]).FLauncher=ByLauncher) then
|
||||
Begin
|
||||
TJob(Jobs[i]).Cancel;
|
||||
Result[iJob]:=TJob(Jobs[i]);
|
||||
iJob+=1;
|
||||
End;
|
||||
End;
|
||||
SetLength(Result,iJob);
|
||||
finally
|
||||
LeaveCriticalSection;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TjobQueue.CancelJobByName(aJobName: String;ByLauncher: TObject) : boolean;
|
||||
var lst : TJobArray;
|
||||
i : integer;
|
||||
begin
|
||||
Result:=false;
|
||||
if FUseThreads then
|
||||
Begin
|
||||
EnterCriticalSection;
|
||||
Try
|
||||
lst:=pFindJobByName(aJobName,ByLauncher);
|
||||
For i:=low(lst) to high(lst) do
|
||||
Begin
|
||||
result:=true;
|
||||
lst[i].Cancel;
|
||||
End;
|
||||
finally
|
||||
LeaveCriticalSection;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TjobQueue.WaitForTerminate(const lstJob: TJobArray);
|
||||
var OneFound : Boolean;
|
||||
i : integer;
|
||||
mThread : Boolean;
|
||||
TimeOut : integer;
|
||||
begin
|
||||
TimeOut:=0;
|
||||
mThread:=IsMainThread;
|
||||
if FUseThreads then
|
||||
Begin
|
||||
repeat
|
||||
OneFound:=False;
|
||||
EnterCriticalSection;
|
||||
Try
|
||||
For i:=low(lstJob) to high(lstJob) do
|
||||
Begin
|
||||
if Jobs.IndexOf(lstJob[i])<>-1 then
|
||||
Begin
|
||||
OneFound:=True;
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
LeaveCriticalSection;
|
||||
end;
|
||||
if OneFound and (TimeOut>200) then
|
||||
Raise Exception.Create('TimeOut');
|
||||
if mThread then
|
||||
Application.ProcessMessages;
|
||||
if OneFound then
|
||||
Sleep(100);
|
||||
Inc(TimeOut);
|
||||
until not(OneFound);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TjobQueue.WaitAllJobTerminated(ByLauncher: TObject);
|
||||
var OneFound : boolean;
|
||||
i : integer;
|
||||
TimeOut : integer;
|
||||
mThread : Boolean;
|
||||
|
||||
Procedure CheckTimeOut;
|
||||
Begin
|
||||
if TimeOut>200 then
|
||||
Raise Exception.Create('TimeOut');
|
||||
if mThread then
|
||||
Application.ProcessMessages;
|
||||
sleep(100);
|
||||
inc(TimeOut);
|
||||
end;
|
||||
|
||||
begin
|
||||
TimeOut:=0;
|
||||
if FUseThreads then
|
||||
Begin
|
||||
mThread:=IsMainThread;
|
||||
if ByLauncher=nil then
|
||||
Begin
|
||||
While Jobs.Count>0 do
|
||||
CheckTimeOut;
|
||||
end
|
||||
else
|
||||
Begin
|
||||
repeat
|
||||
OneFound:=False;
|
||||
EnterCriticalSection;
|
||||
Try
|
||||
For i:=0 to pred(Jobs.Count) do
|
||||
Begin
|
||||
if TJob(Jobs[i]).FLauncher=ByLauncher then
|
||||
Begin
|
||||
OneFound:=True;
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
LeaveCriticalSection;
|
||||
end;
|
||||
if OneFound then
|
||||
CheckTimeOut;
|
||||
until not(OneFound);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TjobQueue }
|
||||
|
||||
procedure TJob.Cancel;
|
||||
var lst : Array of TRestartTask;
|
||||
i,idx : integer;
|
||||
begin
|
||||
Queue.EnterCriticalSection;
|
||||
Try
|
||||
FCancelled := true;
|
||||
if (Name<>'') and (Queue.waitings.count>0) then
|
||||
Begin
|
||||
SetLength(lst,0);
|
||||
Repeat
|
||||
idx:=Queue.waitings.IndexOf(Name);
|
||||
if idx<>-1 then
|
||||
Begin
|
||||
SetLength(lst,length(lst)+1);
|
||||
lst[high(lst)]:=TRestartTask(Queue.waitings.Objects[idx]);
|
||||
Queue.waitings.Delete(idx);
|
||||
end;
|
||||
until idx=-1;
|
||||
For i:=low(lst) to high(lst) do
|
||||
Begin
|
||||
lst[i].Cancel;
|
||||
lst[i].pTaskEnded(1,nil);
|
||||
lst[i].Free;
|
||||
end;
|
||||
end;
|
||||
DoCancel;
|
||||
finally
|
||||
Queue.LeaveCriticalSection;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJob.DoCancel;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
function TJob.pGetTask: integer;
|
||||
begin
|
||||
result:=ALL_TASK_COMPLETED;
|
||||
end;
|
||||
|
||||
procedure TJob.WaitForResultOf(aJob: TJob);
|
||||
begin
|
||||
Raise EWaiting.Create(self,aJob);
|
||||
end;
|
||||
|
||||
procedure TJob.EnterCriticalSection;
|
||||
begin
|
||||
Queue.EnterCriticalSection;
|
||||
end;
|
||||
|
||||
procedure TJob.LeaveCriticalSection;
|
||||
begin
|
||||
Queue.LeaveCriticalSection;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user