delphi 线程实战用法

新版delphi，带有匿名函数功能，大大方便了使用者。

现使用匿名函数开发一个方便实用的线程类，简化线程调用。

1. uSyncObjs.pas,TSuperEvent对TEvent的改进

2. uThreadTList, 对TList的改进

3. uSuperThreadCommon.pas,公共类,继承TThreadList,带自动释放

4. uSuperThreadHelper.pas, 由TThread线程继承而来,一个方便的单独线程类,平时用它可以快速实现线程功能。

5. uSuperThreadWorker.pas, 继承于TSuperThreadHelper,也是TSuperThreadHelper线程的典型应用。

6. uSuperThread.pas ，对TSuperThreadHelper 的包装

本代码在delphi xe8 下编译通过，个人认为在xe2及以上版本都应能正常使用。

使用方法

TSuperThread 有两个函数:Queue,Synchronize

Queue:把匿名函数排队到线程去执行,马上返回。

Synchronize:把匿名函数 排队到线程，并等待此函数执行完毕。

虽说TThread本身自带这两个函数。但是，它是把匿名函数插到主线程去执行的。

本类是将匿名函数插入到一个线程中执行的，有本质上的区别。

SuperThread:=TSuperThread.Create; //在合适的时候创建

//排队执行
SuperThread.Queue( procedrue
begin
DoWhatYouWant;
Sleep(5000); //
end; );
//阻塞执行
SuperThread.Synchronize( procedrue
begin
DoWhatYouWant;
Sleep(5000); //
end; );

SuperThread.free; //在合适的时候释放

以下是源代码，欢迎交流。

unit uSyncObjs;

interface

uses
SyncObjs;

Type

TSuperEvent = class(TEvent)
public
constructor Create; reintroduce;
end;

implementation

{ TSuperEvent }
uses
SysUtils;

constructor TSuperEvent.Create;
var
BGUID: TGUID;
begin
CreateGUID(BGUID);
inherited Create(nil, true, false, GUIDToString(BGUID));
end;

end.

unit uThreadList;

interface

uses
Generics.Collections;

type

TThreadListX<T> = class(TList<T>)
private
function DoPopByIndex(Index: integer): T;
procedure FreeAllItem;
protected
FNeedFreeItem: boolean;
procedure FreeItem(Item: T); virtual;
public

constructor Create;
destructor Destroy; override;

procedure Lock;
procedure Unlock;

function PopFirst: T;
function PopLast: T;
function PopByIndex(Index: integer): T;

procedure ClearAndFreeItem;

end;

TThreadClassList<T: Class> = class(TThreadListX<T>)
protected
procedure FreeItem(Item: T); override;
end;

implementation

procedure TThreadListX<T>.ClearAndFreeItem;
begin
FreeAllItem;
clear;
end;

constructor TThreadListX<T>.Create;
begin
inherited;
FNeedFreeItem := true;
end;

destructor TThreadListX<T>.Destroy;
begin
FreeAllItem;
inherited;
end;

function TThreadListX<T>.DoPopByIndex(Index: integer): T;
begin
if (index >= 0) and (index <= count - 1) then
begin
result := items[index];
delete(index);
Exit;
end;
result := T(nil);
end;

procedure TThreadListX<T>.FreeAllItem;
var
Item: T;
begin
if FNeedFreeItem then
begin
for Item in self do
FreeItem(Item);
end;
end;

procedure TThreadListX<T>.FreeItem(Item: T);
begin
end;

procedure TThreadListX<T>.Lock;
begin
System.TMonitor.Enter(self);
end;

procedure TThreadListX<T>.Unlock;
begin
System.TMonitor.Exit(self);
end;

function TThreadListX<T>.PopByIndex(Index: integer): T;
begin
result := DoPopByIndex(index);
end;

function TThreadListX<T>.PopFirst: T;
begin
result := DoPopByIndex(0);
end;

function TThreadListX<T>.PopLast: T;
begin
result := DoPopByIndex(count - 1);
end;

{ TThreadClassList<T> }

procedure TThreadClassList<T>.FreeItem(Item: T);
begin
TObject(Item).Free;
end;

end.

unit uSuperThreadCommon;

interface

