【转】DELPHI 线程池代码 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: TLis