服务器级别的线程类

http://blog.gxsky.com/blog.php?id=369388

 

本线程类，主要为了解决线程间同步互斥的问题，以及解决和主窗体数据交流同步的问题。已经很稳定长时间的运行于本人开发的服务器程序上。

{******************************************************************************
* YCode 组件 *
* 作者：卢益贵 2003～2007 *
* 版权所有 任何未经授权的使用和销售，均保留追究法律责任的权力 *
* QQ: 48092788 *
* *
******************************************************************************}
{******************************************************************************
说明：服务器级别的线程类，用于伺服服务器应对客户连接的工作处理线程
******************************************************************************}
unit YThread;
interface
uses
Windows, Messages, SysUtils, WinSock2, Dialogs, Forms, Classes,
YSyncObj;
const
MSG_YTHREAD_USER = DWord(WM_USER + 2007);
MSG_YTHREAD_BASIC = DWord(WM_USER + 1975);
MSG_YTHREAD_SYNC = DWord(MSG_YTHREAD_BASIC + 1);
type
TThreadPriority = (tpIdle, tpLowest, tpLower, tpNormal, tpHigher, tpHighest,
tpTimeCritical);
const
Priorities: array [TThreadPriority] of Integer =
(THREAD_PRIORITY_IDLE, THREAD_PRIORITY_LOWEST, THREAD_PRIORITY_BELOW_NORMAL,
THREAD_PRIORITY_NORMAL, THREAD_PRIORITY_ABOVE_NORMAL,
THREAD_PRIORITY_HIGHEST, THREAD_PRIORITY_TIME_CRITICAL);
type

TOnThread = procedure(Sender: TObject) of Object;
TOnThreadMessage = procedure(Sender: TObject; var Msg: TMessage) of Object;
TThreadSyncMethod = procedure(Param: DWord);
PSyncParam = ^ TSyncParam;
TSyncParam = record
Method: TThreadSyncMethod;
Param: DWord;
Signal: THandle;
end;
// 继承于TYSyncSection，可以使用同步互斥功能
TYThread = class(TYSyncSection)
private
FTerminated: Boolean;
FFinished: THandle;
FSuspended: Boolean;
FFreeOnTerminated: Boolean;
FCreateSuspended: Boolean;
FSleepTime: Integer;
FThreadHandle: THandle;
FThreadID: THandle;
FWndHandle: HWnd;
FIsMyWndHandle: Boolean;
procedure DoExecute();
procedure WndProc(var Msg: TMessage);

protected
procedure OnThreadStart(); virtual;
procedure OnThreadFinished(); virtual;
procedure OnThreadExecute(); virtual;
procedure OnThreadMessage(var Msg: TMessage); virtual;
procedure OnMessage(var Msg: TMessage); virtual;
procedure SetWndHandle(Wnd: HWnd);

public
constructor Create(const CreateSuspended: Boolean = False);
destructor Destroy; override;
function GetPriority(): TThreadPriority;
procedure SetPriority(const value: TThreadPriority);
procedure SendThreadMsg(const Msg: DWord; const wParam: DWord; const lParam: DWord);
procedure SendWindowMsg(const Msg: DWord; const wParam: DWord; const lParam: DWord);
function Resume(): Boolean;
function Suspend(): Boolean;
procedure Synchronize(const Method: TThreadSyncMethod; const Param: DWord);
procedure Terminate();
procedure WaitForFinished();

published
property SleepTime: Integer read FSleepTime write FSleepTime;
property Terminated: Boolean read FTerminated;
property WndHandle: HWnd read FWndHandle write SetWndHandle;
property FreeOnTerminated: Boolean read FFreeOnTerminated write FFreeOnTerminated;

end;
procedure GetMem(var P: Pointer; Size: Integer);
implementation
var
FMemSection: TRTLCriticalSection;
{******************************************************************************
函数名：GetMem
参数：P：接收内存地址的变量地址，
Size：内存大小
说明：为了防止多线程分配内存发生的互斥问题
******************************************************************************}
procedure GetMem(var P: Pointer; Size: Integer);
begin
EnterCriticalSection(FMemSection);
System.GetMem(P, Size);
LeaveCriticalSection(FMemSection);
end;
function ThreadProc(YThread: TYThread): Integer;
begin
Result := 0;
with YThread do
try
if not FTerminated then
begin
// 线程开始
OnThreadStart();
if Not FCreateSuspended then
// 告诉创建函数，线程就绪
SetEvent(FFinished);
// 线程执行
DoExecute();
// 线程结束
OnThreadFinished();
end;
// 设置完成标志
SetEvent(FFinished);
if FFreeOnTerminated then
//自杀
Destroy();