uses
Classes, uThreadList, uSyncObjs;

type

PSyncRec = ^TSyncRec;

TSyncRec = record
FMethod: TThreadMethod;
FProcedure: TThreadProcedure;
FSignal: TSuperEvent;
Queued: boolean;
end;

TSyncRecList = Class(TThreadListX<PSyncRec>)
protected
procedure FreeItem(Item: PSyncRec); override;
End;

implementation

{ TSyncRecList }

procedure TSyncRecList.FreeItem(Item: PSyncRec);
begin
if Assigned(Item.FSignal) then
Item.FSignal.Free;
dispose(Item);
end;

end.

unit uSuperThreadHelper;

interface

uses
System.Classes, System.SysUtils, System.SyncObjs;

type

TSuperThreadHelper = class(TThread)
public type

TObjectProc = TThreadMethod;
TAnonymousProc = TThreadProcedure;

private type
TProcKind = (pkObject, pkAnonymous);
private

FObjProc: TObjectProc;
FAnoProc: TAnonymousProc;
FProcKind: TProcKind;

FEvent: TEvent;

procedure SelfStart;

procedure DoExecute;

protected

FWaitStop: boolean;

procedure Execute; override;

procedure OnThreadProcErr(E: Exception); virtual;

public

constructor Create; reintroduce;
destructor Destroy; override;
procedure WaitThreadStop;

procedure ExeProcInThread(AProc: TObjectProc); overload;
procedure ExeProcInThread(AProc: TAnonymousProc); overload;

procedure StopThread;
property WaitStop: boolean read FWaitStop;

end;

implementation

constructor TSuperThreadHelper.Create;
var
BGUID: TGUID;
begin
inherited Create(false);
FreeOnTerminate := false;
CreateGUID(BGUID);
FEvent := TEvent.Create(nil, true, false, GUIDToString(BGUID));

end;

destructor TSuperThreadHelper.Destroy;
begin
WaitThreadStop;
FEvent.Free;
inherited;
end;

procedure TSuperThreadHelper.DoExecute;
begin
repeat

FEvent.WaitFor;
FEvent.ResetEvent; // 下次waitfor 一直等

if not Terminated then
begin

try

case FProcKind of
pkObject: FObjProc;
pkAnonymous: FAnoProc;
end;

except

on E: Exception do
begin
OnThreadProcErr(E);
end;

end;

end;

until Terminated;
end;

procedure TSuperThreadHelper.Execute;
begin
DoExecute;
end;

procedure TSuperThreadHelper.ExeProcInThread(AProc: TObjectProc);
begin
FObjProc := AProc;
FProcKind := pkObject;
SelfStart;
end;

procedure TSuperThreadHelper.ExeProcInThread(AProc: TAnonymousProc);
begin
FAnoProc := AProc;
FProcKind := pkAnonymous;
SelfStart;
end;

procedure TSuperThreadHelper.OnThreadProcErr(E: Exception);
begin;
end;

procedure TSuperThreadHelper.SelfStart;
begin
if FEvent.WaitFor(0) <> wrSignaled then
FEvent.SetEvent; // 让waitfor 不再等
end;

procedure TSuperThreadHelper.StopThread;
begin
FWaitStop := true;
end;

procedure TSuperThreadHelper.WaitThreadStop;
begin
StopThread;
Terminate;
SelfStart;
WaitFor;
end;

end.

unit uSuperThreadWorker;

interface

uses
classes, uSuperThreadHelper, uSuperThreadCommon;

type

TSuperThreadWorker = class(TSuperThreadHelper)
private
FSyncRecList: TSyncRecList;

procedure lock;
procedure Unlock;

procedure Check;
procedure DoCheck;

procedure SetSyncRecList(const Value: TSyncRecList);

public

property SyncRecList: TSyncRecList read FSyncRecList write SetSyncRecList;

procedure Queue(AMethod: TThreadMethod); overload;
procedure Queue(AProcedure: TThreadProcedure); overload;

procedure Synchronize(AMethod: TThreadMethod); overload;
procedure Synchronize(AProcedure: TThreadProcedure); overload;

constructor Create;
destructor Destroy; override;

end;

implementation

{ TSuperThreadInspector }
uses
uSyncObjs;

