t; // 执行了 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; // 储存请求数据的基本类 { ********************************** *********************************** } function TWorkItem.IsTheSame(DataObj: TWorkItem): Boolean; begin Result := False; end; { TWorkItem.IsTheSame } function TWorkItem.TextForLog: string; begin Result := 'Request'; end; { TWorkItem.TextForLog } { ********************************* TThreadsPool ********************************* }
TWorkItem
constructor TThreadsPool.Create(AOwner: TComponent); var DueTo: Int64; begin {$IFNDEF NOLOGS} WriteLog('创建线程池', 5); {$ENDIF} inherited; csQueueManagment := TCriticalSection.Create; FQueue := TList.Create; csThreadManagment := TCriticalSection.Create; FThreads := TList.Create; FThreadsKilling := TList.Create; FThreadsMin := 0; FThreadsMax := 1; FThreadDeadTimeout