DELPHI 线程池代码Word下载.docx
《DELPHI 线程池代码Word下载.docx》由会员分享，可在线阅读，更多相关《DELPHI 线程池代码Word下载.docx（31页珍藏版）》请在冰豆网上搜索。
TThreadsPool=class;
//线程状态
TThreadState=（tcsInitializing,tcsWaiting,tcsGetting,tcsProcessing,
tcsProcessed,tcsTerminating,tcsCheckingDown）;
//工作线程仅用于线程池内，不要直接创建并调用它。
TProcessorThread=class（TThread）
private
//创建线程时临时的Event对象,阻塞线程直到初始化完成
hInitFinished:
THandle;
//初始化出错信息
sInitError:
//记录日志
procedureWriteLog（constStr:
Level:
Integer=0）;
//线程临界区同步对像
csProcessingDataObject:
TCriticalSection;
//平均处理时间
FAverageProcessing:
Integer;
//等待请求的平均时间
FAverageWaitingTime:
//本线程实例的运行状态
FCurState:
TThreadState;
//本线程实例所附属的线程池
FPool:
TThreadsPool;
//当前处理的数据对像。
FProcessingDataObject:
TWorkItem;
//线程停止Event,TProcessorThread.Terminate中开绿灯
hThreadTerminated:
uProcessingStart:
DWORD;
//开始等待的时间,通过GetTickCount取得。
uWaitingStart:
//计算平均工作时间
functionAverageProcessingTime:
//计算平均等待时间
functionAverageWaitingTime:
procedureExecute;
functionIamCurrentlyProcess（DataObj:
//转换枚举类型的线程状态为字串类型
functionInfoText:
//线程是否长时间处理同一个请求？
（已死掉？
）
functionIsDead:
//线程是否已完成当成任务
functionisFinished:
//线程是否处于空闲状态
functionisIdle:
//平均值校正计算。
functionNewAverage（OldAvg,NewVal:
Integer）:
Tag:
constructorCreate（APool:
TThreadsPool）;
procedureTerminate;
//线程初始化时触发的事件
TProcessorThreadInitializing=procedure（Sender:
aThread:
TProcessorThread）ofobject;
//线程结束时触发的事件
TProcessorThreadFinalizing=procedure（Sender:
//线程处理请求时触发的事件
TProcessRequest=procedure（Sender:
WorkItem:
TEmptyKind=（
ekQueueEmpty,//任务被取空后
ekProcessingFinished//最后一个任务处理完毕后
）;
//任务队列空时触发的事件
TQueueEmpty=procedure（Sender:
EmptyKind:
TEmptyKind）of
object;
TThreadsPool=class（TComponent）
csQueueManagment:
csThreadManagment:
FProcessRequest:
TProcessRequest;
FQueue:
TList;
FQueueEmpty:
TQueueEmpty;
//线程超时阀值
FThreadDeadTimeout:
FThreadFinalizing:
TProcessorThreadFinalizing;
FThreadInitializing:
TProcessorThreadInitializing;
//工作中的线程
FThreads:
//执行了terminat发送退出指令,正在结束的线程.
FThreadsKilling:
//最少,最大线程数
FThreadsMax:
FThreadsMin:
//池平均等待时间
functionPoolAverageWaitingTime:
FLastGetPoint:
//Semaphore，统计任务队列
hSemRequestCount:
//Waitabletimer.每30触发一次的时间量同步
hTimCheckPoolDown:
//线程池停机（检查并清除空闲线程和死线程）
procedureCheckPoolDown;
//清除死线程，并补充不足的工作线程
procedureCheckThreadsForGrow;
procedureDoProcessed;
procedureDoProcessRequest（aDataObj:
TProcessorThread）;
procedureDoQueueEmpty（EmptyKind:
TEmptyKind）;
procedureDoThreadFinalizing（aThread:
//执行事件
procedureDoThreadInitializing（aThread:
//释放FThreadsKilling列表中的线程
procedureFreeFinishedThreads;
//申请任务
procedureGetRequest（outRequest:
TWorkItem）;
//清除死线程
procedureKillDeadThreads;
constructorCreate（AOwner:
TComponent）;
//就进行任务是否重复的检查,检查发现重复就返回False
functionAddRequest（aDataObject:
CheckForDoubles:
Boolean=
False）:
overload;
published
//线程处理任务时触发的事件
propertyOnProcessRequest:
TProcessRequestreadFProcessRequestwrite
FProcessRequest;
//任务列表为空时解发的事件
propertyOnQueueEmpty:
TQueueEmptyreadFQueueEmptywriteFQueueEmpty;
propertyOnThreadFinalizing:
TProcessorThreadFinalizingread
FThreadFinalizingwriteFThreadFinalizing;
propertyOnThreadInitializing:
TProcessorThreadInitializingread
FThreadInitializingwriteFThreadInitializing;
//线程超时值（毫秒）,如果处理超时，将视为死线程
propertyThreadDeadTimeout:
DWORDreadFThreadDeadTimeoutwrite
FThreadDeadTimeoutdefault0;
//最大线程数
propertyThreadsMax:
IntegerreadFThreadsMaxwriteFThreadsMaxdefault1;
//最小线程数
propertyThreadsMin:
IntegerreadFThreadsMinwriteFThreadsMindefault0;
//日志记志函数
TLogWriteProc=procedure（
constStr:
//日志
LogID:
Integer=0;
Integer=0//Level=0-跟踪信息,10-致命错误
var
WriteLog:
TLogWriteProc;
//如果存在实例就写日志
implementation
SysUtils;
//储存请求数据的基本类
{
**********************************TWorkItem***********************************
}
functionTWorkItem.IsTheSame（DataObj:
begin
Result:
=False;
end;
{TWorkItem.IsTheSame}
functionTWorkItem.TextForLog:
='
Request'
;
{TWorkItem.TextForLog}
*********************************TThreadsPool*********************************
constructorTThreadsPool.Create（AOwner:
DueTo:
Int64;
{$IFNDEFNOLOGS}
WriteLog（'
创建线程池'
5）;
{$ENDIF}
inherited;
csQueueManagment:
=TCriticalSection.Create;
FQueue:
=TList.Create;
csThreadManagment:
FThreads:
FThreadsKilling:
FThreadsMin:
=0;
FThreadsMax:
=1;
FThreadDeadTimeout:
FLastGetPoint:
//
hSemRequestCount:
=CreateSemaphore（nil,0,$7FFFFFFF,nil）;
DueTo:
=-1;
//可等待的定时器（只用于WindowNT4或更高）
hTimCheckPoolDown:
=CreateWaitableTimer（nil,False,nil）;
ifhTimCheckPoolDown=0then//Win9x不支持
//InWin9xnumberofthreadwillbeneverdecrised
=CreateEvent（nil,False,False,nil）
else
SetWaitableTimer（hTimCheckPoolDown,DueTo,30000,nil,nil,False）;
{TThreadsPool.Create}
destructorTThreadsPool.Destroy;
n,i:
Handles:
arrayofTHandle;
线程池销毁'
csThreadManagment.Enter;
SetLength（Handles,FThreads.Count）;
n:
fori:
=0toFThreads.Count-1do
ifFThreads<
>
nilthen
begin
Handles[n]:
=TProcessorThread（FThreads）.Handle;
TProcessorThread（FThreads）.Terminate;
Inc（n）;
WaitForMultipleObjects（n,@Handles[0],True,30000）;
TProcessorThread（FThreads）.Free;
FThreads.Free;
FThreadsKilling.Free;
csThreadManagment.Free;
csQueueManagment.Enter;
=FQueue.Count-1downto0do
TObject（FQueue）.Free;
FQueue.Free;
csQueueManagment.Free;
CloseHandle（hSemRequestCount）;
CloseHandle（hTimCheckPoolDown）;
{TThreadsPool.Destroy}
functionTThreadsPool.AddRequest（aDataObject:
Boolean=False）:
i:
AddRequest（'
+aDataObject.TextForLog+'
）'
2）;
try
//如果CheckForDoubles=TRUE
//则进行任务是否重复的检查
ifCheckForDoublesthen
=0toFQueue.Count-1do
if（FQueue<
nil）
andaDataObject.IsTheSame（TWorkItem（FQueue））then
Exit;
//发现有相同的任务
CheckThreadsForGrow;
//则检查是否有相同的任务正在处理中
ifTProcessorThread（FThreads）.IamCurrentlyProcess（aDataObject）then
finally
csThreadManagment.Leave;
//将任务加入队列
FQueue.Add（aDataObject）;
//释放一个同步信号量
ReleaseSemaphore（hSemRequestCount,1,nil）;
释放一个同步信号量）'
1）;
=True;
csQueueManagment.Leave;
//调试信息
增加一个任务（'
{TThreadsPool.AddRequest}
函数名：
TThreadsPool.CheckPoolDown
功能描述：
线程池停机（检查并清除空闲线程和死线程）
输入参数：
无
返回值:
无
创建日期：
2006.10.2211:
31
修改日期：
2006.
作者：
Kook
附加说明：
procedureTThreadsPool.CheckPoolDown;
TThreadsPool.CheckPoolDown'
WriteLog（InfoText,2）;
KillDeadThreads;
FreeFinishedThreads;
//如果线程空闲，就终止它
=FThreads.Count-1downtoFThreadsMindo
ifTProcessorThread（FThreads）.isIdlethen
//发出终止命令
//加入待清除队列
FThreadsKilling.Add（FThreads）;
//从工作队列中除名
FThreads.Delete（i）;
//todo:
？
？
Break;
{TThreadsPool.CheckPoolDown}
TThreadsPool.CheckThreadsForGrow
清除死线程，并补充不足的工作线程
procedureTThreadsPool.CheckThreadsForGrow;
AvgWait:
{
Newthreadcreatedif:
新建线程的条件：
1.工作线程数小于最小线程数
2.工作线程数小于最大线程数and线程池平均等待时间<
100ms（系统忙）
3.任务大于工作线程数的4倍
ifFThreads.Count<
FThreadsMinthen
工作线程数小于最小线程数'
4）;
=FThreads.CounttoFThreadsMin-1do
FThreads.Add（TProcess
升级会员 