DELPHI线程池代码【uThreadPool.PAS】

ajmxj 2011-09-23 10:52:58

有没有人用过这个线程池，不知道怎么调用啊，哪个高人写个简单的DEMO，非常感谢,解决了再加100分！！

部分代码，全部代码地址：http://blog.csdn.net/babyvspp/article/details/2008234



unit uThreadPool;



{   aPool.AddRequest(TMyRequest.Create(RequestParam1, RequestParam2, ...)); }



interface

uses

  Windows,

  Classes;



// 是否记录日志

// {$DEFINE NOLOGS}



type

  TCriticalSection = class(TObject)

  protected

    FSection: TRTLCriticalSection;

  public

    constructor Create;

    destructor Destroy; override;

    // 进入临界区

    procedure Enter;

    // 离开临界区

    procedure Leave;

    // 尝试进入

    function TryEnter: Boolean;

  end;



type

  // 储存请求数据的基本类

  TWorkItem = class(TObject)

  public

    // 是否有重复任务

    function IsTheSame(DataObj: TWorkItem): Boolean; virtual;

    // 如果 NOLOGS 被定义，则禁用。

    function TextForLog: string; virtual;

  end;



type

  TThreadsPool = class;



  //线程状态

  TThreadState = (tcsInitializing, tcsWaiting, tcsGetting, tcsProcessing,

    tcsProcessed, tcsTerminating, tcsCheckingDown);

  // 工作线程仅用于线程池内， 不要直接创建并调用它。

  TProcessorThread = class(TThread)

  private

    // 创建线程时临时的Event对象, 阻塞线程直到初始化完成

    hInitFinished: THandle;

    // 初始化出错信息

    sInitError: string;

    // 记录日志

    procedure WriteLog(const Str: string; Level: Integer = 0);

  protected

    // 线程临界区同步对像

    csProcessingDataObject: TCriticalSection;

    // 平均处理时间

    FAverageProcessing: Integer;

    // 等待请求的平均时间

    FAverageWaitingTime: Integer;

    // 本线程实例的运行状态

    FCurState: TThreadState;

    // 本线程实例所附属的线程池

    FPool: TThreadsPool;

    // 当前处理的数据对像。

    FProcessingDataObject: TWorkItem;

    // 线程停止 Event, TProcessorThread.Terminate 中开绿灯

    hThreadTerminated: THandle;

    uProcessingStart: DWORD;

    // 开始等待的时间, 通过 GetTickCount 取得。

    uWaitingStart: DWORD;

    // 计算平均工作时间

    function AverageProcessingTime: DWORD;

    // 计算平均等待时间

    function AverageWaitingTime: DWORD;

    procedure Execute; override;

    function IamCurrentlyProcess(DataObj: TWorkItem): Boolean;

    // 转换枚举类型的线程状态为字串类型

    function InfoText: string;

    // 线程是否长时间处理同一个请求？（已死掉？）

    function IsDead: Boolean;

    // 线程是否已完成当成任务

    function isFinished: Boolean;

    // 线程是否处于空闲状态

    function isIdle: Boolean;

    // 平均值校正计算。

    function NewAverage(OldAvg, NewVal: Integer): Integer;

  public

    Tag: Integer;

    constructor Create(APool: TThreadsPool);

    destructor Destroy; override;

    procedure Terminate;

  end;



  // 线程初始化时触发的事件

  TProcessorThreadInitializing = procedure(Sender: TThreadsPool; aThread:

    TProcessorThread) of object;

  // 线程结束时触发的事件

  TProcessorThreadFinalizing = procedure(Sender: TThreadsPool; aThread:

    TProcessorThread) of object;

  // 线程处理请求时触发的事件

  TProcessRequest = procedure(Sender: TThreadsPool; WorkItem: TWorkItem;

    aThread: TProcessorThread) of object;

  TEmptyKind = (

    ekQueueEmpty, //任务被取空后

    ekProcessingFinished // 最后一个任务处理完毕后

    );

  // 任务队列空时触发的事件

  TQueueEmpty = procedure(Sender: TThreadsPool; EmptyKind: TEmptyKind) of

    object;



    

  TThreadsPool = class(TComponent)

  private

    csQueueManagment: TCriticalSection;

    csThreadManagment: TCriticalSection;

    FProcessRequest: TProcessRequest;

    FQueue: TList;

    FQueueEmpty: TQueueEmpty;

    // 线程超时阀值

    FThreadDeadTimeout: DWORD;

    FThreadFinalizing: TProcessorThreadFinalizing;

    FThreadInitializing: TProcessorThreadInitializing;

    // 工作中的线程

    FThreads: TList;

    // 执行了 terminat 发送退出指令, 正在结束的线程.

    FThreadsKilling: TList;

    // 最少, 最大线程数

    FThreadsMax: Integer;

    // 最少, 最大线程数

    FThreadsMin: Integer;

    // 池平均等待时间

    function PoolAverageWaitingTime: Integer;

    procedure WriteLog(const Str: string; Level: Integer = 0);

  protected

    FLastGetPoint: Integer;

    // Semaphore， 统计任务队列

    hSemRequestCount: THandle;

    // Waitable timer. 每30触发一次的时间量同步

    hTimCheckPoolDown: THandle;

    // 线程池停机（检查并清除空闲线程和死线程）

    procedure CheckPoolDown;

    // 清除死线程，并补充不足的工作线程

    procedure CheckThreadsForGrow;

    procedure DoProcessed;

    procedure DoProcessRequest(aDataObj: TWorkItem; aThread: TProcessorThread);

      virtual;

    procedure DoQueueEmpty(EmptyKind: TEmptyKind); virtual;

    procedure DoThreadFinalizing(aThread: TProcessorThread); virtual;

    // 执行事件

    procedure DoThreadInitializing(aThread: TProcessorThread); virtual;

    // 释放 FThreadsKilling 列表中的线程

    procedure FreeFinishedThreads;

    // 申请任务

    procedure GetRequest(out Request: TWorkItem);

    // 清除死线程

    procedure KillDeadThreads;

  public

    constructor Create(AOwner: TComponent); override;

    destructor Destroy; override;

    // 就进行任务是否重复的检查, 检查发现重复就返回 False

    function AddRequest(aDataObject: TWorkItem; CheckForDoubles: Boolean =

      False): Boolean; overload;

    // 转换枚举类型的线程状态为字串类型

    function InfoText: string;

  published

    // 线程处理任务时触发的事件

    property OnProcessRequest: TProcessRequest read FProcessRequest write

      FProcessRequest;

    // 任务列表为空时解发的事件

    property OnQueueEmpty: TQueueEmpty read FQueueEmpty write FQueueEmpty;

    // 线程结束时触发的事件

    property OnThreadFinalizing: TProcessorThreadFinalizing read

      FThreadFinalizing write FThreadFinalizing;

    // 线程初始化时触发的事件

    property OnThreadInitializing: TProcessorThreadInitializing read

      FThreadInitializing write FThreadInitializing;

    // 线程超时值（毫秒), 如果处理超时，将视为死线程

    property ThreadDeadTimeout: DWORD read FThreadDeadTimeout write

      FThreadDeadTimeout default 0;

    // 最大线程数

    property ThreadsMax: Integer read FThreadsMax write FThreadsMax default 1;

    // 最小线程数

    property ThreadsMin: Integer read FThreadsMin write FThreadsMin default 0;

  end;



