线程池任务队列

http://blog.csdn.net/fengsh998/article/details/8007009

unit uPool;

{***********************************************************************

                       线程池+任务队列

         整个线程池调度图
         ==========================================================
         |  -----   ----------------------                         |
         |  |空 |   | 任务队列   ←----    | ⑴                     |
         |  |闲 |   ----------------------                         |
         |  |线 |     ↑空闲线程检查队列是否有任务                  |
         |  |程 |--①-- 有任务要执行时,加入到工作队列              |
         |  |队 |            |                                     |
         |  |列 |            ↓②               ----------------    |
         |  |   |   -----------------------    |  自动回收空   |   |
         |  |   |   |正在工作队列          |   |  闲定时器     |   |
         |  |   |   -----------------------    ----------------    |
         |  |   |     ③     | 任务做完后              |           |
         |  ----- ←----------| 调度到空闲队列          |           |
         |    |                                        |           |
         |    -----------------------------------------|           |
         |             ④定时回收空闲线程                          |
         |                                                         |
         ==========================================================

         使用方法：

         pool = TThreadPool.Create;
         pool.MinNums := 2; //最小线程
         pool.MaxNums := 6; //最大线程
         pool.TasksCacheSize := 10; //任务缓冲队列

         上面创建好之后，就可以往池中放任务

         pool.AddWorkTask(Task);

         线程池就开始工作了。
         同时线程池支持对任务进行优先级排序，排序算法默认
         为快速序，也可以外问进行队列排序

         这里把任务和池分开了。
         使用任务时，需要继承TWorkTask进开自己的任务设计。
         然后重写exectask;方法。如果方法中要进行毫时循环，
         请见如下例子；
         for i := 0 to 5000 do
          begin
            if tk.WorkState = tsFinished then break;
              inc(k);
              //caption := inttostr(k);
            edit2.Text := inttostr(k);
          end;

         如：TWirteFileTask = Class(TWorkTask);


        9-23:
        修正BUG
          1.在设置MIN时多创建了线程。
          2.定时回收机制BUG。
          3.外部处理预任务时线程不能自增。

        作者：边缘
        @RightCopy fsh
        QQ: 19985430
        date: 2012-09-22
        Email:fengsh998@163.com
***********************************************************************}

interface

uses
    Classes,Windows,SysUtils,Messages,SyncObjs;

