异步任务调度

异步任务调度
适用于DELPHI2009及以上版本，支持跨操作系统。

/// <author>cxg 2020-7-13</author>
/// 异步任务调度
{使用:
procedure TForm1.Button1Click(Sender: TObject);
begin
  var task: TMsgPack := TMsgPack.Create;
  task.Force('f1').AsString := '测试';
  var queue: TTaskQueue := TTaskQueue.Create;
  queue.enQueue(task);
  var tasks: TThreadCfg := TThreadCfg.Create(1, queue,
    procedure(task: TMsgPack)
    begin
      ShowMessage(task.Force('f1').AsString);
      tasks.Free;
    end);
end;
}
unit tasks;

interface

uses
  {$IFDEF  mswindows}
  Winapi.Windows,
  {$ENDIF}

{$IFDEF posix}
posix.Unistd,
{$ENDIF}

  System.SyncObjs, System.Classes, System.SysUtils, System.Generics.Collections,
  MsgPack;

type
  TCallBack = reference to procedure(task: TMsgPack);

type
  TTaskQueue = class   //任务队列（线程安全）
  private
    fQueue: TQueue<TMsgPack>;
    fCS: TCriticalSection;
  public
    constructor Create;
    destructor Destroy; override;
    procedure enQueue(task: TMsgPack);
    function deQueue: TMsgPack;
  end;

type
  TThreadCfg = class     //管理 工作线程
  private
    fQueue: TTaskQueue;
    fCallBack: TCallBack;
    fThreadNum: Integer;
    fWorkers: array of TThread;
  public
    constructor Create(const threadNum: Integer; const queue: TTaskQueue; CallbackEvent: TCallBack);
    destructor Destroy; override;
  end;

type
  TWorkThread = class(TThread)  //工作线程
  private
    fConfig: TThreadCfg;
  public
    constructor Create(cfg: TThreadCfg);
    destructor Destroy; override;
    procedure Execute; override;
  end;

implementation

function GetCPUNum: Integer;
{$IFDEF MSWINDOWS}
var
  si: SYSTEM_INFO;
{$ENDIF}
begin
  {$IFDEF MSWINDOWS}
  GetSystemInfo(si);
  Result := si.dwNumberOfProcessors;
  {$ELSE}// Linux,MacOS,iOS,Andriod{POSIX}
  {$IFDEF POSIX}
  Result := sysconf(_SC_NPROCESSORS_ONLN);
  {$ELSE}// unkown system, default 1
  Result := 5;
  {$ENDIF POSIX}
  {$ENDIF MSWINDOWS}
end;

{ TTaskQueue }

constructor TTaskQueue.Create;
begin
  fQueue := TQueue<TMsgPack>.Create;
  fCS := TCriticalSection.Create;
end;

destructor TTaskQueue.Destroy;
begin
  FreeAndNil(fQueue);
  FreeAndNil(fCS);
  inherited;
end;

procedure TTaskQueue.enQueue(task: TMsgPack);
begin
  fCS.Enter;
  fQueue.Enqueue(task);
  fCS.Leave;
end;

function TTaskQueue.deQueue: TMsgPack;
begin
  fCS.Enter;
  Result := fQueue.Dequeue;
  fCS.Leave;
end;

{ TWorkThread }

constructor TWorkThread.Create(cfg: TThreadCfg);
begin
  inherited Create(True);
  FreeOnTerminate := true;
  fConfig := cfg;
end;

destructor TWorkThread.Destroy;
begin

  inherited;
end;

procedure TWorkThread.Execute;
begin
  while not Self.Terminated do
  begin
    if fConfig.fQueue.fQueue.Count > 0 then
    begin
      var task: TMsgPack := fConfig.fQueue.deQueue;
      if Assigned(fConfig.fCallBack) then
      begin
        fConfig.fCallBack(task);
        task.Free;    //释放
      end;
    end;
    Sleep(1);
    {$IFDEF MSWINDOWS}
    SwitchToThread;
    {$ELSE}
    TThread.Yield;
    {$ENDIF}
  end;
end;

{ TThreadCfg }

constructor TThreadCfg.Create(const threadNum: Integer; const queue: TTaskQueue; CallbackEvent: TCallBack);
begin
  fThreadNum := threadNum;
  fQueue := queue;
  fCallBack := CallbackEvent;
  if fThreadNum = 0 then
    fThreadNum := GetCPUNum;
  SetLength(fWorkers, fThreadNum);
  for var i: Integer := 0 to fThreadNum - 1 do
  begin
    fWorkers[i] := TWorkThread.Create(Self);
    fWorkers[i].Start;
  end;
end;

destructor TThreadCfg.Destroy;
begin
  for var i: Integer := 0 to fThreadNum - 1 do  //停止并释放工作线程
  begin
    fWorkers[i].Terminate;
    fWorkers[i].WaitFor;
    fWorkers[i].Free;
  end;
  fQueue.Free;       //释放队列
  inherited;
end;

end.