type

  //日志记志函数

  TLogWriteProc = procedure(

    const Str: string; //日志

    LogID: Integer = 0;

    Level: Integer = 0 //Level = 0 - 跟踪信息, 10 - 致命错误

    );



var

  WriteLog: TLogWriteProc; // 如果存在实例就写日志



implementation

uses

  SysUtils;

调用方法:

// 创建线程池
FThreadPool := TThreadsPool.Create(Self); // 创建线程池
FThreadPool.ThreadsMin := 5; // 初始工作线程数
FThreadPool.ThreadsMax := 50; // 最大允许工作线程数
FThreadPool.OnProcessRequest := DealwithCommRecvData; // 线程工作函数(DealwithCommRecvData在工作者线程的Execute方法中被调用)

// 使用线程池
var
　AWorkItem: TRecvCommDataWorkItem; // 继承自TWorkItem
begin
　AWorkItem := TRecvCommDataWorkItem.Create;
　Move(PData[0], AWorkItem.FRecvData[0], PDataLen);
　AWorkItem.FRecvDataLen := PDataLen;
　FThreadPool.AddRequest(AWorkItem); // 向线程池分配一个任务
end;

...全文

578 7 打赏收藏转发到动态举报

写回复

用AI写文章

7 条回复

切换为时间正序

请发表友善的回复…

发表回复

lyhoo163 2011-09-25

打赏
举报

关注。

ajmxj 2011-09-24

打赏
举报

[Quote=引用 5 楼 jiang188136923 的回复:]
去我的资源下载，已写好DEMO.
[/Quote]
初始化参数，然后点开始任务就没反应了，请问是什么情况？

rainychan2009 2011-09-23

打赏
举报

var
　AWorkItem: TRecvCommDataWorkItem; // 继承自TWorkItem
begin
　AWorkItem := TRecvCommDataWorkItem.Create;
　Move(PData[0], AWorkItem.FRecvData[0], PDataLen);
　AWorkItem.FRecvDataLen := PDataLen;
　FThreadPool.AddRequest(AWorkItem); // 向线程池分配一个任务
end;