Const
    PRE_NUM = 5;
    MAX_NUM = 100;
    AUTO_FREE = 2;
    MAX_TASKNUM = 100;
    ONEMINUTE = 10000;//60000;

  type
    TLogLevel = (lDebug,lInfo,lError);

    ILog = interface
      procedure WriteLog(Const Msg:String;Level:TLogLevel = lDebug);
    end;

    TPoolLog = Class(TInterfacedObject,ILog)
       private
          procedure WriteLog(Const Msg:String;Level:TLogLevel = lDebug);
       public
          procedure OutputLog(Const Msg:String;Level:TLogLevel);virtual;
    End;

    TPoolException = class(Exception)

    end;

    Thandles = Array of Cardinal;

    //任务级别  优先级高的任务先执行。
    TTaskLevel = (tlLower,tlNormal,tlHigh);
    TTaskState = (tsNone,tsDoing,tsWaiting,tsReStart,tsStop,tsFinished);
    TWorkTask = Class
       private
          Work:TThread;
          //任务ID
          hTask:TCriticalSection;
          FWorkId:Cardinal;
          FWorkName:String;
          FWorkLevel:TTaskLevel; //默认为普通
          FWorkState : TTaskState;
          procedure setWorkState(Const Value:TTaskState);
       public
          Constructor Create;
          Destructor Destroy;override;
          procedure execTask;virtual; abstract;
          property WorkId:Cardinal read FWorkId write FWorkId;
          property WorkName:String read FWorkName write FWorkName;
          property WorkLevel:TTaskLevel read FWorkLevel write FWorkLevel;
          property WorkState : TTaskState read FWorkState write setWorkState;
    End;

    TWorkTaskQueue = Array of TWorkTask;
    
    TThreadPool = Class;

    TWorkThreadState = (wtIdle,wtRunning,wtStop,wtFinished);
    //工作线程(单个线程一次只能处理一个task)
    TWorkThread = Class(TThread)
      private
        FPool:TThreadPool;
        FState:TWorkThreadState;
        procedure SetDefault;
      protected
        procedure Execute;override;
      public
        Constructor Create(Const pool:TThreadPool);
        property State : TWorkThreadState read FState write FState;
    End;

    TWorkThreadQueue = Array of TWorkThread;

    //查看缓冲情况事件
    TListenCacheInfoEvent = procedure (Sender:TObject;Const IdleCount,BusyCount,TaskCount:Integer) of Object;
    TTaskQueueFullEvent = procedure (Sender:TObject) of Object;
    //任务处理完后
    TTaskFinishedEvent = procedure (Const cTast:TWorkTask) of object;
    //任务准备被处理前事件
    TTaskWillDoBeforeEvent = procedure (Const thId:Cardinal;Const cTast:TWorkTask) of Object;
    //外部排序任务队列算法，默认为快速排序，可自行在外部定制算法。
    TSortTaskQueueEvent = procedure (Sender:TObject;var taskQueue:TWorkTaskQueue) of object;

    TThreadPool = Class
     private
       Log:TPoolLog;
       //自动回收标识
       FAuto:Boolean;
       //定时等待控制
       FWaitFlag:Boolean;
       //表示正在用于等待回收到的线程
       Waiting:TWorkThread;
       //提取任务通知信号
       entTaskNotify:Tevent;
       //时间事件HANDLE
       hTimeJump:Cardinal;
       //是否排序任务队列
       FSorted:Boolean;
       //对空闲队列操作锁
       hIDleLock:TCriticalSection;
       //对正在进行的线程锁
       hBusyLock:TCriticalSection;
       //任务队列锁
       hTaskLock:TCriticalSection;
       //预设线程数 默认为5 发现忙不过来时才进行自增直到Max
       FMinNums:Integer;
       //最大限制线程数，默认为100
       FMaxNums:Integer;
       //任务队列缓冲大小 默认100
       FTasksCache:Integer;
       //当线程空闲时间长达XX时自动回收 :单位为分钟
       FRecoverInterval:Integer;
       //是否允许队列中存在重复任务 (同一任务时要考虑线程同步),默认为否
       FIsAllowTheSameTask:Boolean;
       //任务队列 (不释放外部任务) 最大100个任务。当大于100个任务时，需要等待
       //每抽取一个任务，立即从队列中删除。
       TaskQueue:TWorkTaskQueue;
       //工作线程
       BusyQueue:TWorkThreadQueue;
       //空闲线程
       IdleQueue:TWorkThreadQueue;

       //************************事件回调**********************//
       //排序队列回调
       FOnSortTask:TSortTaskQueueEvent;
       FOnTaskWillDo:TTaskWillDoBeforeEvent;
       FOnTaskFinished:TTaskFinishedEvent;
       FOnTaskFull:TTaskQueueFullEvent;
       FOnListenInfo:TListenCacheInfoEvent;
       //*****************************************************//
       
       //************************Get/Set操作*******************//
       procedure SetMinNums(Const Value:Integer);
       procedure SetMaxNums(Const Value:Integer);
       function getTaskQueueCount: Integer;
       function getBusyQueueCount: Integer;
       function getIdleQueueCount: Integer;
       //*****************************************************//

       //***********************同步量处理********************//
       procedure CreateLock;
       procedure FreeLock;
       //*****************************************************//

       //设置初值
       procedure SetDefault;
       //处理回调
       procedure DoTaskFull;

       //********************线程队列操作**********************//
       //清空线程队列
       procedure ClearQueue(var Queue:TWorkThreadQueue);
       //得到队列的长度
       function QueueSize(Const Queue:TWorkThreadQueue):Integer;
       //调整队列
       procedure DelQueueOfIndex(var Queue:TWorkThreadQueue;Const Index:Integer);
       //移动队列;
       procedure MoveQueue(Const wt:TWorkThread;flag:Integer);
       //移除某个线程
       procedure RemoveFromQueue(var Queue:TWorkThreadQueue;Const re:TWorkThread);
       //*****************************************************//

       //********************任务队列操作**********************//
       //排序队列将优先级高的排前面。//可以交给外问进行排序算法
       procedure SortTask(var Queue:TWorkTaskQueue);
       //调整队列
       procedure DelTaskOfIndex(var Queue:TWorkTaskQueue;Const Index:Integer);
       //获取队列大小
       function TaskSzie(Const Queue:TWorkTaskQueue):Integer;
       //*****************************************************//
       //查找任务(如果有好的算法，哪更高效)
       function FindTask(Const tsk:TWorkTask):Integer;
       //快速排序
       procedure QuikeSortTask(var Queue:TWorkTaskQueue;Const s,e:Integer);
       //自动回收空闲线程
       procedure RecoverIDle(Const wait:TWorkThread);
       //交换任务
       procedure switch(var Queue: TWorkTaskQueue; m, n: Integer);
       //判断当前运行线程是否使用在等待自动回收
       function WaitAutoRecover(Const curThread:TWorkThread):Boolean;
     protected
       //求最小值
       function Smaller(Const expresion:Boolean;Const tureValue,falseValue:Integer):Integer;
       //按照先进选出进行提取任务
       function PickupTask:TWorkTask;
       //创建空闲线程
       procedure CreateIdleThread(Const Nums:Integer = 1);
       //添加到空闲线程队列
       procedure AddThreadToIdleQueue(Const idle:TWorkThread);
       //添加到工作队列
       procedure AddThreadToBusyQueue(Const busy:TWorkThread);
       //发送新任务到达信号
       procedure PostNewTaskSign;
       
     public
       Constructor Create;
       Destructor Destroy;override;
       //***********************线程池管理方法******************************//
       //停止执行的任务
       procedure StopAll;
       //开始任务
       procedure StartAll;
       //清空任务
       procedure CleanTasks;
       //运行中不能进行对调
       function  SwitchTasks(Const aTask,bTask:TWorkTask):Boolean;
       //移除某个任务
       procedure RemoveTask(Const tk:TWorkTask);//只允许移除未执行的任务
       //需要外部定时调用来得到动态数据效果
       procedure ListenPool;
       //******************************************************************//
       //添加任务
       function AddWorkTask(Const wtask:TWorkTask):Integer;

       property MinNums:Integer read FMinNums write SetMinNums;
       property MaxNums:Integer read FMaxNums write SetMaxNums;
       property TasksCacheSize:Integer read FTasksCache write FTasksCache;
       property RecoverInterval:Integer read FRecoverInterval
                write FRecoverInterval;
       property IsAllowTheSameTask:Boolean read FIsAllowTheSameTask
                write FIsAllowTheSameTask;
       property Sorted:Boolean read FSorted write FSorted;
       property TaskQueueCount:Integer read getTaskQueueCount;
       property IdleQueueCount:Integer read getIdleQueueCount;
       property BusyQueueCount:Integer read getBusyQueueCount;
       property OnSortTask:TSortTaskQueueEvent read FOnSortTask write FOnSortTask;
       property OnTaskWillDo:TTaskWillDoBeforeEvent read FOnTaskWillDo write FOnTaskWillDo;
       property OnTaskFinished:TTaskFinishedEvent read FOnTaskFinished write FOnTaskFinished;
       property OnTaskFull:TTaskQueueFullEvent read FOnTaskFull write FOnTaskFull;
       property OnListenInfo:TListenCacheInfoEvent read FOnListenInfo write FOnListenInfo;
    End;

