我也写了一个这样的东西，先是代码：
unit uScopeGuard;
interface
uses
SysUtils, Classes, Contnrs;
type
TShenMethod = record
Code, Sender, Data: Pointer;
T: Integer;
end;
TShenMethodDynArray = array of TShenMethod;
TObjProcedure = procedure (Sender: TObject);
TObjectGuard = class;
IScopeGuard = interface
['{7561A2E9-F368-429F-9982-BCFFACC32573}']
function CreateObject(AObject: TObject): TObject;
function CreateSubScopeGuard: IScopeGuard;
procedure Add(AObject: TObjectGuard);
procedure Clear;
procedure DismissAll;
procedure Remove(AObject: TObjectGuard);
end;
TScopeGuard = class(TInterfacedObject, IScopeGuard)
private
FStack: TStack;
protected
procedure Clear; virtual;
public
constructor Create;
destructor Destroy; override;
function CreateObject(AObject: TObject): TObject;
function CreateSubScopeGuard: IScopeGuard;
procedure Add(AObject: TObjectGuard);
procedure DismissAll;
procedure Remove(AObject: TObjectGuard);
end;
TObjectGuard = class
private
FDismiss: Boolean;
protected
FMethods: TShenMethodDynArray;
constructor InternalCreate;
procedure AddMethods(M: TShenMethodDynArray); virtual;
public
constructor Create;
destructor Destroy; override;
procedure CleanUp; virtual;
procedure Dismiss;
end;
TObjectGuardFactory = class
public
class function Make(M: TShenMethod): TObjectGuard; overload;
class function Make(M: array of TShenMethod): TObjectGuard; overload;
end;
ISG = IScopeGuard;
TSG = TScopeGuard;
TOG = TObjectGuard;
TOGF = TObjectGuardFactory;
function MakeMethod(const Code: PLongint; const Sender: Pointer = nil; const Data: Pointer = nil): TShenMethod; overload;
function MakeMethod(const Code: TProcedure): TShenMethod; overload;
function MakeMethod(const Code: TObjProcedure; const Sender: TObject): TShenMethod; overload;
function MakeMethod(const Code: TNotifyEvent; const Sender, Data: TObject): TShenMethod; overload;
function MakeMethod(const Code: TThreadMethod; const Sender: TObject): TShenMethod; overload;
function MakeFreeAndNil(var P): TShenMethod;
function MakeAssignOrd(var Dest; const Src: Integer): TShenMethod;
function MakeAssignStr(var Dest: string; const Src: string): TShenMethod;
procedure CallMethod(const M: TShenMethod); overload;
implementation
const
SMNormal = 0;
SMFreeAndNil = 1;
SMAssignOrd = 2;
SMAssignStr = 3;
function MakeMethod(const Code: PLongint; const Sender, Data: Pointer): TShenMethod;
begin
Result.Code := Code;
Result.Sender := Sender;
Result.Data := Data;
Result.T := SMNormal;
end;
function MakeMethod(const Code: TProcedure): TShenMethod;
begin
Result := MakeMethod(PLongint(@Code));
end;
function MakeMethod(const Code: TObjProcedure; const Sender: TObject): TShenMethod;
begin
Result := MakeMethod(PLongint(@Code), Sender);
end;
function MakeMethod(const Code: TNotifyEvent; const Sender, Data: TObject): TShenMethod;
begin
Result := MakeMethod(PLongint(@Code), Sender, Data);
end;
function MakeMethod(const Code: TThreadMethod; const Sender: TObject): TShenMethod;
begin
Result := MakeMethod(PLongint(@Code), Sender);
end;
function MakeFreeAndNil(var P): TShenMethod;
begin
Result.Code := nil;
Result.Sender := nil;
Result.Data := @P;
Result.T := SMFreeAndNil;
end;
function MakeAssignOrd(var Dest; const Src: Integer): TShenMethod;
begin
Result.Code := nil;
Result.Sender := Pointer(Src);
Result.Data := @Dest;
Result.T := SMAssignOrd;
end;
function MakeAssignStr(var Dest: string; const Src: string): TShenMethod;
begin
Result.Code := nil;
Result.Sender := PChar(Src);
Result.Data := PChar(@Dest);
Result.T := SMAssignStr;
end;
procedure CallMethodNormal(const M: TShenMethod);
asm
CMP M.Code, 0;
JZ @@end;
MOV ECX, EAX;
MOV EAX, [ECX].TShenMethod.Sender;
MOV EDX, [ECX].TShenMethod.Data;
Call [ECX].TShenMethod.Code;
@@end:
end;
procedure CallMethodFreeAndNil(const M: TShenMethod);
begin
FreeAndNil((M.Data)^);
end;
procedure CallMethodAssignOrd(const M: TShenMethod);
begin
PLongint(M.Data)^ := Longint(M.Sender);
end;
procedure CallMethodAssignStr(const M: TShenMethod);
var
s: string;
begin
s := StrPas(M.Sender);
PChar((M.Data)^) := PChar(s);
end;
procedure CallMethod(const M: TShenMethod);
begin
case M.T of
SMNormal: CallMethodNormal(M);
SMFreeAndNil: CallMethodFreeAndNil(M);
SMAssignOrd: CallMethodAssignOrd(M);
SMAssignStr: CallMethodAssignStr(M);
end;
end;
{ TScopeGuard }
type TStackAccess = class(TStack);
procedure TScopeGuard.Add(AObject: TObjectGuard);
begin
FStack.Push(AObject);
end;
procedure TScopeGuard.Clear;
var
AObject: TObject;
begin
while FStack.Count > 0 do
begin
AObject := FStack.Pop;
if Assigned(AObject) then
begin
AObject.Free;
end;
end;
end;
constructor TScopeGuard.Create;
begin
inherited Create;
FStack := TStack.Create;
end;
function TScopeGuard.CreateObject(AObject: TObject): TObject;
begin
Result := AObject;
Add(TObjectGuardFactory.Make(MakeMethod(Result.Free, Result)));
end;
function TScopeGuard.CreateSubScopeGuard: IScopeGuard;
begin
Result := TScopeGuard.Create;
end;
destructor TScopeGuard.Destroy;
begin
Clear;
FStack.Free;
inherited;
end;
procedure TScopeGuard.DismissAll;
var
i: Integer;
AObject: TObjectGuard;
begin
with TStackAccess(FStack).List do
begin
for i := Count - 1 downto 0 do
begin
AObject := Items[i];
AObject.Dismiss;
end;
end;
end;
procedure TScopeGuard.Remove(AObject: TObjectGuard);
begin
TStackAccess(FStack).List.Remove(AObject); // Do not free AObject
end;
{ TObjectGuard }
procedure TObjectGuard.AddMethods(M: TShenMethodDynArray);
var
i, OldLen, MLen: Integer;
begin
MLen := Length(M);
if MLen > 0 then
begin
OldLen := Length(FMethods);
SetLength(FMethods, OldLen + MLen);
for i := 0 to MLen - 1 do
begin
FMethods[OldLen + i] := M[i];
end;
end;
end;
procedure TObjectGuard.CleanUp;
var
i: Integer;
begin
for i := 0 to Length(FMethods) - 1 do
begin
CallMethod(FMethods[i]);
end;
end;
constructor TObjectGuard.Create;
begin
raise Exception.Create('Please use TObjectGuardFactory.make instead of TObjectGuard.Create');
end;
destructor TObjectGuard.Destroy;
begin
if not FDismiss then CleanUp;
inherited;
end;
procedure TObjectGuard.Dismiss;
begin
FDismiss := True;
end;
constructor TObjectGuard.InternalCreate;
begin
inherited Create;
end;
{ TObjectGuardFactory }
class function TObjectGuardFactory.Make(M: TShenMethod): TObjectGuard;
var
_M: TShenMethodDynArray;
begin
Result := TObjectGuard.InternalCreate;
SetLength(_M, 1);
_M[0] := M;
Result.AddMethods(_M);
end;
class function TObjectGuardFactory.Make(M: array of TShenMethod): TObjectGuard;
var
_M: TShenMethodDynArray;
I, Count: Integer;
begin
Result := nil;
Count := Length(M);
if Count <= 0 then Exit;
Result := TObjectGuard.InternalCreate;
SetLength(_M, Count);
for I := 0 to Count - 1 do _M[I] := M[I];
Result.AddMethods(_M);
end;
end.
