threadpool.pas

Delphi中处理线程池的一个组件,非常好用.

{*******************************************************}
{                                                       }
{       高级线程池                                      }
{       单元名 ThreadPool.pas                           }
{                                                       }
{       版权所有 (C) 2006-6-25 飞翔的久久酷             }
{       http://www.flying99koo.com                      }
{       QQ:78273318 Mail: [e-mail]         }
{                                                       }
{*******************************************************}


unit ThreadPool;

interface

uses
  Windows, SysUtils, Classes,
  ThreadTask, ComCtrls, StdCtrls;

type
  TThreadClass = class of TThreadTask;

  PThreadObj = ^TThreadObj;
  TThreadObj = record
    Handle : THandle;
    Active : boolean;
    Index : Integer;
  end;
  {<<<< Added 2006.6.22 at Company<<<<}
  PTaskObj = ^TTaskObj;
  TTaskObj = record
    Index : Integer;
    Param : Pointer;
  end;

  TThreadPool = class
  private
    _TASK_OVER : Boolean;
    _THREAD_OVER : Boolean;
  protected
    _THREADS : array of TThreadTask;
    _THREAD_LIST : TThreadList;
    procedure ThreadDone(Sender : TObject);
    procedure SetThread(ThreadIndex : Integer; Task : Pointer); virtual; abstract;
    procedure CreateThreads;
    procedure RunThread(ThreadIndex : Integer);
    procedure TraceLog(Desc : string);
  public
    _THREAD_CLASS : TThreadClass;
    _THREAD_COUNT : Integer;
    _TASK_LIST : TThreadList;
    _OnTerminate : TNotifyEvent;
    _OnTraceLog : TTraceLogNotifyEvent;
    //
    _PROGRESS_BAR : TProgressBar;                //           
    procedure Start;
    procedure Pause;
    procedure Goon;
    procedure Stop;
    constructor Create;
    destructor Destroy; override;
  end;

  procedure LoadTask(Index : Integer; Param : Pointer; TaskList : TThreadList);

implementation

uses
  HTTPutil;


{TThreadPool}
constructor TThreadPool.Create;
begin
  inherited Create;
  _TASK_LIST := TThreadList.Create;
  _THREAD_LIST := TThreadList.Create;
  _THREAD_COUNT := 1;
  _TASK_OVER := False;
  _THREAD_OVER := False;
end;

destructor TThreadPool.Destroy;
begin
  _TASK_LIST.Free;
  _THREAD_LIST.Free;
  inherited Destroy;
end;

procedure TThreadPool.ThreadDone(Sender : TObject);
var
  i,idx : Integer;
begin
  idx := -1;
  with _THREAD_LIST.LockList do
  try
    for i:=0 to Count-1 do
    if not TThreadObj(Items[i]^).Active then
    begin
      idx := TThreadObj(Items[i]^).Index;
      Remove(Items[i]);
      if Count=0 then
      _THREAD_OVER := True;
      _THREADS[idx] := nil;
      if _PROGRESS_BAR <> nil then
      _PROGRESS_BAR.StepIt;
      Break;
    end;
  finally
    _THREAD_LIST.UnlockList;
  end;
  if _THREAD_OVER and _TASK_OVER then
  begin
    if Assigned(_OnTerminate) then
    _OnTerminate(Self);
  end else if idx>=0 then
    RunThread(idx);
end;

procedure TThreadPool.TraceLog(Desc : string);
begin
  if Assigned(_OnTraceLog) then
  _OnTraceLog(Desc,Self);
end;

procedure TThreadPool.RunThread(ThreadIndex : Integer);
var
  Obj : PThreadObj;
begin
  with _TASK_LIST.LockList do
  try
    if Count>0 then
    begin
      _THREADS[ThreadIndex] := _THREAD_CLASS.Create;
      _THREADS[ThreadIndex]._THREAD_LIST := _THREAD_LIST;
      _THREADS[ThreadIndex].OnTerminate := ThreadDone;
      SetThread(ThreadIndex,Items[0]);
      Remove(Items[0]);
      if Count = 0 then
      _TASK_OVER := True;
      with _THREAD_LIST.LockList do
      try
        GetMem(Obj,SizeOf(TThreadObj));
        Obj^.Handle := _THREADS[ThreadIndex].Handle;
        Obj^.Index := ThreadIndex;
        Obj^.Active := True;
        Add(Obj);
      finally
        _THREAD_LIST.UnlockList;
      end;
      _THREADS[ThreadIndex].Resume;
    end;
  finally
    _TASK_LIST.UnlockList;
  end;
end;


procedure TThreadPool.CreateThreads;
var
  i,TaskCount : Integer;
begin
  with _TASK_LIST.LockList do
  try
    TaskCount := Count;
    if TaskCount < _THREAD_COUNT then
    _THREAD_COUNT := TaskCount;
  finally
    _TASK_LIST.UnlockList;
  end;
  if _PROGRESS_BAR <> nil then
  begin
    _PROGRESS_BAR.Min := 0;
    _PROGRESS_BAR.Max := TaskCount;
    _PROGRESS_BAR.Step := 1;
    _PROGRESS_BAR.Position := 0;
  end;
  SetLength(_THREADS,_THREAD_COUNT);
  for i:=Low(_THREADS) to High(_THREADS) do
  RunThread(i);
end;

procedure TThreadPool.Start;
begin
  if _THREAD_COUNT>0 then
  CreateThreads;
end;

procedure TThreadPool.Pause;
var
  i : Integer;
begin
  for i:= Low(_THREADS) to High(_THREADS) do
    if _THREADS[i]<>nil then
    _THREADS[i].Pause;
end;

procedure TThreadPool.Goon;
var
  i : Integer;
begin
  for i:= Low(_THREADS) to High(_THREADS) do
    if _THREADS[i]<>nil then
    _THREADS[i].Goon;
end;

procedure TThreadPool.Stop;
var
  i : Integer;
begin
  for i:= Low(_THREADS) to High(_THREADS) do
    if _THREADS[i]<>nil then
    begin
      _THREADS[i].Stop;
      _THREADS[i]:=nil;
    end;
  if Assigned(_OnTerminate) then _OnTerminate(Self);
end;

procedure LoadTask(Index : Integer; Param : Pointer; TaskList : TThreadList);
var
  TaskObj : PTaskObj;
begin
  GetMem(TaskObj,SizeOf(TTaskObj));
  TaskObj^.Index := Index;
  TaskObj^.Param := Param;
  TaskList.Add(TaskObj);
end;

end.