implementation

{ TThreadPool }

constructor TThreadPool.Create;
var
  tpError:Cardinal;
begin
   Log:=TPoolLog.Create;
   SetDefault;
   CreateLock;

   tpError := 0;

   entTaskNotify:=Tevent.create(nil,false,false, 'TaskNotify');//事件信号
   hTimeJump := CreateEvent(nil,False,False,'Timer');//自动回收心跳事件
   if hTimeJump = 0 then
       tpError := GetLastError;
       
   //the same name of sign exists.
   Case tpError of
     ERROR_ALREADY_EXISTS:
                       begin
                          hTimeJump := 0;
                          Log.WriteLog('CreateTimerEvent Fail,the Same Name of Event Exists');
                       end;
   End;
   //预创建线程
   CreateIdleThread(FMinNums);
   Log.WriteLog('Thread Pool start run.',lInfo);
end;

destructor TThreadPool.Destroy;
begin
   ClearQueue(IdleQueue);
   ClearQueue(BusyQueue);
   FreeLock;
   if hTimeJump > 0 then
      CloseHandle(hTimeJump);
   entTaskNotify.Free;
   Log.Free;
  inherited;
  Log.WriteLog('Thread Pool end run.',lInfo);
end;

procedure TThreadPool.DoTaskFull;
begin
   if Assigned(FOnTaskFull) then
      FOnTaskFull(self);
end;

procedure TThreadPool.SetDefault;
begin
   FMinNums := PRE_NUM;
   FMaxNums := MAX_NUM;
   FTasksCache := MAX_TASKNUM;
   FRecoverInterval := AUTO_FREE;
   FIsAllowTheSameTask := False;
   FAuto :=False;
   FWaitFlag := True;
   Waiting := nil;
   FSorted := False;
end;

procedure TThreadPool.CreateLock;
begin
   hIDleLock := TCriticalSection.Create;
   hBusyLock := TCriticalSection.Create;
   hTaskLock := TCriticalSection.Create;
end;

procedure TThreadPool.FreeLock;
begin
   hIDleLock.Free;
   hBusyLock.Free;
   hTaskLock.Free;
end;

function TThreadPool.getBusyQueueCount: Integer;
begin
   Result := QueueSize(BusyQueue);
end;

function TThreadPool.getIdleQueueCount: Integer;
begin
   Result := QueueSize(IdleQueue);
end;

function TThreadPool.getTaskQueueCount: Integer;
begin
   Result := TaskSzie(TaskQueue);
end;

procedure TThreadPool.CleanTasks;
begin
   hTaskLock.Enter;
   SetLength(TaskQueue,0);
   hTaskLock.Leave;
end;

procedure TThreadPool.ListenPool;
begin
   //正在执行任务的线程，空闲线程，队列中任务数
   if Assigned(FOnListenInfo) then
      FOnListenInfo(self,IdleQueueCount,BusyQueueCount,TaskQueueCount);
end;

procedure TThreadPool.ClearQueue(var Queue: TWorkThreadQueue);
var
   i:Integer;
   sc:Integer;
begin
   sc := Length(Queue);
   for i := 0 to sc - 1 do
   begin
       TWorkThread(Queue[i]).Terminate;
       PostNewTaskSign;
       //TWorkThread(Queue[i]).Free; //如果FreeOnTerminate为TRUE就不要使用这句了。
   end;
   SetLength(Queue,0);
end;

procedure TThreadPool.SetMaxNums(const Value: Integer);
begin
   if Value<FMinNums then
      //to do tips Error;
   else
      FMaxNums := Value;