EndThread(Result);
except
end;
end;
{ TYThread }
constructor TYThread.Create(const CreateSuspended: Boolean);
begin
FFinished := CreateEvent(nil, True, False, nil);
FCreateSuspended := CreateSuspended;
FSleepTime := 1;
FWndHandle := AllocateHWnd(WndProc);
if (FCreateSuspended) then
FThreadHandle := BeginThread(nil, 0, @ThreadProc, Pointer(Self), CREATE_SUSPENDED, FThreadID)
else
FThreadHandle := BeginThread(nil, 0, @ThreadProc, Pointer(Self), 0, FThreadID);

inherited Create();
if Not FCreateSuspended then
begin
// 为了保证线程正常执行，完成线程内的初始化，所以等待线程执行后，函数才返回
WaitForFinished();
ResetEvent(FFinished);
end;
end;
destructor TYThread.Destroy();
begin
// 清自杀标志，因为是他杀
FFreeOnTerminated := False;
// 终止线程
Terminate();
// 等待线程结束
WaitForFinished();
// 释放自己分配的窗口句柄
if FIsMyWndHandle then
DeallocateHWnd(FWndHandle);
FWndHandle := 0;
inherited;
end;
{******************************************************************************
函数名：OnThreadStart
参数：无
说明：在线程体内完成初始化的函数，由于很多对象需要在线程体内初始化，才能达到线程
独占的目的，还有在本线程体内对函数体外的部分对象是无法使用的，所以很多对象必须在
线程体内初始化，所以设立本函数，便于初始化和继承
******************************************************************************}
procedure TYThread.OnThreadStart();
begin
FTerminated := ((FThreadID = 0) and (FThreadHandle = 0));
FSuspended := FTerminated;
FFreeOnTerminated := False;
FIsMyWndHandle := True;
end;
{******************************************************************************
函数名：OnThreadFinished
参数：无
说明：和OnThreadStart成对的，线程结束后在这里对线程独占对象进行释放等
******************************************************************************}
procedure TYThread.OnThreadFinished();
begin
end;
{******************************************************************************
函数名：OnThreadExecute
参数：无
说明：虚函数，线程工作的函数，在继承类里面，完成新类的工作任务
******************************************************************************}
procedure TYThread.OnThreadExecute;
begin
end;
{******************************************************************************
函数名：DoExecute
参数：无
说明：虚函数，线程工作的函数
******************************************************************************}
procedure TYThread.DoExecute();
var
Msg: TMsg;
WMsg: TMessage;
begin
while (Not FTerminated) do
begin
// 调用虚函数
OnThreadExecute();
if (Not FTerminated) then
begin
// 获取线程消息
if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) and (Not FTerminated) then
begin
WMsg.Msg := Msg.message;
WMsg.LParam := Msg.lParam;
WMsg.WParam := Msg.wParam;
// 解析线程消息
OnThreadMessage(WMsg);
end;
end;
Sleep(FSleepTime);
end;
end;
{******************************************************************************
函数名：GetPriority
参数：无
说明：取得线程权限
******************************************************************************}
function TYThread.GetPriority(): TThreadPriority;
var
P: Integer;
I: TThreadPriority;
begin
P := GetThreadPriority(FThreadHandle);
Result := tpNormal;
for I := Low(TThreadPriority) to High(TThreadPriority) do
if Priorities[I] = P then
Result := I;
end;
{******************************************************************************
函数名：Resume
参数：无
说明：线程继续
******************************************************************************}
function TYThread.Resume(): Boolean;
begin
Result := False;
if FSuspended then
try
Result := ResumeThread(FThreadHandle) = 1;
FSuspended := Not Result;
except
end;
end;
{******************************************************************************
函数名：SendThreadMsg
参数：Msg：消息，wParam，lParam：消息参数
说明：供外部使用的给线程发消息的函数
******************************************************************************}
procedure TYThread.SendThreadMsg(const Msg, wParam, lParam: DWord);
begin
PostThreadMessage(FThreadID, Msg, wParam, lParam);
end;
{******************************************************************************
函数名：SendWindowMsg
参数：Msg：消息，wParam，lParam：消息参数
说明：线程使用的给窗口句柄发消息的函数，由于线程对窗体直接操作，会遇到VCL限制，
为了同步，设立本函数，通过窗口消息的方式，大道同步目的
******************************************************************************}
procedure TYThread.SendWindowMsg(const Msg, wParam, lParam: DWord);
begin
PostMessage(FWndHandle, Msg, wParam, lParam);
end;
{******************************************************************************
函数名：SetPriority
参数：value: 新权限值
说明：
******************************************************************************}
procedure TYThread.SetPriority(const value: TThreadPriority);
begin
SetThreadPriority(FThreadHandle, Priorities[value]);
end;
{******************************************************************************
函数名：Suspend
参数：无
说明：线程挂起
******************************************************************************}
function TYThread.Suspend(): Boolean;
begin
try
FSuspended := True;
Result := SuspendThread(FThreadHandle) <> $FFFFFFFF;
FSuspended := Result;
except
Result := False;
end;
end;
{******************************************************************************
函数名：Synchronize
参数： Method：同步执行函数，Param：给执行函数发的参数
说明：线程同步函数，采用窗体消息的方式达到同步目的
******************************************************************************}
procedure TYThread.Synchronize(const Method: TThreadSyncMethod; const Param: DWord);
var
SP: TSyncParam;
begin
try
SP.Method := Method;
SP.Param := Param;
SP.Signal := CreateEvent(nil, True, False, nil);
SendWindowMsg(MSG_YTHREAD_SYNC, DWord(@SP), 0);
// 等待执行完毕
WaitForSingleObject(SP.Signal, INFINITE);
finally
CloseHandle(SP.Signal);
end;
end;
{******************************************************************************
函数名：Terminate
参数： 无
说明：为了安全结束线程，不易采用强行终止的方式，将线程结束标志设立，线程体内既
结束while循环，然后执行OnThreadFinished函数
******************************************************************************}
procedure TYThread.Terminate();
begin
FTerminated := True;
end;
{******************************************************************************
函数名：WaitForFinished
参数： 无
说明：等待线程安全结束
******************************************************************************}
procedure TYThread.WaitForFinished();
begin
WaitForSingleObject(FFinished, INFINITE);
end;
{******************************************************************************
函数名：OnMessage
参数： Msg：线程收到的Win消息
说明：虚函数，解析Win消息
******************************************************************************}
procedure TYThread.OnMessage(var Msg: TMessage);
begin
end;
{******************************************************************************
函数名：WndProc
参数： Msg：线程收到的Win消息
说明：解析线程的Win句柄消息
******************************************************************************}
procedure TYThread.WndProc(var Msg: TMessage);
begin
with Msg do
Result := DefWindowProc(FWndHandle, Msg, wParam, lParam);
with Msg do
begin
case Msg of
// 执行线程同步
MSG_YTHREAD_SYNC:
begin
with PSyncParam(wParam)^ do
begin
Method(Param);
SetEvent(Signal);
end;
end;
end;
end;
// 调用虚函数解析消息
OnMessage(Msg);
end;
{******************************************************************************
函数名：SetWndHandle
参数： Wnd：Window句柄
说明：设置本线程使用的window句柄，为了给予使用者或继承者方便，可改变Win句柄，
实现共同解析Win消息的功能。
******************************************************************************}
procedure TYThread.SetWndHandle(Wnd: HWnd);
begin
if (Wnd <> 0) then
begin
if FWndHandle <> 0 then
DeallocateHWnd(FWndHandle);
FIsMyWndHandle := False;
FWndHandle := Wnd;
end;
end;
{******************************************************************************
函数名：OnThreadMessage
参数： Msg：线程收到的消息
说明：虚函数，解析线程消息
******************************************************************************}
procedure TYThread.OnThreadMessage(var Msg: TMessage);
begin
end;
initialization
InitializeCriticalSection(FMemSection);
finalization
DeleteCriticalSection(FMemSection);
end.