Advertisement
sglienke

ThreadingEx

Feb 24th, 2015
331
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. unit ThreadingEx;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils,
  7.   Threading;
  8.  
  9. type
  10.   TAction<T> = reference to procedure(const arg: T);
  11.  
  12.   TTaskContinuationOptions = (
  13.     NotOnCompleted,
  14.     NotOnFaulted,
  15.     NotOnCanceled,
  16.     OnlyOnCompleted,
  17.     OnlyOnFaulted,
  18.     OnlyOnCanceled
  19.   );
  20.  
  21.   ITaskEx = interface(ITask)
  22.     ['{3AE1A614-27AA-4B5A-BC50-42483650E20D}']
  23.     function GetExceptObj: Exception;
  24.     function GetStatus: TTaskStatus;
  25.     function ContinueWith(const continuationAction: TAction<ITaskEx>;
  26.       continuationOptions: TTaskContinuationOptions): ITaskEx;
  27.     function ContinueWithGui(const continuationAction: TAction<ITaskEx>;
  28.       continuationOptions: TTaskContinuationOptions): ITaskEx;
  29.     property ExceptObj: Exception read GetExceptObj;
  30.     property Status: TTaskStatus read GetStatus;
  31.   end;
  32.  
  33.   TTaskEx = class(TTask, ITaskEx)
  34.   private
  35.     fExceptObj: Exception;
  36.     function GetExceptObj: Exception;
  37.     function InternalContinueWith(const continuationAction: TAction<ITaskEx>;
  38.       continuationOptions: TTaskContinuationOptions;
  39.       invokeInMainThread: Boolean): ITaskEx;
  40.   protected
  41.     function ContinueWith(const continuationAction: TAction<ITaskEx>;
  42.       continuationOptions: TTaskContinuationOptions): ITaskEx;
  43.     function ContinueWithGui(const continuationAction: TAction<ITaskEx>;
  44.       continuationOptions: TTaskContinuationOptions): ITaskEx;
  45.   public
  46.     destructor Destroy; override;
  47.     class function Run(const action: TProc): ITaskEx; static;
  48.   end;
  49.  
  50. implementation
  51.  
  52. uses
  53.   Classes;
  54.  
  55. { TTaskEx }
  56.  
  57. function TTaskEx.ContinueWith(const continuationAction: TAction<ITaskEx>;
  58.   continuationOptions: TTaskContinuationOptions): ITaskEx;
  59. begin
  60.   Result := InternalContinueWith(continuationAction, continuationOptions, False);
  61. end;
  62.  
  63. function TTaskEx.ContinueWithGui(const continuationAction: TAction<ITaskEx>;
  64.   continuationOptions: TTaskContinuationOptions): ITaskEx;
  65. begin
  66.   Result := InternalContinueWith(continuationAction, continuationOptions, True);
  67. end;
  68.  
  69. destructor TTaskEx.Destroy;
  70. begin
  71.   fExceptObj.Free;
  72.   inherited;
  73. end;
  74.  
  75. function TTaskEx.GetExceptObj: Exception;
  76. begin
  77.   if (fExceptObj is EAggregateException)
  78.     and (EAggregateException(fExceptObj).Count = 1) then
  79.     Result := EAggregateException(fExceptObj)[0]
  80.   else
  81.     Result := fExceptObj;
  82. end;
  83.  
  84. function TTaskEx.InternalContinueWith(
  85.   const continuationAction: TAction<ITaskEx>;
  86.   continuationOptions: TTaskContinuationOptions;
  87.   invokeInMainThread: Boolean): ITaskEx;
  88. begin
  89.   Result := TTaskEx.Run(
  90.     procedure
  91.     var
  92.       task: ITaskEx;
  93.       doContinue: Boolean;
  94.     begin
  95.       task := Self;
  96.       if not IsComplete then
  97.         DoneEvent.WaitFor;
  98.       fExceptObj := GetExceptionObject;
  99.       case continuationOptions of
  100.         NotOnCompleted:  doContinue := GetStatus <> TTaskStatus.Completed;
  101.         NotOnFaulted:    doContinue := GetStatus <> TTaskStatus.Exception;
  102.         NotOnCanceled:   doContinue := GetStatus <> TTaskStatus.Canceled;
  103.         OnlyOnCompleted: doContinue := GetStatus = TTaskStatus.Completed;
  104.         OnlyOnFaulted:   doContinue := GetStatus = TTaskStatus.Exception;
  105.         OnlyOnCanceled:  doContinue := GetStatus = TTaskStatus.Canceled;
  106.       else
  107.         doContinue := False;
  108.       end;
  109.       if doContinue then
  110.         if invokeInMainThread then
  111.           TThread.Queue(nil,
  112.             procedure
  113.             begin
  114.               continuationAction(task);
  115.             end)
  116.         else
  117.           continuationAction(task);
  118.     end);
  119. end;
  120.  
  121. class function TTaskEx.Run(const action: TProc): ITaskEx;
  122. var
  123.   task: TTaskEx;
  124. begin
  125.   task := TTaskEx.Create(nil, TNotifyEvent(nil), action, TThreadPool.Default, nil);
  126.   Result := task.Start as ITaskEx;
  127. end;
  128.  
  129. end.
Advertisement
RAW Paste Data Copied
Advertisement