end;

procedure TThreadPool.SetMinNums(const Value: Integer);
begin
   if value > FMaxNums then
      //to do tips Error;
   else if Value <= 0 then
      FMinNums := PRE_NUM
   else
      FMinNums := Value;
     
   ClearQueue(IDleQueue);
   CreateIdleThread(FMinNums);
   Log.WriteLog('Reset MinNums Numbers is ' + inttostr(FMinNums) + ' .',lInfo);
end;


function TThreadPool.Smaller(const expresion: Boolean; const tureValue,
  falseValue: Integer): Integer;
begin
   if expresion then
      result := tureValue
   else
      result := falseValue;
end;

procedure TThreadPool.DelQueueOfIndex(var Queue: TWorkThreadQueue;
  const Index: Integer);
var
   i:integer;
   ic:integer;
begin
   ic := Length(Queue);
   for i := Index to ic - 1 do
       Queue[i] := Queue[i+1];

   setLength(Queue,ic-1);
end;

procedure TThreadPool.DelTaskOfIndex(var Queue: TWorkTaskQueue;
  const Index: Integer);
var
   i:integer;
   ic:integer;
begin
   ic := length(Queue);
   for i := Index to ic -1 do
       Queue[i] := Queue[i+1];

   setLength(Queue,ic-1);
end;

procedure TThreadPool.MoveQueue(const wt: TWorkThread; flag: Integer);
var
    k:integer;
begin
   if flag = 0 then
   begin
     hIDleLock.Enter;
     for k := Low(IdleQueue) to High(IdleQueue) do
     begin
        if IdleQueue[k]=wt then
        begin
           AddThreadToBusyQueue(wt);
           DelQueueOfIndex(IdleQueue,k);
        end;
     end;
     hIDleLock.Leave;
   end
   else
   begin
     hBusyLock.Enter;
     for k := Low(BusyQueue) to High(BusyQueue) do
     begin
        if BusyQueue[k]=wt then
        begin
           AddThreadToIdleQueue(wt);
           DelQueueOfIndex(BusyQueue,k);
        end;
     end;
     hBusyLock.Leave;
   end;
end;

function TThreadPool.SwitchTasks(const aTask, bTask: TWorkTask): Boolean;
var
   aIndex,bIndex:Integer;
begin
   Result := true;
   hTaskLock.Enter;
   aIndex := FindTask(aTask);
   bIndex := FindTask(bTask);
   
   if (aIndex = -1) or (bIndex = -1) then
   begin
      Result := false;
      hTaskLock.Leave;
      exit;
   end;
   switch(TaskQueue,aIndex,bIndex);
   hTaskLock.Leave;
end;

function TThreadPool.TaskSzie(const Queue: TWorkTaskQueue): Integer;
begin
   Result := Length(Queue);
end;

function TThreadPool.WaitAutoRecover(const curThread: TWorkThread): Boolean;
begin
   Result := Waiting = curThread;
end;

procedure TThreadPool.CreateIdleThread(const Nums: Integer);
var
   WorkThread:TWorkThread;
   i:integer;
begin
   hIDleLock.Enter;
   for i := 0 to Nums - 1 do
   begin
     WorkThread := TWorkThread.Create(self);
     WorkThread.FreeOnTerminate := true;
     AddThreadToIdleQueue(WorkThread);
   end;
   hIDleLock.Leave;
end;

procedure TThreadPool.AddThreadToBusyQueue(const busy: TWorkThread);
var
   sz:integer;
begin
   sz := QueueSize(BusyQueue);
   setLength(BusyQueue,sz + 1);
   BusyQueue[sz] := busy;
end;

procedure TThreadPool.AddThreadToIdleQueue(const idle: TWorkThread);
var
   sz:integer;
begin
   sz := Length(IdleQueue);
   setLength(IdleQueue,sz + 1);
   IdleQueue[sz] := idle;
end;

function TThreadPool.PickupTask: TWorkTask;
begin
   //先排序再取
   hTaskLock.enter;

   if FSorted then
      SortTask(TaskQueue);

   if length(TaskQueue) > 0 then
   begin
      Result := TaskQueue[0];
      DelTaskOfIndex(TaskQueue,0);
   end
   else
      Result := Nil;

   hTaskLock.Leave;
end;

function TThreadPool.AddWorkTask(Const wtask: TWorkTask):Integer;
var
   sz,ic,bc:Integer;
begin
   sz := Length(TaskQueue);
   if sz >= FTasksCache  then
   begin
      Result := -1;
      DoTaskFull;
      exit;
   end;

   setLength(TaskQueue,sz+1);
   wtask.WorkState := tsWaiting;
   TaskQueue[sz] := wtask;

   Result := sz + 1;

   //未达到最大线程数时增加
   ic := IdleQueueCount;
   bc := BusyQueueCount;

   //最大只能ic + bc = MaxNums
   if (ic = 0) and (ic+ bc < FMaxNums) then
      CreateIdleThread();
      
   FAuto := True;
   //通知线程去取任务
   PostNewTaskSign;
   Log.WriteLog('Add a task to queue.',lInfo);
