7
7
Author : Kike Pérez
8
8
Version : 1.5
9
9
Created : 09/03/2018
10
- Modified : 08/02 /2021
10
+ Modified : 08/03 /2021
11
11
12
12
This file is part of QuickLib: https://github.com/exilon/QuickLib
13
13
@@ -595,12 +595,29 @@ TBackgroundWorkers = class
595
595
private
596
596
fWorkerPool : TWorkerPool;
597
597
fConcurrentWorkers : Integer;
598
- fWorkerTask : IWorkTask;
598
+ fWorkerInitProc : TTaskProc;
599
+ fWorkerExecuteProc : TTaskProc;
600
+ fWorkerRetryProc : TTaskRetryProc;
601
+ fWorkerExceptionProc : TTaskExceptionProc;
602
+ fWorkerTerminateProc : TTaskProc;
603
+ fMaxRetries : Integer;
604
+ fFaultPolicy : TFaultPolicy;
605
+ procedure SetRetryPolicy (aMaxRetries, aWaitTimeBetweenRetriesMS : Integer; aWaitTimeMultiplierFactor: Double);
599
606
public
600
- constructor Create(aConcurrentWorkers : Integer);
607
+ constructor Create(aConcurrentWorkers : Integer; aWorkerProc : TTaskProc );
601
608
destructor Destroy; override;
602
609
property ConcurrentWorkers : Integer read fConcurrentWorkers;
603
- function OnExecute (aWorkerProc : TTaskProc) : IWorkTask;
610
+ function OnInitialize (aTaskProc : TTaskProc) : TBackgroundWorkers;
611
+ function OnException (aTaskProc : TTaskExceptionProc) : TBackgroundWorkers;
612
+ function OnRetry (aTaskProc : TTaskRetryProc) : TBackgroundWorkers;
613
+ function OnTerminated (aTaskProc : TTaskProc) : TBackgroundWorkers;
614
+ function Retry (aMaxRetries : Integer) : TBackgroundWorkers;
615
+ function RetryForever : TBackgroundWorkers;
616
+ function WaitAndRetry (aMaxRetries, aWaitTimeBetweenRetriesMS : Integer) : TBackgroundWorkers; overload;
617
+ function WaitAndRetry (aWaitTimeArray : TArray<Integer>) : TBackgroundWorkers; overload;
618
+ function WaitAndRetry (aMaxRetries, aWaitTimeBetweenRetriesMS : Integer; aWaitTimeMultiplierFactor : Double) : TBackgroundWorkers; overload;
619
+ function WaitAndRetryForever (aWaitTimeBetweenRetriesMS : Integer) : TBackgroundWorkers; overload;
620
+ function WaitAndRetryForever (aWaitTimeBetweenRetriesMS : Integer; aWaitTimeMultiplierFactor : Double) : TBackgroundWorkers; overload;
604
621
procedure Start ;
605
622
procedure Stop ;
606
623
end ;
@@ -1616,13 +1633,13 @@ procedure TSimpleWorker.Execute;
1616
1633
end ;
1617
1634
finally
1618
1635
fStatus := TWorkerStatus.wsIdle;
1619
- if fRunOnce then Terminate;
1620
1636
try
1621
1637
if TTask(fCurrentTask).TerminateWithSync then Synchronize(TerminateTask)
1622
1638
else fCurrentTask.DoTerminate;
1623
1639
except
1624
1640
on E : Exception do if fCurrentTask <> nil then fCurrentTask.DoException(E)
1625
1641
end ;
1642
+ if fRunOnce then Terminate;
1626
1643
end ;
1627
1644
end ;
1628
1645
fStatus := TWorkerStatus.wsSuspended
@@ -2331,9 +2348,11 @@ destructor TParamValue.Destroy;
2331
2348
2332
2349
{ TBackgroundWorkers }
2333
2350
2334
- constructor TBackgroundWorkers.Create(aConcurrentWorkers: Integer);
2351
+ constructor TBackgroundWorkers.Create(aConcurrentWorkers : Integer; aWorkerProc : TTaskProc );
2335
2352
begin
2336
2353
fConcurrentWorkers := aConcurrentWorkers;
2354
+ fWorkerExecuteProc := aWorkerProc;
2355
+ fWorkerPool := TWorkerPool.Create(True);
2337
2356
end ;
2338
2357
2339
2358
destructor TBackgroundWorkers.Destroy;
@@ -2342,25 +2361,23 @@ destructor TBackgroundWorkers.Destroy;
2342
2361
inherited ;
2343
2362
end ;
2344
2363
2345
- function TBackgroundWorkers.OnExecute (aWorkerProc: TTaskProc): IWorkTask;
2346
- begin
2347
- // fWorkerTask := TWorkTask.Create([],False,procedure(task : ITask)
2348
- // begin
2349
- // aWorkerProc;
2350
- // end);
2351
- fWorkerTask := TWorkTask.Create([],False,aWorkerProc);
2352
- fWorkerTask.Run;
2353
- Result := fWorkerTask;
2354
- end ;
2355
-
2356
2364
procedure TBackgroundWorkers.Start ;
2357
2365
var
2358
2366
i : Integer;
2359
2367
worker : TWorker;
2368
+ task : IWorkTask;
2360
2369
begin
2361
2370
for i := 1 to fConcurrentWorkers do
2362
2371
begin
2363
- worker := TSimpleWorker.Create(fWorkerTask,False);
2372
+ task := TWorkTask.Create([],False,fWorkerExecuteProc)
2373
+ .OnInitialize(fWorkerInitProc)
2374
+ .OnRetry(fWorkerRetryProc)
2375
+ .OnException(fWorkerExceptionProc)
2376
+ .OnTerminated(fWorkerTerminateProc);
2377
+ task.NumWorker := i;
2378
+ task.Run;
2379
+ worker := TSimpleWorker.Create(task,False);
2380
+ fWorkerPool.Add(worker);
2364
2381
worker.Start;
2365
2382
end ;
2366
2383
end ;
@@ -2377,4 +2394,72 @@ procedure TBackgroundWorkers.Stop;
2377
2394
end ;
2378
2395
end ;
2379
2396
2397
+ function TBackgroundWorkers.OnException (aTaskProc: TTaskExceptionProc): TBackgroundWorkers;
2398
+ begin
2399
+ Result := Self;
2400
+ fWorkerExceptionProc := aTaskProc;
2401
+ end ;
2402
+
2403
+ function TBackgroundWorkers.OnInitialize (aTaskProc: TTaskProc): TBackgroundWorkers;
2404
+ begin
2405
+ Result := Self;
2406
+ fWorkerInitProc := aTaskProc;
2407
+ end ;
2408
+
2409
+ function TBackgroundWorkers.OnRetry (aTaskProc: TTaskRetryProc): TBackgroundWorkers;
2410
+ begin
2411
+ Result := Self;
2412
+ fWorkerRetryProc := aTaskProc;
2413
+ end ;
2414
+
2415
+ function TBackgroundWorkers.OnTerminated (aTaskProc: TTaskProc): TBackgroundWorkers;
2416
+ begin
2417
+ Result := Self;
2418
+ fWorkerTerminateProc := aTaskProc;
2419
+ end ;
2420
+
2421
+ function TBackgroundWorkers.Retry (aMaxRetries: Integer): TBackgroundWorkers;
2422
+ begin
2423
+ Result := Self;
2424
+ SetRetryPolicy(aMaxRetries,0 ,1 );
2425
+ end ;
2426
+
2427
+ function TBackgroundWorkers.RetryForever : TBackgroundWorkers;
2428
+ begin
2429
+ Result := Self;
2430
+ SetRetryPolicy(-1 ,0 ,1 );
2431
+ end ;
2432
+
2433
+ procedure TBackgroundWorkers.SetRetryPolicy (aMaxRetries, aWaitTimeBetweenRetriesMS: Integer; aWaitTimeMultiplierFactor: Double);
2434
+ begin
2435
+ fFaultPolicy.MaxRetries := aMaxRetries;
2436
+ fFaultPolicy.WaitTimeBetweenRetries := aWaitTimeBetweenRetriesMS;
2437
+ fFaultPolicy.WaitTimeMultiplierFactor := aWaitTimeMultiplierFactor;
2438
+ end ;
2439
+
2440
+ function TBackgroundWorkers.WaitAndRetry (aMaxRetries, aWaitTimeBetweenRetriesMS: Integer; aWaitTimeMultiplierFactor: Double): TBackgroundWorkers;
2441
+ begin
2442
+
2443
+ end ;
2444
+
2445
+ function TBackgroundWorkers.WaitAndRetry (aWaitTimeArray: TArray<Integer>): TBackgroundWorkers;
2446
+ begin
2447
+
2448
+ end ;
2449
+
2450
+ function TBackgroundWorkers.WaitAndRetry (aMaxRetries, aWaitTimeBetweenRetriesMS: Integer): TBackgroundWorkers;
2451
+ begin
2452
+
2453
+ end ;
2454
+
2455
+ function TBackgroundWorkers.WaitAndRetryForever (aWaitTimeBetweenRetriesMS: Integer): TBackgroundWorkers;
2456
+ begin
2457
+
2458
+ end ;
2459
+
2460
+ function TBackgroundWorkers.WaitAndRetryForever (aWaitTimeBetweenRetriesMS: Integer; aWaitTimeMultiplierFactor: Double): TBackgroundWorkers;
2461
+ begin
2462
+
2463
+ end ;
2464
+
2380
2465
end .
0 commit comments