DELPHI线程池代码【uThreadPool.PAS】
有没有人用过这个线程池,不知道怎么调用啊,哪个高人写个简单的DEMO,非常感谢,解决了再加100分!!
部分代码,全部代码地址:http://blog.csdn.net/babyvspp/article/details/2008234
unit uThreadPool;{ aPool.AddRequest(TMyRequest.Create(RequestParam1, RequestParam2, ...)); }interfaceuses 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; // 如果存在实例就写日志implementationuses SysUtils;