end;

function TThreadPool.FindTask(const tsk: TWorkTask): Integer;
var
   l:Integer;
begin
   Result := -1;
   for l := Low(TaskQueue) to High(TaskQueue) do
       if TaskQueue[l] = tsk then
       begin
         Result := l;
         Break;
       end;
end;

procedure TThreadPool.PostNewTaskSign;
begin
   entTaskNotify.SetEvent;
end;

procedure TThreadPool.switch(var Queue:TWorkTaskQueue;m,n:Integer);
var
 tem:TWorkTask;
begin
  tem := Queue[m];
  Queue[m] := Queue[n];
  Queue[n] := tem;
end;

procedure TThreadPool.QuikeSortTask(var Queue: TWorkTaskQueue; const s,
  e: Integer);
var
   key:Integer;
   k,j:Integer;
begin
   key := ord(Queue[s].WorkLevel);

   if s > e then exit;

   k := s;
   j := e;

   while (k <> j) do
   begin
     while (k < j) and (ord(Queue[j].WorkLevel) <= key) do //如果排序从小到大时改为 >=
         dec(j);
     switch(Queue,k,j);

     while (k < j) and (ord(Queue[k].WorkLevel) >= key) do //如果排序从小到大时改为 <=
         inc(k);
     Switch(Queue,j,k);
   end;

   if s < k-1 then
      QuikeSortTask(Queue,s,k-1);
   if k+1 < e then
      QuikeSortTask(Queue,k+1,e);
end;

procedure TThreadPool.SortTask(var Queue: TWorkTaskQueue);
var
   f,l:Integer;
   ic:Integer;
begin
   ic := Length(Queue);
   if ic = 0 then exit;
   
   if Assigned(FOnSortTask) then
      FOnSortTask(self,Queue)
   else
   begin
      f := 0;
      l := ic-1;
      QuikeSortTask(Queue,f,l);
   end;
end;

procedure TThreadPool.StartAll;
var
   I:Integer;
begin
   hBusyLock.Enter;
   for I := Low(BusyQueue) to High(BusyQueue) do
   begin
     BusyQueue[i].Resume;
     BusyQueue[i].State := wtRunning;
   end;
   hBusyLock.Leave;

   hIDleLock.Enter;
   for I := Low(IdleQueue) to High(IdleQueue) do
   begin
     IdleQueue[i].Resume;
     IdleQueue[i].State := wtRunning;
   end;
   hIDleLock.Leave;
end;

procedure TThreadPool.StopAll;
var
   I:Integer;
begin
   hBusyLock.Enter;
   for I := Low(BusyQueue) to High(BusyQueue) do
   begin
     BusyQueue[i].Suspend;
     BusyQueue[i].State := wtStop;
   end;
   hBusyLock.Leave;

   hIDleLock.Enter;
   for I := Low(IdleQueue) to High(IdleQueue) do
   begin
     IdleQueue[i].Suspend;
     IdleQueue[i].State := wtStop;
   end;
   hIDleLock.Leave;
end;

function TThreadPool.QueueSize(const Queue: TWorkThreadQueue):Integer;
begin
  Result := Length(Queue);
end;

//每次只留单线程进行空闲回收等待
procedure TThreadPool.RecoverIDle(Const wait:TWorkThread);
var
   k:Integer;
begin
   FAuto:=False;
   //等待时间超时
   FWaitFlag := False;
   Waiting := wait;
   hBusyLock.Enter;
   RemoveFromQueue(BusyQueue,wait);
   hBusyLock.Leave;
   //补给一个空闲线程
   CreateIdleThread();
   WaitforSingleObject(hTimeJump,FRecoverInterval*ONEMINUTE);

   //满足空闲时间到后并且空闲线程大于零，没有线程在执行任务，及任务队列为空
   if (IdleQueueCount > 0)
      and (BusyQueueCount = 0) //正在等待的是清空空闲线程
      and (TaskQueueCount = 0) then
   begin
      hTaskLock.Enter;
      //回收到最小设定线程
      for k := High(IdleQueue) Downto FMinNums do
      begin
         TWorkThread(IdleQueue[k]).Terminate;
         PostNewTaskSign;
      end;
      SetLength(IdleQueue,FMinNums);
      hTaskLock.Leave;
   end;
   //定时完后线程释放
   wait.Terminate;
   FWaitFlag := True;
end;

procedure TThreadPool.RemoveFromQueue(var Queue: TWorkThreadQueue;
  const re: TWorkThread);
var
   index ,i: integer;
begin
   index := -1;
   for i := Low(Queue) to High(Queue) do
   begin
       if Queue[i] = re then
       begin
          index := i;
          break;
       end;
   end;
   
   if Index<>-1 then
      DelQueueOfIndex(Queue,index);
end;

procedure TThreadPool.RemoveTask(const tk: TWorkTask);
var
   index:Integer;
begin
   index := FindTask(tk);
   if index = -1 then Exit;
   hTaskLock.Enter;
   DelTaskOfIndex(TaskQueue,index);
   hTaskLock.Leave;
