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