procedure TSuperThreadWorker.Check;
begin
ExeProcInThread(DoCheck);
end;

constructor TSuperThreadWorker.Create;
begin
inherited;
FSyncRecList := TSyncRecList.Create;
end;

destructor TSuperThreadWorker.Destroy;
begin
WaitThreadStop;
FSyncRecList.Free;
inherited;
end;

procedure TSuperThreadWorker.DoCheck;
var
p: PSyncRec;
begin

lock;
try
p := FSyncRecList.PopFirst;
finally
Unlock;
end;

if Assigned(p) then
begin

if Assigned(p.FMethod) then
p.FMethod
else if Assigned(p.FProcedure) then
p.FProcedure();

if not p.Queued then
begin
p.FSignal.SetEvent;
end;

Dispose(p);
Check;

end;

end;

procedure TSuperThreadWorker.lock;
begin
FSyncRecList.lock;
end;

procedure TSuperThreadWorker.Queue(AMethod: TThreadMethod);
var
p: PSyncRec;
begin
new(p);

p.FProcedure := nil;
p.FMethod := AMethod;
p.Queued := true;

lock;
try
FSyncRecList.Add(p);
Check;
finally
Unlock;
end;

end;

procedure TSuperThreadWorker.Queue(AProcedure: TThreadProcedure);
var
p: PSyncRec;
begin
new(p);
p.FProcedure := AProcedure;
p.FMethod := nil;
p.Queued := true;
lock;
try
FSyncRecList.Add(p);
Check;
finally
Unlock;
end;
end;

procedure TSuperThreadWorker.SetSyncRecList(const Value: TSyncRecList);
begin
FSyncRecList := Value;
end;

procedure TSuperThreadWorker.Synchronize(AMethod: TThreadMethod);
var
p: PSyncRec;
o: TSuperEvent;
begin
new(p);

p.FProcedure := nil;
p.FMethod := AMethod;
p.Queued := false;
p.FSignal := TSuperEvent.Create;
p.FSignal.ResetEvent;
o := p.FSignal;

lock;
try
FSyncRecList.Add(p);
Check;
finally
Unlock;
end;

o.WaitFor;
o.Free;

end;

procedure TSuperThreadWorker.Synchronize(AProcedure: TThreadProcedure);
var
p: PSyncRec;
o: TSuperEvent;
begin
new(p);

p.FProcedure := AProcedure;
p.FMethod := nil;
p.Queued := false;
p.FSignal := TSuperEvent.Create;
p.FSignal.ResetEvent;
o := p.FSignal;

lock;
try
FSyncRecList.Add(p);
Check;
finally
Unlock;
end;

o.WaitFor;
o.Free;

end;

procedure TSuperThreadWorker.Unlock;
begin
FSyncRecList.Unlock;
end;

end.

unit uSuperThread;

interface

uses
Classes, uSuperThreadWorker;

type

TSuperThread = class
private
FSuperThreadWorker: TSuperThreadWorker;
public

constructor Create;
destructor Destroy; override;

procedure Queue(AMethod: TThreadMethod); overload;
procedure Queue(AProcedure: TThreadProcedure); overload;

procedure Synchronize(AMethod: TThreadMethod); overload;
procedure Synchronize(AProcedure: TThreadProcedure); overload;

end;

implementation

{ TSuperThread }

constructor TSuperThread.Create;
begin
inherited;
FSuperThreadWorker := TSuperThreadWorker.Create;
end;

destructor TSuperThread.Destroy;
begin
FSuperThreadWorker.WaitThreadStop;
FSuperThreadWorker.Free;
inherited;
end;

procedure TSuperThread.Queue(AMethod: TThreadMethod);
begin
FSuperThreadWorker.Queue(AMethod);
end;

procedure TSuperThread.Queue(AProcedure: TThreadProcedure);
begin
FSuperThreadWorker.Queue(AProcedure);
end;

procedure TSuperThread.Synchronize(AMethod: TThreadMethod);
begin
FSuperThreadWorker.Synchronize(AMethod);
end;

procedure TSuperThread.Synchronize(AProcedure: TThreadProcedure);
begin
FSuperThreadWorker.Synchronize(AProcedure);
end;

end.