end;

{ TWorkThread }

constructor TWorkThread.Create(const pool: TThreadPool);
begin
   FPool := pool;
   SetDefault;
   inherited Create(false);
end;

procedure TWorkThread.Execute;
var
  hd:Array[0..0] of Cardinal;
  ret:Cardinal;
  task:TWorkTask;
  nc:Integer;
begin
   //不断的在任务队列中取任务
   hd[0]:= fPool.entTaskNotify.Handle;
   while not Terminated do
   begin
      //跟踪时为什么会暂停不了，是因为前面在设置MinNums时有信号增加
      ret := WaitForMultipleObjects(1,@hd,false,INFINITE);
      
      if Terminated then break;

      Case ret - WAIT_OBJECT_0 of
      WAIT_OBJECT_0:
           begin
                if state <> wtRunning then 
                begin
                    try
                      //抽取一个任务
                      task := FPool.PickupTask;

                      if assigned(task) then
                      begin
                         //需要线程同步,以防正在执行的任务被其它线程执行。

                         task.hTask.Enter;
                         //当有任务做时，将自己移到工作队列中
                         fPool.MoveQueue(self,0);
                         state := wtRunning;

                         //任务启动前
                         if Assigned(fPool.FOnTaskWillDo) then
                            fPool.FOnTaskWillDo(self.ThreadID,task);

                         //指定执行线程
                         task.Work := self;
                         task.WorkState := tsDoing;
                         task.execTask;
                         state := wtFinished;
                         task.WorkState := tsFinished;
                         task.Work := nil;
                         task.hTask.leave;
                         //任务完成
                         if Assigned(fPool.FOnTaskFinished) then
                            fPool.FOnTaskFinished(task);
                      end;

                    finally

                    end;

                end;
           end;
         WAIT_OBJECT_0 + 1:;//Terminate  don't to do something
      End;

      nc := fPool.TaskQueueCount;
      if (nc > 0) then
        fpool.PostNewTaskSign
      else if (fPool.FAuto) and (fPool.FWaitFlag) and (fPool.BusyQueueCount=1) then
         fPool.RecoverIDle(self);//任务空闲，线程空闲时间大于设定时间时自动回收空闲线程

      state := wtIdle;
      //将自己移至空闲线程
      if not fPool.WaitAutoRecover(self) then //如果当前正在等待自动回收线程的
         fPool.MoveQueue(self,1)
      else
         fPool.Waiting := nil;
   end;
end;

procedure TWorkThread.SetDefault;
begin
   FState := wtIdle;
end;

{ TWorkTask }

constructor TWorkTask.Create;
begin
   hTask := TCriticalSection.Create;
   WorkState := tsNone;
   FWorkLevel := tlNormal;
   Work := nil;
end;

destructor TWorkTask.Destroy;
begin
   WorkState := tsFinished;
   if Assigned(Work) then
      Work.Resume;
   hTask.Free;
  inherited;
end;

procedure TWorkTask.setWorkState(Const Value:TTaskState);
begin

   FWorkState := Value;

   case value of
     tsReStart:
          begin
            if Assigned(Work) and (Work.Suspended)  then
            begin
                FWorkState := tsDoing;
                Work.Resume;
            end;
          end;
     tsStop:
          begin
            if Assigned(Work) then
                Work.Suspend;
          end;
   end;
end;

{ TPoolLog }

procedure TPoolLog.OutputLog(const Msg: String; Level: TLogLevel);
begin
   // to implement at sub class.
end;

procedure TPoolLog.WriteLog(const Msg: String; Level: TLogLevel);
var
   dt:TDatetime;
begin
   dt := now;
   OutputLog(datetimetostr(dt) + ' : ' + Msg,Level);
end;

end.

unit uTest;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls,uPool, StdCtrls,SyncObjs;

type

  TUICALL = procedure (Sender:TObject) of object;

  TTaskDemo = class(TWorkTask)
     private
       FOnUICall:TUICALL;
     public
       procedure execTask;override;
       property OnUICall:TUICALL read FOnUICall write FOnUICall;
  end;


  TfrmDemo = class(TForm)
    GroupBox1: TGroupBox;
    Label1: TLabel;
    edtMin: TEdit;
    Label2: TLabel;
    edtMax: TEdit;
    Label3: TLabel;
    edttasks: TEdit;
    btnset: TButton;
    GroupBox2: TGroupBox;
    Memo1: TMemo;
    Memo2: TMemo;
    ckSort: TCheckBox;
    Button1: TButton;
    GroupBox3: TGroupBox;
    GroupBox4: TGroupBox;
    GroupBox5: TGroupBox;
    GroupBox6: TGroupBox;
    GroupBox7: TGroupBox;
    GroupBox8: TGroupBox;
    GroupBox9: TGroupBox;
    GroupBox10: TGroupBox;
    GroupBox11: TGroupBox;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    cb: TComboBox;
    Timer1: TTimer;
    one: TEdit;
    two: TEdit;
    three: TEdit;
    four: TEdit;
    five: TEdit;
    six: TEdit;
    seven: TEdit;
    eight: TEdit;
    nine: TEdit;
    Button5: TButton;
    Button6: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure btnsetClick(Sender: TObject);
  private
    { Private declarations }
    kk:TCriticalSection;
  public
    { Public declarations }
    list:TList;
    tpDemo:TThreadPool;
    procedure DoTaskOne(Sender: TObject);
    procedure DoTaskTwo(Sender: TObject);
    procedure DoTaskThr(Sender: TObject);
    procedure DoTaskFour(Sender: TObject);
    procedure DoTaskFive(Sender: TObject);
    procedure DoTaskSix(Sender: TObject);
    procedure DoTaskSeven(Sender: TObject);
    procedure DoTaskEight(Sender: TObject);
    procedure DoTaskNine(Sender: TObject);
    procedure DoTaskExcuBefore(Const thId:Cardinal;Const cTast:TWorkTask);
    procedure DoListen(Sender:TObject;Const IdleCount,BusyCount,TaskCount:Integer);
  end;

