线程池任务队列

[delphi]  view plain copy
  1. unit uPool;  
  2.   
  3. {*********************************************************************** 
  4.  
  5.                        线程池+任务队列 
  6.  
  7.          整个线程池调度图 
  8.          ========================================================== 
  9.          |  -----   ----------------------                         | 
  10.          |  |空 |   | 任务队列   ←----    | ⑴                     | 
  11.          |  |闲 |   ----------------------                         | 
  12.          |  |线 |     ↑空闲线程检查队列是否有任务                  | 
  13.          |  |程 |--①-- 有任务要执行时,加入到工作队列              | 
  14.          |  |队 |            |                                     | 
  15.          |  |列 |            ↓②               ----------------    | 
  16.          |  |   |   -----------------------    |  自动回收空   |   | 
  17.          |  |   |   |正在工作队列          |   |  闲定时器     |   | 
  18.          |  |   |   -----------------------    ----------------    | 
  19.          |  |   |     ③     | 任务做完后              |           | 
  20.          |  ----- ←----------| 调度到空闲队列          |           | 
  21.          |    |                                        |           | 
  22.          |    -----------------------------------------|           | 
  23.          |             ④定时回收空闲线程                          | 
  24.          |                                                         | 
  25.          ========================================================== 
  26.  
  27.          使用方法: 
  28.  
  29.          pool = TThreadPool.Create; 
  30.          pool.MinNums := 2; //最小线程 
  31.          pool.MaxNums := 6; //最大线程 
  32.          pool.TasksCacheSize := 10; //任务缓冲队列 
  33.  
  34.          上面创建好之后,就可以往池中放任务 
  35.  
  36.          pool.AddWorkTask(Task); 
  37.  
  38.          线程池就开始工作了。 
  39.          同时线程池支持对任务进行优先级排序,排序算法默认 
  40.          为快速序,也可以外问进行队列排序 
  41.  
  42.          这里把任务和池分开了。 
  43.          使用任务时,需要继承TWorkTask进开自己的任务设计。 
  44.          然后重写exectask;方法。如果方法中要进行毫时循环, 
  45.          请见如下例子; 
  46.          for i := 0 to 5000 do 
  47.           begin 
  48.             if tk.WorkState = tsFinished then break; 
  49.               inc(k); 
  50.               //caption := inttostr(k); 
  51.             edit2.Text := inttostr(k); 
  52.           end; 
  53.  
  54.          如:TWirteFileTask = Class(TWorkTask); 
  55.  
  56.  
  57.         9-23: 
  58.         修正BUG 
  59.           1.在设置MIN时多创建了线程。 
  60.           2.定时回收机制BUG。 
  61.           3.外部处理预任务时线程不能自增。 
  62.  
  63.         作者:边缘 
  64.         @RightCopy fsh 
  65.         QQ: 19985430 
  66.         date: 2012-09-22 
  67.         Email:fengsh998@163.com 
  68. ***********************************************************************}  
  69.   
  70. interface  
  71.   
  72. uses  
  73.     Classes,Windows,SysUtils,Messages,SyncObjs;  
  74.   
  75. Const  
  76.     PRE_NUM = 5;  
  77.     MAX_NUM = 100;  
  78.     AUTO_FREE = 2;  
  79.     MAX_TASKNUM = 100;  
  80.     ONEMINUTE = 10000;//60000;  
  81.   
  82.   type  
  83.     TLogLevel = (lDebug,lInfo,lError);  
  84.   
  85.     ILog = interface  
  86.       procedure WriteLog(Const Msg:String;Level:TLogLevel = lDebug);  
  87.     end;  
  88.   
  89.     TPoolLog = Class(TInterfacedObject,ILog)  
  90.        private  
  91.           procedure WriteLog(Const Msg:String;Level:TLogLevel = lDebug);  
  92.        public  
  93.           procedure OutputLog(Const Msg:String;Level:TLogLevel);virtual;  
  94.     End;  
  95.   
  96.     TPoolException = class(Exception)  
  97.   
  98.     end;  
  99.   
  100.     Thandles = Array of Cardinal;  
  101.   
  102.     //任务级别  优先级高的任务先执行。  
  103.     TTaskLevel = (tlLower,tlNormal,tlHigh);  
  104.     TTaskState = (tsNone,tsDoing,tsWaiting,tsReStart,tsStop,tsFinished);  
  105.     TWorkTask = Class  
  106.        private  
  107.           Work:TThread;  
  108.           //任务ID  
  109.           hTask:TCriticalSection;  
  110.           FWorkId:Cardinal;  
  111.           FWorkName:String;  
  112.           FWorkLevel:TTaskLevel; //默认为普通  
  113.           FWorkState : TTaskState;  
  114.           procedure setWorkState(Const Value:TTaskState);  
  115.        public  
  116.           Constructor Create;  
  117.           Destructor Destroy;override;  
  118.           procedure execTask;virtual; abstract;  
  119.           property WorkId:Cardinal read FWorkId write FWorkId;  
  120.           property WorkName:String read FWorkName write FWorkName;  
  121.           property WorkLevel:TTaskLevel read FWorkLevel write FWorkLevel;  
  122.           property WorkState : TTaskState read FWorkState write setWorkState;  
  123.     End;  
  124.   
  125.     TWorkTaskQueue = Array of TWorkTask;  
  126.       
  127.     TThreadPool = Class;  
  128.   
  129.     TWorkThreadState = (wtIdle,wtRunning,wtStop,wtFinished);  
  130.     //工作线程(单个线程一次只能处理一个task)  
  131.     TWorkThread = Class(TThread)  
  132.       private  
  133.         FPool:TThreadPool;  
  134.         FState:TWorkThreadState;  
  135.         procedure SetDefault;  
  136.       protected  
  137.         procedure Execute;override;  
  138.       public  
  139.         Constructor Create(Const pool:TThreadPool);  
  140.         property State : TWorkThreadState read FState write FState;  
  141.     End;  
  142.   
  143.     TWorkThreadQueue = Array of TWorkThread;  
  144.   
  145.     //查看缓冲情况事件  
  146.     TListenCacheInfoEvent = procedure (Sender:TObject;Const IdleCount,BusyCount,TaskCount:Integer) of Object;  
  147.     TTaskQueueFullEvent = procedure (Sender:TObject) of Object;  
  148.     //任务处理完后  
  149.     TTaskFinishedEvent = procedure (Const cTast:TWorkTask) of object;  
  150.     //任务准备被处理前事件  
  151.     TTaskWillDoBeforeEvent = procedure (Const thId:Cardinal;Const cTast:TWorkTask) of Object;  
  152.     //外部排序任务队列算法,默认为快速排序,可自行在外部定制算法。  
  153.     TSortTaskQueueEvent = procedure (Sender:TObject;var taskQueue:TWorkTaskQueue) of object;  
  154.   
  155.     TThreadPool = Class  
  156.      private  
  157.        Log:TPoolLog;  
  158.        //自动回收标识  
  159.        FAuto:Boolean;  
  160.        //定时等待控制  
  161.        FWaitFlag:Boolean;  
  162.        //表示正在用于等待回收到的线程  
  163.        Waiting:TWorkThread;  
  164.        //提取任务通知信号  
  165.        entTaskNotify:Tevent;  
  166.        //时间事件HANDLE  
  167.        hTimeJump:Cardinal;  
  168.        //是否排序任务队列  
  169.        FSorted:Boolean;  
  170.        //对空闲队列操作锁  
  171.        hIDleLock:TCriticalSection;  
  172.        //对正在进行的线程锁  
  173.        hBusyLock:TCriticalSection;  
  174.        //任务队列锁  
  175.        hTaskLock:TCriticalSection;  
  176.        //预设线程数 默认为5 发现忙不过来时才进行自增直到Max  
  177.        FMinNums:Integer;  
  178.        //最大限制线程数,默认为100  
  179.        FMaxNums:Integer;  
  180.        //任务队列缓冲大小 默认100  
  181.        FTasksCache:Integer;  
  182.        //当线程空闲时间长达XX时自动回收 :单位为分钟  
  183.        FRecoverInterval:Integer;  
  184.        //是否允许队列中存在重复任务 (同一任务时要考虑线程同步),默认为否  
  185.        FIsAllowTheSameTask:Boolean;  
  186.        //任务队列 (不释放外部任务) 最大100个任务。当大于100个任务时,需要等待  
  187.        //每抽取一个任务,立即从队列中删除。  
  188.        TaskQueue:TWorkTaskQueue;  
  189.        //工作线程  
  190.        BusyQueue:TWorkThreadQueue;  
  191.        //空闲线程  
  192.        IdleQueue:TWorkThreadQueue;  
  193.   
  194.        //************************事件回调**********************//  
  195.        //排序队列回调  
  196.        FOnSortTask:TSortTaskQueueEvent;  
  197.        FOnTaskWillDo:TTaskWillDoBeforeEvent;  
  198.        FOnTaskFinished:TTaskFinishedEvent;  
  199.        FOnTaskFull:TTaskQueueFullEvent;  
  200.        FOnListenInfo:TListenCacheInfoEvent;  
  201.        //*****************************************************//  
  202.          
  203.        //************************Get/Set操作*******************//  
  204.        procedure SetMinNums(Const Value:Integer);  
  205.        procedure SetMaxNums(Const Value:Integer);  
  206.        function getTaskQueueCount: Integer;  
  207.        function getBusyQueueCount: Integer;  
  208.        function getIdleQueueCount: Integer;  
  209.        //*****************************************************//  
  210.   
  211.        //***********************同步量处理********************//  
  212.        procedure CreateLock;  
  213.        procedure FreeLock;  
  214.        //*****************************************************//  
  215.   
  216.        //设置初值  
  217.        procedure SetDefault;  
  218.        //处理回调  
  219.        procedure DoTaskFull;  
  220.   
  221.        //********************线程队列操作**********************//  
  222.        //清空线程队列  
  223.        procedure ClearQueue(var Queue:TWorkThreadQueue);  
  224.        //得到队列的长度  
  225.        function QueueSize(Const Queue:TWorkThreadQueue):Integer;  
  226.        //调整队列  
  227.        procedure DelQueueOfIndex(var Queue:TWorkThreadQueue;Const Index:Integer);  
  228.        //移动队列;  
  229.        procedure MoveQueue(Const wt:TWorkThread;flag:Integer);  
  230.        //移除某个线程  
  231.        procedure RemoveFromQueue(var Queue:TWorkThreadQueue;Const re:TWorkThread);  
  232.        //*****************************************************//  
  233.   
  234.        //********************任务队列操作**********************//  
  235.        //排序队列将优先级高的排前面。//可以交给外问进行排序算法  
  236.        procedure SortTask(var Queue:TWorkTaskQueue);  
  237.        //调整队列  
  238.        procedure DelTaskOfIndex(var Queue:TWorkTaskQueue;Const Index:Integer);  
  239.        //获取队列大小  
  240.        function TaskSzie(Const Queue:TWorkTaskQueue):Integer;  
  241.        //*****************************************************//  
  242.        //查找任务(如果有好的算法,哪更高效)  
  243.        function FindTask(Const tsk:TWorkTask):Integer;  
  244.        //快速排序  
  245.        procedure QuikeSortTask(var Queue:TWorkTaskQueue;Const s,e:Integer);  
  246.        //自动回收空闲线程  
  247.        procedure RecoverIDle(Const wait:TWorkThread);  
  248.        //交换任务  
  249.        procedure switch(var Queue: TWorkTaskQueue; m, n: Integer);  
  250.        //判断当前运行线程是否使用在等待自动回收  
  251.        function WaitAutoRecover(Const curThread:TWorkThread):Boolean;  
  252.      protected  
  253.        //求最小值  
  254.        function Smaller(Const expresion:Boolean;Const tureValue,falseValue:Integer):Integer;  
  255.        //按照先进选出进行提取任务  
  256.        function PickupTask:TWorkTask;  
  257.        //创建空闲线程  
  258.        procedure CreateIdleThread(Const Nums:Integer = 1);  
  259.        //添加到空闲线程队列  
  260.        procedure AddThreadToIdleQueue(Const idle:TWorkThread);  
  261.        //添加到工作队列  
  262.        procedure AddThreadToBusyQueue(Const busy:TWorkThread);  
  263.        //发送新任务到达信号  
  264.        procedure PostNewTaskSign;  
  265.          
  266.      public  
  267.        Constructor Create;  
  268.        Destructor Destroy;override;  
  269.        //***********************线程池管理方法******************************//  
  270.        //停止执行的任务  
  271.        procedure StopAll;  
  272.        //开始任务  
  273.        procedure StartAll;  
  274.        //清空任务  
  275.        procedure CleanTasks;  
  276.        //运行中不能进行对调  
  277.        function  SwitchTasks(Const aTask,bTask:TWorkTask):Boolean;  
  278.        //移除某个任务  
  279.        procedure RemoveTask(Const tk:TWorkTask);//只允许移除未执行的任务  
  280.        //需要外部定时调用来得到动态数据效果  
  281.        procedure ListenPool;  
  282.        //******************************************************************//  
  283.        //添加任务  
  284.        function AddWorkTask(Const wtask:TWorkTask):Integer;  
  285.   
  286.        property MinNums:Integer read FMinNums write SetMinNums;  
  287.        property MaxNums:Integer read FMaxNums write SetMaxNums;  
  288.        property TasksCacheSize:Integer read FTasksCache write FTasksCache;  
  289.        property RecoverInterval:Integer read FRecoverInterval  
  290.                 write FRecoverInterval;  
  291.        property IsAllowTheSameTask:Boolean read FIsAllowTheSameTask  
  292.                 write FIsAllowTheSameTask;  
  293.        property Sorted:Boolean read FSorted write FSorted;  
  294.        property TaskQueueCount:Integer read getTaskQueueCount;  
  295.        property IdleQueueCount:Integer read getIdleQueueCount;  
  296.        property BusyQueueCount:Integer read getBusyQueueCount;  
  297.        property OnSortTask:TSortTaskQueueEvent read FOnSortTask write FOnSortTask;  
  298.        property OnTaskWillDo:TTaskWillDoBeforeEvent read FOnTaskWillDo write FOnTaskWillDo;  
  299.        property OnTaskFinished:TTaskFinishedEvent read FOnTaskFinished write FOnTaskFinished;  
  300.        property OnTaskFull:TTaskQueueFullEvent read FOnTaskFull write FOnTaskFull;  
  301.        property OnListenInfo:TListenCacheInfoEvent read FOnListenInfo write FOnListenInfo;  
  302.     End;  
  303.   
  304. implementation  
  305.   
  306. { TThreadPool }  
  307.   
  308. constructor TThreadPool.Create;  
  309. var  
  310.   tpError:Cardinal;  
  311. begin  
  312.    Log:=TPoolLog.Create;  
  313.    SetDefault;  
  314.    CreateLock;  
  315.   
  316.    tpError := 0;  
  317.   
  318.    entTaskNotify:=Tevent.create(nil,false,false'TaskNotify');//事件信号  
  319.    hTimeJump := CreateEvent(nil,False,False,'Timer');//自动回收心跳事件  
  320.    if hTimeJump = 0 then  
  321.        tpError := GetLastError;  
  322.          
  323.    //the same name of sign exists.  
  324.    Case tpError of  
  325.      ERROR_ALREADY_EXISTS:  
  326.                        begin  
  327.                           hTimeJump := 0;  
  328.                           Log.WriteLog('CreateTimerEvent Fail,the Same Name of Event Exists');  
  329.                        end;  
  330.    End;  
  331.    //预创建线程  
  332.    CreateIdleThread(FMinNums);  
  333.    Log.WriteLog('Thread Pool start run.',lInfo);  
  334. end;  
  335.   
  336. destructor TThreadPool.Destroy;  
  337. begin  
  338.    ClearQueue(IdleQueue);  
  339.    ClearQueue(BusyQueue);  
  340.    FreeLock;  
  341.    if hTimeJump > 0 then  
  342.       CloseHandle(hTimeJump);  
  343.    entTaskNotify.Free;  
  344.    Log.Free;  
  345.   inherited;  
  346.   Log.WriteLog('Thread Pool end run.',lInfo);  
  347. end;  
  348.   
  349. procedure TThreadPool.DoTaskFull;  
  350. begin  
  351.    if Assigned(FOnTaskFull) then  
  352.       FOnTaskFull(self);  
  353. end;  
  354.   
  355. procedure TThreadPool.SetDefault;  
  356. begin  
  357.    FMinNums := PRE_NUM;  
  358.    FMaxNums := MAX_NUM;  
  359.    FTasksCache := MAX_TASKNUM;  
  360.    FRecoverInterval := AUTO_FREE;  
  361.    FIsAllowTheSameTask := False;  
  362.    FAuto :=False;  
  363.    FWaitFlag := True;  
  364.    Waiting := nil;  
  365.    FSorted := False;  
  366. end;  
  367.   
  368. procedure TThreadPool.CreateLock;  
  369. begin  
  370.    hIDleLock := TCriticalSection.Create;  
  371.    hBusyLock := TCriticalSection.Create;  
  372.    hTaskLock := TCriticalSection.Create;  
  373. end;  
  374.   
  375. procedure TThreadPool.FreeLock;  
  376. begin  
  377.    hIDleLock.Free;  
  378.    hBusyLock.Free;  
  379.    hTaskLock.Free;  
  380. end;  
  381.   
  382. function TThreadPool.getBusyQueueCount: Integer;  
  383. begin  
  384.    Result := QueueSize(BusyQueue);  
  385. end;  
  386.   
  387. function TThreadPool.getIdleQueueCount: Integer;  
  388. begin  
  389.    Result := QueueSize(IdleQueue);  
  390. end;  
  391.   
  392. function TThreadPool.getTaskQueueCount: Integer;  
  393. begin  
  394.    Result := TaskSzie(TaskQueue);  
  395. end;  
  396.   
  397. procedure TThreadPool.CleanTasks;  
  398. begin  
  399.    hTaskLock.Enter;  
  400.    SetLength(TaskQueue,0);  
  401.    hTaskLock.Leave;  
  402. end;  
  403.   
  404. procedure TThreadPool.ListenPool;  
  405. begin  
  406.    //正在执行任务的线程,空闲线程,队列中任务数  
  407.    if Assigned(FOnListenInfo) then  
  408.       FOnListenInfo(self,IdleQueueCount,BusyQueueCount,TaskQueueCount);  
  409. end;  
  410.   
  411. procedure TThreadPool.ClearQueue(var Queue: TWorkThreadQueue);  
  412. var  
  413.    i:Integer;  
  414.    sc:Integer;  
  415. begin  
  416.    sc := Length(Queue);  
  417.    for i := 0 to sc - 1 do  
  418.    begin  
  419.        TWorkThread(Queue[i]).Terminate;  
  420.        PostNewTaskSign;  
  421.        //TWorkThread(Queue[i]).Free; //如果FreeOnTerminate为TRUE就不要使用这句了。  
  422.    end;  
  423.    SetLength(Queue,0);  
  424. end;  
  425.   
  426. procedure TThreadPool.SetMaxNums(const Value: Integer);  
  427. begin  
  428.    if Value<FMinNums then  
  429.       //to do tips Error;  
  430.    else  
  431.       FMaxNums := Value;  
  432. end;  
  433.   
  434. procedure TThreadPool.SetMinNums(const Value: Integer);  
  435. begin  
  436.    if value > FMaxNums then  
  437.       //to do tips Error;  
  438.    else if Value <= 0 then  
  439.       FMinNums := PRE_NUM  
  440.    else  
  441.       FMinNums := Value;  
  442.        
  443.    ClearQueue(IDleQueue);  
  444.    CreateIdleThread(FMinNums);  
  445.    Log.WriteLog('Reset MinNums Numbers is ' + inttostr(FMinNums) + ' .',lInfo);  
  446. end;  
  447.   
  448.   
  449. function TThreadPool.Smaller(const expresion: Boolean; const tureValue,  
  450.   falseValue: Integer): Integer;  
  451. begin  
  452.    if expresion then  
  453.       result := tureValue  
  454.    else  
  455.       result := falseValue;  
  456. end;  
  457.   
  458. procedure TThreadPool.DelQueueOfIndex(var Queue: TWorkThreadQueue;  
  459.   const Index: Integer);  
  460. var  
  461.    i:integer;  
  462.    ic:integer;  
  463. begin  
  464.    ic := Length(Queue);  
  465.    for i := Index to ic - 1 do  
  466.        Queue[i] := Queue[i+1];  
  467.   
  468.    setLength(Queue,ic-1);  
  469. end;  
  470.   
  471. procedure TThreadPool.DelTaskOfIndex(var Queue: TWorkTaskQueue;  
  472.   const Index: Integer);  
  473. var  
  474.    i:integer;  
  475.    ic:integer;  
  476. begin  
  477.    ic := length(Queue);  
  478.    for i := Index to ic -1 do  
  479.        Queue[i] := Queue[i+1];  
  480.   
  481.    setLength(Queue,ic-1);  
  482. end;  
  483.   
  484. procedure TThreadPool.MoveQueue(const wt: TWorkThread; flag: Integer);  
  485. var  
  486.     k:integer;  
  487. begin  
  488.    if flag = 0 then  
  489.    begin  
  490.      hIDleLock.Enter;  
  491.      for k := Low(IdleQueue) to High(IdleQueue) do  
  492.      begin  
  493.         if IdleQueue[k]=wt then  
  494.         begin  
  495.            AddThreadToBusyQueue(wt);  
  496.            DelQueueOfIndex(IdleQueue,k);  
  497.         end;  
  498.      end;  
  499.      hIDleLock.Leave;  
  500.    end  
  501.    else  
  502.    begin  
  503.      hBusyLock.Enter;  
  504.      for k := Low(BusyQueue) to High(BusyQueue) do  
  505.      begin  
  506.         if BusyQueue[k]=wt then  
  507.         begin  
  508.            AddThreadToIdleQueue(wt);  
  509.            DelQueueOfIndex(BusyQueue,k);  
  510.         end;  
  511.      end;  
  512.      hBusyLock.Leave;  
  513.    end;  
  514. end;  
  515.   
  516. function TThreadPool.SwitchTasks(const aTask, bTask: TWorkTask): Boolean;  
  517. var  
  518.    aIndex,bIndex:Integer;  
  519. begin  
  520.    Result := true;  
  521.    hTaskLock.Enter;  
  522.    aIndex := FindTask(aTask);  
  523.    bIndex := FindTask(bTask);  
  524.      
  525.    if (aIndex = -1or (bIndex = -1then  
  526.    begin  
  527.       Result := false;  
  528.       hTaskLock.Leave;  
  529.       exit;  
  530.    end;  
  531.    switch(TaskQueue,aIndex,bIndex);  
  532.    hTaskLock.Leave;  
  533. end;  
  534.   
  535. function TThreadPool.TaskSzie(const Queue: TWorkTaskQueue): Integer;  
  536. begin  
  537.    Result := Length(Queue);  
  538. end;  
  539.   
  540. function TThreadPool.WaitAutoRecover(const curThread: TWorkThread): Boolean;  
  541. begin  
  542.    Result := Waiting = curThread;  
  543. end;  
  544.   
  545. procedure TThreadPool.CreateIdleThread(const Nums: Integer);  
  546. var  
  547.    WorkThread:TWorkThread;  
  548.    i:integer;  
  549. begin  
  550.    hIDleLock.Enter;  
  551.    for i := 0 to Nums - 1 do  
  552.    begin  
  553.      WorkThread := TWorkThread.Create(self);  
  554.      WorkThread.FreeOnTerminate := true;  
  555.      AddThreadToIdleQueue(WorkThread);  
  556.    end;  
  557.    hIDleLock.Leave;  
  558. end;  
  559.   
  560. procedure TThreadPool.AddThreadToBusyQueue(const busy: TWorkThread);  
  561. var  
  562.    sz:integer;  
  563. begin  
  564.    sz := QueueSize(BusyQueue);  
  565.    setLength(BusyQueue,sz + 1);  
  566.    BusyQueue[sz] := busy;  
  567. end;  
  568.   
  569. procedure TThreadPool.AddThreadToIdleQueue(const idle: TWorkThread);  
  570. var  
  571.    sz:integer;  
  572. begin  
  573.    sz := Length(IdleQueue);  
  574.    setLength(IdleQueue,sz + 1);  
  575.    IdleQueue[sz] := idle;  
  576. end;  
  577.   
  578. function TThreadPool.PickupTask: TWorkTask;  
  579. begin  
  580.    //先排序再取  
  581.    hTaskLock.enter;  
  582.   
  583.    if FSorted then  
  584.       SortTask(TaskQueue);  
  585.   
  586.    if length(TaskQueue) > 0 then  
  587.    begin  
  588.       Result := TaskQueue[0];  
  589.       DelTaskOfIndex(TaskQueue,0);  
  590.    end  
  591.    else  
  592.       Result := Nil;  
  593.   
  594.    hTaskLock.Leave;  
  595. end;  
  596.   
  597. function TThreadPool.AddWorkTask(Const wtask: TWorkTask):Integer;  
  598. var  
  599.    sz,ic,bc:Integer;  
  600. begin  
  601.    sz := Length(TaskQueue);  
  602.    if sz >= FTasksCache  then  
  603.    begin  
  604.       Result := -1;  
  605.       DoTaskFull;  
  606.       exit;  
  607.    end;  
  608.   
  609.    setLength(TaskQueue,sz+1);  
  610.    wtask.WorkState := tsWaiting;  
  611.    TaskQueue[sz] := wtask;  
  612.   
  613.    Result := sz + 1;  
  614.   
  615.    //未达到最大线程数时增加  
  616.    ic := IdleQueueCount;  
  617.    bc := BusyQueueCount;  
  618.   
  619.    //最大只能ic + bc = MaxNums  
  620.    if (ic = 0and (ic+ bc < FMaxNums) then  
  621.       CreateIdleThread();  
  622.         
  623.    FAuto := True;  
  624.    //通知线程去取任务  
  625.    PostNewTaskSign;  
  626.    Log.WriteLog('Add a task to queue.',lInfo);  
  627. end;  
  628.   
  629. function TThreadPool.FindTask(const tsk: TWorkTask): Integer;  
  630. var  
  631.    l:Integer;  
  632. begin  
  633.    Result := -1;  
  634.    for l := Low(TaskQueue) to High(TaskQueue) do  
  635.        if TaskQueue[l] = tsk then  
  636.        begin  
  637.          Result := l;  
  638.          Break;  
  639.        end;  
  640. end;  
  641.   
  642. procedure TThreadPool.PostNewTaskSign;  
  643. begin  
  644.    entTaskNotify.SetEvent;  
  645. end;  
  646.   
  647. procedure TThreadPool.switch(var Queue:TWorkTaskQueue;m,n:Integer);  
  648. var  
  649.  tem:TWorkTask;  
  650. begin  
  651.   tem := Queue[m];  
  652.   Queue[m] := Queue[n];  
  653.   Queue[n] := tem;  
  654. end;  
  655.   
  656. procedure TThreadPool.QuikeSortTask(var Queue: TWorkTaskQueue; const s,  
  657.   e: Integer);  
  658. var  
  659.    key:Integer;  
  660.    k,j:Integer;  
  661. begin  
  662.    key := ord(Queue[s].WorkLevel);  
  663.   
  664.    if s > e then exit;  
  665.   
  666.    k := s;  
  667.    j := e;  
  668.   
  669.    while (k <> j) do  
  670.    begin  
  671.      while (k < j) and (ord(Queue[j].WorkLevel) <= key) do //如果排序从小到大时改为 >=  
  672.          dec(j);  
  673.      switch(Queue,k,j);  
  674.   
  675.      while (k < j) and (ord(Queue[k].WorkLevel) >= key) do //如果排序从小到大时改为 <=  
  676.          inc(k);  
  677.      Switch(Queue,j,k);  
  678.    end;  
  679.   
  680.    if s < k-1 then  
  681.       QuikeSortTask(Queue,s,k-1);  
  682.    if k+1 < e then  
  683.       QuikeSortTask(Queue,k+1,e);  
  684. end;  
  685.   
  686. procedure TThreadPool.SortTask(var Queue: TWorkTaskQueue);  
  687. var  
  688.    f,l:Integer;  
  689.    ic:Integer;  
  690. begin  
  691.    ic := Length(Queue);  
  692.    if ic = 0 then exit;  
  693.      
  694.    if Assigned(FOnSortTask) then  
  695.       FOnSortTask(self,Queue)  
  696.    else  
  697.    begin  
  698.       f := 0;  
  699.       l := ic-1;  
  700.       QuikeSortTask(Queue,f,l);  
  701.    end;  
  702. end;  
  703.   
  704. procedure TThreadPool.StartAll;  
  705. var  
  706.    I:Integer;  
  707. begin  
  708.    hBusyLock.Enter;  
  709.    for I := Low(BusyQueue) to High(BusyQueue) do  
  710.    begin  
  711.      BusyQueue[i].Resume;  
  712.      BusyQueue[i].State := wtRunning;  
  713.    end;  
  714.    hBusyLock.Leave;  
  715.   
  716.    hIDleLock.Enter;  
  717.    for I := Low(IdleQueue) to High(IdleQueue) do  
  718.    begin  
  719.      IdleQueue[i].Resume;  
  720.      IdleQueue[i].State := wtRunning;  
  721.    end;  
  722.    hIDleLock.Leave;  
  723. end;  
  724.   
  725. procedure TThreadPool.StopAll;  
  726. var  
  727.    I:Integer;  
  728. begin  
  729.    hBusyLock.Enter;  
  730.    for I := Low(BusyQueue) to High(BusyQueue) do  
  731.    begin  
  732.      BusyQueue[i].Suspend;  
  733.      BusyQueue[i].State := wtStop;  
  734.    end;  
  735.    hBusyLock.Leave;  
  736.   
  737.    hIDleLock.Enter;  
  738.    for I := Low(IdleQueue) to High(IdleQueue) do  
  739.    begin  
  740.      IdleQueue[i].Suspend;  
  741.      IdleQueue[i].State := wtStop;  
  742.    end;  
  743.    hIDleLock.Leave;  
  744. end;  
  745.   
  746. function TThreadPool.QueueSize(const Queue: TWorkThreadQueue):Integer;  
  747. begin  
  748.   Result := Length(Queue);  
  749. end;  
  750.   
  751. //每次只留单线程进行空闲回收等待  
  752. procedure TThreadPool.RecoverIDle(Const wait:TWorkThread);  
  753. var  
  754.    k:Integer;  
  755. begin  
  756.    FAuto:=False;  
  757.    //等待时间超时  
  758.    FWaitFlag := False;  
  759.    Waiting := wait;  
  760.    hBusyLock.Enter;  
  761.    RemoveFromQueue(BusyQueue,wait);  
  762.    hBusyLock.Leave;  
  763.    //补给一个空闲线程  
  764.    CreateIdleThread();  
  765.    WaitforSingleObject(hTimeJump,FRecoverInterval*ONEMINUTE);  
  766.   
  767.    //满足空闲时间到后并且空闲线程大于零,没有线程在执行任务,及任务队列为空  
  768.    if (IdleQueueCount > 0)  
  769.       and (BusyQueueCount = 0//正在等待的是清空空闲线程  
  770.       and (TaskQueueCount = 0then  
  771.    begin  
  772.       hTaskLock.Enter;  
  773.       //回收到最小设定线程  
  774.       for k := High(IdleQueue) Downto FMinNums do  
  775.       begin  
  776.          TWorkThread(IdleQueue[k]).Terminate;  
  777.          PostNewTaskSign;  
  778.       end;  
  779.       SetLength(IdleQueue,FMinNums);  
  780.       hTaskLock.Leave;  
  781.    end;  
  782.    //定时完后线程释放  
  783.    wait.Terminate;  
  784.    FWaitFlag := True;  
  785. end;  
  786.   
  787. procedure TThreadPool.RemoveFromQueue(var Queue: TWorkThreadQueue;  
  788.   const re: TWorkThread);  
  789. var  
  790.    index ,i: integer;  
  791. begin  
  792.    index := -1;  
  793.    for i := Low(Queue) to High(Queue) do  
  794.    begin  
  795.        if Queue[i] = re then  
  796.        begin  
  797.           index := i;  
  798.           break;  
  799.        end;  
  800.    end;  
  801.      
  802.    if Index<>-1 then  
  803.       DelQueueOfIndex(Queue,index);  
  804. end;  
  805.   
  806. procedure TThreadPool.RemoveTask(const tk: TWorkTask);  
  807. var  
  808.    index:Integer;  
  809. begin  
  810.    index := FindTask(tk);  
  811.    if index = -1 then Exit;  
  812.    hTaskLock.Enter;  
  813.    DelTaskOfIndex(TaskQueue,index);  
  814.    hTaskLock.Leave;  
  815. end;  
  816.   
  817. { TWorkThread }  
  818.   
  819. constructor TWorkThread.Create(const pool: TThreadPool);  
  820. begin  
  821.    FPool := pool;  
  822.    SetDefault;  
  823.    inherited Create(false);  
  824. end;  
  825.   
  826. procedure TWorkThread.Execute;  
  827. var  
  828.   hd:Array[0..0of Cardinal;  
  829.   ret:Cardinal;  
  830.   task:TWorkTask;  
  831.   nc:Integer;  
  832. begin  
  833.    //不断的在任务队列中取任务  
  834.    hd[0]:= fPool.entTaskNotify.Handle;  
  835.    while not Terminated do  
  836.    begin  
  837.       //跟踪时为什么会暂停不了,是因为前面在设置MinNums时有信号增加  
  838.       ret := WaitForMultipleObjects(1,@hd,false,INFINITE);  
  839.         
  840.       if Terminated then break;  
  841.   
  842.       Case ret - WAIT_OBJECT_0 of  
  843.       WAIT_OBJECT_0:  
  844.            begin  
  845.                 if state <> wtRunning then   
  846.                 begin  
  847.                     try  
  848.                       //抽取一个任务  
  849.                       task := FPool.PickupTask;  
  850.   
  851.                       if assigned(task) then  
  852.                       begin  
  853.                          //需要线程同步,以防正在执行的任务被其它线程执行。  
  854.   
  855.                          task.hTask.Enter;  
  856.                          //当有任务做时,将自己移到工作队列中  
  857.                          fPool.MoveQueue(self,0);  
  858.                          state := wtRunning;  
  859.   
  860.                          //任务启动前  
  861.                          if Assigned(fPool.FOnTaskWillDo) then  
  862.                             fPool.FOnTaskWillDo(self.ThreadID,task);  
  863.   
  864.                          //指定执行线程  
  865.                          task.Work := self;  
  866.                          task.WorkState := tsDoing;  
  867.                          task.execTask;  
  868.                          state := wtFinished;  
  869.                          task.WorkState := tsFinished;  
  870.                          task.Work := nil;  
  871.                          task.hTask.leave;  
  872.                          //任务完成  
  873.                          if Assigned(fPool.FOnTaskFinished) then  
  874.                             fPool.FOnTaskFinished(task);  
  875.                       end;  
  876.   
  877.                     finally  
  878.   
  879.                     end;  
  880.   
  881.                 end;  
  882.            end;  
  883.          WAIT_OBJECT_0 + 1:;//Terminate  don't to do something  
  884.       End;  
  885.   
  886.       nc := fPool.TaskQueueCount;  
  887.       if (nc > 0then  
  888.         fpool.PostNewTaskSign  
  889.       else if (fPool.FAuto) and (fPool.FWaitFlag) and (fPool.BusyQueueCount=1then  
  890.          fPool.RecoverIDle(self);//任务空闲,线程空闲时间大于设定时间时自动回收空闲线程  
  891.   
  892.       state := wtIdle;  
  893.       //将自己移至空闲线程  
  894.       if not fPool.WaitAutoRecover(self) then //如果当前正在等待自动回收线程的  
  895.          fPool.MoveQueue(self,1)  
  896.       else  
  897.          fPool.Waiting := nil;  
  898.    end;  
  899. end;  
  900.   
  901. procedure TWorkThread.SetDefault;  
  902. begin  
  903.    FState := wtIdle;  
  904. end;  
  905.   
  906. { TWorkTask }  
  907.   
  908. constructor TWorkTask.Create;  
  909. begin  
  910.    hTask := TCriticalSection.Create;  
  911.    WorkState := tsNone;  
  912.    FWorkLevel := tlNormal;  
  913.    Work := nil;  
  914. end;  
  915.   
  916. destructor TWorkTask.Destroy;  
  917. begin  
  918.    WorkState := tsFinished;  
  919.    if Assigned(Work) then  
  920.       Work.Resume;  
  921.    hTask.Free;  
  922.   inherited;  
  923. end;  
  924.   
  925. procedure TWorkTask.setWorkState(Const Value:TTaskState);  
  926. begin  
  927.   
  928.    FWorkState := Value;  
  929.   
  930.    case value of  
  931.      tsReStart:  
  932.           begin  
  933.             if Assigned(Work) and (Work.Suspended)  then  
  934.             begin  
  935.                 FWorkState := tsDoing;  
  936.                 Work.Resume;  
  937.             end;  
  938.           end;  
  939.      tsStop:  
  940.           begin  
  941.             if Assigned(Work) then  
  942.                 Work.Suspend;  
  943.           end;  
  944.    end;  
  945. end;  
  946.   
  947. { TPoolLog }  
  948.   
  949. procedure TPoolLog.OutputLog(const Msg: String; Level: TLogLevel);  
  950. begin  
  951.    // to implement at sub class.  
  952. end;  
  953.   
  954. procedure TPoolLog.WriteLog(const Msg: String; Level: TLogLevel);  
  955. var  
  956.    dt:TDatetime;  
  957. begin  
  958.    dt := now;  
  959.    OutputLog(datetimetostr(dt) + ' : ' + Msg,Level);  
  960. end;  
  961.   
  962. end.  
  • 1
    点赞
  • 1
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值