《delphi线程池代码》由会员分享，可在线阅读，更多相关《delphi线程池代码（23页珍藏版）》请在金锄头文库上搜索。
1、【转】DELPHI 线程池代码 unit uThreadPool; aPool.AddRequest(TMyRequest.Create(RequestParam1, RequestParam2, .); interface usesWindows,Classes;/ 是否记录日志 / $DEFINE NOLOGStypeTCriticalSection = class(TObject)protectedFSection: TRTLCriticalSection;publicconstructor Create;destructor Destroy; override;/ 进入临界区proce
2、dure Enter;/ 离开临界区procedure Leave;/ 尝试进入function TryEnter: Boolean;end;type/ 储存请求数据的基本类TWorkItem = class(TObject)public/ 是否有重复任务function IsTheSame(DataObj: TWorkItem): Boolean; virtual;/ 如果 NOLOGS 被定义，则禁用。function TextForLog: string; virtual;end;typeTThreadsPool = class;/线程状态TThreadState = (tcsIniti
3、alizing, tcsWaiting, tcsGetting, tcsProcessing,tcsProcessed, tcsTerminating, tcsCheckingDown);/ 工作线程仅用于线程池内， 不要直接创建并调用它。TProcessorThread = class(TThread)private/ 创建线程时临时的 Event 对象, 阻塞线程直到初始化完成hInitFinished: THandle;/ 初始化出错信息sInitError: string;/ 记录日志procedure WriteLog(const Str: string; Level: Intege
4、r = 0);protected/ 线程临界区同步对像csProcessingDataObject: TCriticalSection;/ 平均处理时间FAverageProcessing: Integer;/ 等待请求的平均时间FAverageWaitingTime: Integer;/ 本线程实例的运行状态FCurState: TThreadState;/ 本线程实例所附属的线程池FPool: TThreadsPool;/ 当前处理的数据对像。FProcessingDataObject: TWorkItem;/ 线程停止 Event, TProcessorThread.Terminate
5、中开绿灯hThreadTerminated: THandle;uProcessingStart: DWORD;/ 开始等待的时间, 通过 GetTickCount 取得。uWaitingStart: DWORD;/ 计算平均工作时间function AverageProcessingTime: DWORD;/ 计算平均等待时间function AverageWaitingTime: DWORD;procedure Execute; override;function IamCurrentlyProcess(DataObj: TWorkItem): Boolean;/ 转换枚举类型的线程状态为字
6、串类型function InfoText: string;/ 线程是否长时间处理同一个请求？（已死掉？）function IsDead: Boolean;/ 线程是否已完成当成任务function isFinished: Boolean;/ 线程是否处于空闲状态function isIdle: Boolean;/ 平均值校正计算。function NewAverage(OldAvg, NewVal: Integer): Integer;publicTag: Integer;constructor Create(APool: TThreadsPool);destructor Destroy; o
7、verride;procedure Terminate;end;/ 线程初始化时触发的事件TProcessorThreadInitializing = procedure(Sender: TThreadsPool; aThread:TProcessorThread) of object;/ 线程结束时触发的事件TProcessorThreadFinalizing = procedure(Sender: TThreadsPool; aThread:TProcessorThread) of object;/ 线程处理请求时触发的事件TProcessRequest = procedure(Sende
8、r: TThreadsPool; WorkItem: TWorkItem;aThread: TProcessorThread) of object;TEmptyKind = (ekQueueEmpty, /任务被取空后ekProcessingFinished / 最后一个任务处理完毕后);/ 任务队列空时触发的事件TQueueEmpty = procedure(Sender: TThreadsPool; EmptyKind: TEmptyKind) ofobject;TThreadsPool = class(TComponent)privatecsQueueManagment: TCritic
9、alSection;csThreadManagment: TCriticalSection;FProcessRequest: TProcessRequest;FQueue: TList;FQueueEmpty: TQueueEmpty;/ 线程超时阀值FThreadDeadTimeout: DWORD;FThreadFinalizing: TProcessorThreadFinalizing;FThreadInitializing: TProcessorThreadInitializing;/ 工作中的线程FThreads: TList;/ 执行了 terminat 发送退出指令, 正在结束的
10、线程.FThreadsKilling: TList;/ 最少, 最大线程数FThreadsMax: Integer;/ 最少, 最大线程数FThreadsMin: Integer;/ 池平均等待时间function PoolAverageWaitingTime: Integer;procedure WriteLog(const Str: string; Level: Integer = 0);protectedFLastGetPoint: Integer;/ Semaphore， 统计任务队列hSemRequestCount: THandle;/ Waitable timer. 每 30 触发
11、一次的时间量同步hTimCheckPoolDown: THandle;/ 线程池停机（检查并清除空闲线程和死线程）procedure CheckPoolDown;/ 清除死线程，并补充不足的工作线程procedure CheckThreadsForGrow;procedure DoProcessed;procedure DoProcessRequest(aDataObj: TWorkItem; aThread: TProcessorThread);virtual;procedure DoQueueEmpty(EmptyKind: TEmptyKind); virtual;procedure D
12、oThreadFinalizing(aThread: TProcessorThread); virtual;/ 执行事件procedure DoThreadInitializing(aThread: TProcessorThread); virtual;/ 释放 FThreadsKilling 列表中的线程procedure FreeFinishedThreads;/ 申请任务procedure GetRequest(out Request: TWorkItem);/ 清除死线程procedure KillDeadThreads;publicconstructor Create(AOwner:
13、 TComponent); override;destructor Destroy; override;/ 就进行任务是否重复的检查, 检查发现重复就返回 Falsefunction AddRequest(aDataObject: TWorkItem; CheckForDoubles: Boolean =False): Boolean; overload;/ 转换枚举类型的线程状态为字串类型function InfoText: string;published/ 线程处理任务时触发的事件property OnProcessRequest: TProcessRequest read FProce
14、ssRequest writeFProcessRequest;/ 任务列表为空时解发的事件property OnQueueEmpty: TQueueEmpty read FQueueEmpty write FQueueEmpty;/ 线程结束时触发的事件property OnThreadFinalizing: TProcessorThreadFinalizing readFThreadFinalizing write FThreadFinalizing;/ 线程初始化时触发的事件property OnThreadInitializing: TProcessorThreadInitializin
15、g readFThreadInitializing write FThreadInitializing;/ 线程超时值（毫秒), 如果处理超时，将视为死线程property ThreadDeadTimeout: DWORD read FThreadDeadTimeout writeFThreadDeadTimeout default 0;/ 最大线程数property ThreadsMax: Integer read FThreadsMax write FThreadsMax default 1;/ 最小线程数property ThreadsMin: Integer read FThreads
16、Min write FThreadsMin default 0;end;type/日志记志函数TLogWriteProc = procedure(const Str: string; /日志LogID: Integer = 0;Level: Integer = 0 /Level = 0 - 跟踪信息, 10 - 致命错误);varWriteLog: TLogWriteProc; / 如果存在实例就写日志implementation usesSysUtils;/ 储存请求数据的基本类 * TWorkItem * function TWorkItem.IsTheSame(DataObj: TWorkItem): Boolean; beginResult := False; end; TWorkItem.Is