var
  frmDemo: TfrmDemo;
implementation

{$R *.dfm}

procedure TfrmDemo.btnsetClick(Sender: TObject);
begin
   tpDemo.MinNums := strtoint(edtMin.text);
   tpDemo.MaxNums := strtoint(edtMax.text);
   tpDemo.TasksCacheSize := strtoint(edttasks.text);
end;

procedure TfrmDemo.Button1Click(Sender: TObject);
var
   i:integer;
   td:TTaskDemo;
begin
      list.Clear;
      cb.Clear;
        
      td:=TTaskDemo.Create;
      td.WorkId := 1;
      td.WorkName := 'Task1';
      td.WorkLevel := tlLower;
      td.OnUICall := DoTaskOne;
      Memo1.Lines.Add('id = 1 taskName = Task1');
      list.Add(td);
      cb.Items.Add(td.WorkName);
      //tpDemo.AddWorkTask(td);

      td:=TTaskDemo.Create;
      td.WorkId := 2;
      td.WorkName := 'Task2';
      td.WorkLevel := tlNormal;
      td.OnUICall := DoTaskTwo;
      Memo1.Lines.Add('id = 2 taskName = Task2');
      list.Add(td);
      cb.Items.Add(td.WorkName);
      //tpDemo.AddWorkTask(td);

      td:=TTaskDemo.Create;
      td.WorkId := 3;
      td.WorkName := 'Task3';
      td.WorkLevel := tlHigh;
      td.OnUICall := DoTaskThr;
      Memo1.Lines.Add('id = 3 taskName = Task3');
      list.Add(td);
      cb.Items.Add(td.WorkName);
      //tpDemo.AddWorkTask(td);

      td:=TTaskDemo.Create;
      td.WorkId := 4;
      td.WorkName := 'Task4';
      td.WorkLevel := tlLower;
      td.OnUICall := DoTaskFour;
      Memo1.Lines.Add('id = 4 taskName = Task4');
      list.Add(td);
      cb.Items.Add(td.WorkName);
      //tpDemo.AddWorkTask(td);

      td:=TTaskDemo.Create;
      td.WorkId := 5;
      td.WorkName := 'Task5';
      td.WorkLevel := tlNormal;
      td.OnUICall := DoTaskFive;
      Memo1.Lines.Add('id = 5 taskName = Task5');
      list.Add(td);
      cb.Items.Add(td.WorkName);
      //tpDemo.AddWorkTask(td);

      td:=TTaskDemo.Create;
      td.WorkId := 6;
      td.WorkName := 'Task6';
      td.WorkLevel := tlHigh;
      td.OnUICall := DoTaskSix;
      Memo1.Lines.Add('id = 6 taskName = Task6');
      list.Add(td);
      cb.Items.Add(td.WorkName);
      //tpDemo.AddWorkTask(td);

      td:=TTaskDemo.Create;
      td.WorkId := 7;
      td.WorkName := 'Task7';
      td.WorkLevel := tlLower;
      td.OnUICall := DoTaskSeven;
      Memo1.Lines.Add('id = 7 taskName = Task7');
      list.Add(td);
      cb.Items.Add(td.WorkName);
      //tpDemo.AddWorkTask(td);

      td:=TTaskDemo.Create;
      td.WorkId := 8;
      td.WorkName := 'Task8';
      td.WorkLevel := tlNormal;
      td.OnUICall := DoTaskEight;
      Memo1.Lines.Add('id = 8 taskName = Task8');
      list.Add(td);
      cb.Items.Add(td.WorkName);
      //tpDemo.AddWorkTask(td);

      td:=TTaskDemo.Create;
      td.WorkId := 9;
      td.WorkName := 'Task9';
      td.WorkLevel := tlHigh;
      td.OnUICall := DoTaskNine;
      Memo1.Lines.Add('id = 9 taskName = Task9');
      list.Add(td);
      cb.Items.Add(td.WorkName);
      //tpDemo.AddWorkTask(td);
                                  
      if ckSort.Checked then
         tpDemo.Sorted := true;
         
      for i := 0 to list.Count-1 do
      begin
         tpDemo.AddWorkTask(list[i]);
         sleep(200);
      end;
end;

procedure TfrmDemo.Button2Click(Sender: TObject);
begin
   tpDemo.StopAll;
   Button2.Enabled := False;
   Button3.Enabled := True;
end;

procedure TfrmDemo.Button3Click(Sender: TObject);
begin
   tpDemo.StartAll;
   Button2.Enabled := True;
   Button3.Enabled := False;
end;

procedure TfrmDemo.Button4Click(Sender: TObject);
var
   idx:integer;
begin
   idx := cb.ItemIndex;
   TWorkTask(List[idx]).WorkState := tsStop;
end;

procedure TfrmDemo.Button5Click(Sender: TObject);
var
  i:integer;
begin
      for i := 0 to list.Count-1 do
      begin
         tpDemo.AddWorkTask(list[i]);
         sleep(200);
      end;
end;

procedure TfrmDemo.Button6Click(Sender: TObject);
var
   idx:integer;
begin
   idx := cb.ItemIndex;
   TWorkTask(List[idx]).WorkState := tsReStart;
end;

procedure TfrmDemo.DoListen(Sender: TObject; const IdleCount, BusyCount,
  TaskCount: Integer);
begin
   Caption := '空闲数:'+inttostr(IdleCount)+' 工作数：'+inttostr(BusyCount)+' 任务池'+inttostr(TaskCount);
end;

procedure TfrmDemo.DoTaskEight(Sender: TObject);
var
  i:integer;
begin
   for i := 0 to 49 do
   begin
      Application.ProcessMessages;
       eight.Text := inttostr(i+1);
       sleep(1000);
   end;
end;

procedure TfrmDemo.DoTaskExcuBefore(const thId: Cardinal;
  const cTast: TWorkTask);
begin
   Memo2.Lines.Add('任务'+cTast.WorkName+'准备被执行,线程ID='+inttostr(thID));
end;

procedure TfrmDemo.DoTaskFive(Sender: TObject);
var
  i:integer;
begin
   for i := 0 to 49 do
   begin
       Application.ProcessMessages;
       five.Text := inttostr(i+1);
       sleep(1500);
   end;
end;

procedure TfrmDemo.DoTaskFour(Sender: TObject);
var
  i:integer;
begin
   for i := 0 to 49 do
   begin
       Application.ProcessMessages;
       four.Text := inttostr(i+1);
       sleep(500);
   end;

end;

procedure TfrmDemo.DoTaskNine(Sender: TObject);
var
  i:integer;
begin
   for i := 0 to 49 do
   begin
       Application.ProcessMessages;
       nine.Text := inttostr(i+1);
       sleep(700);
   end;
end;

procedure TfrmDemo.DoTaskOne(Sender: TObject);
var
  i:integer;
begin
   for i := 0 to 49 do
   begin
     Application.ProcessMessages;
     one.Text := inttostr(i+1);
     sleep(1000);
   end;

end;

procedure TfrmDemo.DoTaskSeven(Sender: TObject);
var
  i:integer;
begin
   for i := 0 to 49 do
   begin
       Application.ProcessMessages;
       seven.Text := inttostr(i+1);
       sleep(400);
   end;
end;

procedure TfrmDemo.DoTaskSix(Sender: TObject);
var
  i:integer;
begin
   for i := 0 to 49 do
   begin
       Application.ProcessMessages;
       six.Text := inttostr(i+1);
       sleep(1200);
   end;
end;

procedure TfrmDemo.DoTaskThr(Sender: TObject);
var
  i:integer;
begin
   for i := 0 to 49 do
   begin
       Application.ProcessMessages;
       three.Text := inttostr(i+1);
       sleep(1000);
   end;
end;

procedure TfrmDemo.DoTaskTwo(Sender: TObject);
var
  i:integer;
begin
   for i := 0 to 49 do
   begin
       Application.ProcessMessages;
       two.Text := inttostr(i+1);
       sleep(800);
   end;
end;

procedure TfrmDemo.FormCreate(Sender: TObject);
begin
   list:=TList.Create;
   tpDemo:=TThreadPool.Create;
   tpDemo.OnTaskWillDo := DoTaskExcuBefore;
   tpDemo.OnListenInfo := DoListen;
   //tpDemo.MinNums := 2;
   tpDemo.MaxNums := 10;
   tpDemo.TasksCacheSize := 10;
   edtMin.Text := InttoStr(tpDemo.MinNums);
   edtMax.Text := InttoStr(tpDemo.MaxNums);
   edttasks.Text := InttoStr(tpDemo.TasksCacheSize);
   Button2.Enabled := True;
   Button3.Enabled := False;
   kk:=TCriticalSection.Create;
end;

procedure TfrmDemo.FormDestroy(Sender: TObject);
begin
   kk.free;
   list.Free;
   tpDemo.Free;
end;


procedure TfrmDemo.Timer1Timer(Sender: TObject);
begin
   tpDemo.ListenPool;
end;

{ TTaskDemo }

procedure TTaskDemo.execTask;
begin
  if Assigned(FOnUICall) then
     FOnUICall(self);
end;


end.