时间关系,不废话了unit GC32 deprecated;{
基本说明:
=============
IGC32是一个负责记录一个函数过程中创建的对象,并在函数退出前自动清理这些被记录的
对象。IGC32实现为object。
用法:
=============
procedure Usage;
var
Obj1: TAnyObject;
GC: IGC32;
begin
//无需在函数一开始时执行类似于:
//GC := ....Create()
//或者
//GC.Init
//的代码
Obj1 := TAnyObject.Create(aParam);
GC.RegisterObject(Obj1); //直接调用RegisterObject方法
DoSomeThingWith(Obj1);
//注册到GC中的Obj1在函数退出前自动释放
end;
关键思路:
=============
1.判断object/record是否已经初始化,为object/record添加一个生存期自管理自段,Delphi
会初始化该字段为nil或0,如果为nil/0则初始化object,初始化object时将这个生存期自管理
对象设为非0值
2.清除对象时,只需重载CustomVariant的
procedure Clear(var V: TVarData); override;
函数,使其清理object所记录的对象
注意事项:
=============
1. 本单元已经不再使用了,原因是
(a).使用了非常规的技巧,不适宜大规模使用
(b).object类型是为兼容而保留的类型(实际上可以用record代替)
2. 对象只能/也应该在函数体内使用,不应/不能传递到函数体外,非线程安全
3. 本对象(IGC32)不能被继承
声明:
=============
1. 如有雷同,纯属巧合
2. 只经过简单测试
3. 公开供任意用途,无任何担保
alphax, 2005.02
}interface
uses
SysUtils, Classes, Windows, Variants;const
GC32_BLOCK_CAPACITY = 32; //每次申请32个slot供储存对象用 //对于32位代码,不能增大这个数值 GC32_ALL_SLOT_USED = LongWord(0);
GC32_ALL_SLOT_FREE = not GC32_ALL_SLOT_USED;type
TGC32ItemType = (
gc32_FREE,
gc32_OBJECT,
gc32_GET_MEM,
gc32_HANDLE,
gc32_LOCAL_ALLOC,
gc32_GLOBAL_ALLOC,
gc32_PSID
);
TGC32ItemRec = record
case TGC32ItemType of
gc32_FREE: (Any: Pointer);
gc32_OBJECT: (Obj: TObject);
gc32_GET_MEM: (Mem: Pointer);
gc32_HANDLE: (Handle: THandle);
gc32_LOCAL_ALLOC: (LocalAlloc: THandle);
gc32_GLOBAL_ALLOC: (GlobalAlloc: THandle);
gc32_PSID: (SIDPtr: PSID);
end; TGC32Item = object
ItemData: TGC32ItemRec;
procedure Free(aType: TGC32ItemType);
procedure Remove;
end; TGC32ItemTypes = array[0..GC32_BLOCK_CAPACITY-1] of TGC32ItemType; //32 bytes
TGC32Items = array[0..GC32_BLOCK_CAPACITY-1] of TGC32Item; //128 bytes PGC32Block = ^TGC32Block;
TGC32Block = object
public
Prev: PGC32Block;
Next: PGC32Block;
MaxIndex: Integer;
FreeFlag: LongWord;
ItemTypes: TGC32ItemTypes;
Items: TGC32Items;
procedure Init(aPrev: PGC32Block);
function SetItem(
const aItemType: TGC32ItemType;
const aItem: Pointer): Boolean;
function SetItemLast(
const aItemType: TGC32ItemType;
const aItem: Pointer): Boolean;
function FreeItem(
const aItemType: TGC32ItemType;
const aItem: Pointer
): Boolean;
function RemoveItem(
const aItemType: TGC32ItemType;
const aItem: Pointer
): Boolean;
procedure CleanUp;
end; //176 bytes (on Delphi 7) //注意,本对象不能传递给其他过程/函数,非线程安全
IGC32 = object
private
Ordered: Boolean;
AutoDestroy: Variant;
LastBlock: PGC32Block;
FirstBlock: TGC32Block; //第一个块分配在栈上
procedure RegisterAny(const aItemType: TGC32ItemType; const aItem: Pointer);
procedure FreeAny(const aItemType: TGC32ItemType; const aItem: Pointer);
procedure RemoveAny(const aItemType: TGC32ItemType; const aItem: Pointer);
public
procedure Init; //不需显式调用该函数
procedure InitOrdered; //当对象的释放顺序是有要求的时候,应该在函数开始时就调用InitOrdered
procedure FreeAll; //释放所有被记录的对象 procedure RegisterObject(aObj: TObject);
procedure RemoveObject(aObj: TObject);
procedure FreeObject(var aObj);
procedure RegisterGetMem(aMem: Pointer);
procedure FreeMem(var aMem: Pointer);
procedure RegisterHandle(aHandle: THandle);
procedure CloseHandle(aHandle: THandle);
procedure RegisterLocalAlloc(aLocalAlloc: THandle);
procedure LocalFree(aLocalAlloc: THandle);
procedure RegisterGlobalAlloc(aGlobalAlloc: THandle);
procedure GlobalFree(aGlobalAlloc: THandle);
procedure RegisterPSID(aPSID: PSID);
procedure FreeSID(var aPSID: PSID); function CreateList: TList;
procedure Create2List(out aList1, aList2: TList); function CreateStringList(const aCaseSensitive: Boolean = True): TStringList;
procedure Create2StrList(out aStrList1, aStrList2: TStringList);// function CreateMemStr: TChillsMemStr;
// procedure Create2MemStr(out aMemStr1, aMemStr2: TChillsMemStr);// function CreateFileStr(const aFileName: string; const aMode: Word): TChillsFileStream;// function CreateDeleteFile(
// const aFileName: string;
// const aExceptionOnDelete: Boolean): TDeleteFileObject;// procedure CreateComponent(aComponentClass: TComponentClass; var aComp; aOwner: TComponent);// function CreateExplicitTrans(aTransaction: TObject): TTransDelegate;
// function PushScreenCursor(aNewCursor: TCursor): TScrCursorHolder;
// function PushScreenCursorSQLWait: TScrCursorHolder;
// function CreateDSBook(aDS: TDataSet; const aDisableControls: Boolean): TDSBook;
//注意,需要对GetMem/AllocMem返回的内存块执行ReallocMem时,必须使用本对象的ReallocMem方法
function GetMem(const aSize: Integer): Pointer;
function AllocMem(const aSize: Integer): Pointer;
procedure ReallocMem(var aPtr: Pointer; aSize: Integer);
end; //196 bytes (on Delphi 7)
PGC32 = ^IGC32;
TGCVarData = packed record
VType: TVarType;
Reserved1, Reserved2, Reserved3: Word;
GCObj: PGC32; //指向IGC32对象
Reserved4: LongWord;
end; //自定义Variant类型
TGCVariantType = class(TCustomVariantType)
public
procedure Clear(var V: TVarData); override; //清理工作
procedure Copy(var Dest: TVarData; const Source: TVarData;
const Indirect: Boolean); override; //禁止传递
end;var
GCVariantType: TGCVariantType;
基本说明:
=============
IGC32是一个负责记录一个函数过程中创建的对象,并在函数退出前自动清理这些被记录的
对象。IGC32实现为object。
用法:
=============
procedure Usage;
var
Obj1: TAnyObject;
GC: IGC32;
begin
//无需在函数一开始时执行类似于:
//GC := ....Create()
//或者
//GC.Init
//的代码
Obj1 := TAnyObject.Create(aParam);
GC.RegisterObject(Obj1); //直接调用RegisterObject方法
DoSomeThingWith(Obj1);
//注册到GC中的Obj1在函数退出前自动释放
end;
关键思路:
=============
1.判断object/record是否已经初始化,为object/record添加一个生存期自管理自段,Delphi
会初始化该字段为nil或0,如果为nil/0则初始化object,初始化object时将这个生存期自管理
对象设为非0值
2.清除对象时,只需重载CustomVariant的
procedure Clear(var V: TVarData); override;
函数,使其清理object所记录的对象
注意事项:
=============
1. 本单元已经不再使用了,原因是
(a).使用了非常规的技巧,不适宜大规模使用
(b).object类型是为兼容而保留的类型(实际上可以用record代替)
2. 对象只能/也应该在函数体内使用,不应/不能传递到函数体外,非线程安全
3. 本对象(IGC32)不能被继承
声明:
=============
1. 如有雷同,纯属巧合
2. 只经过简单测试
3. 公开供任意用途,无任何担保
alphax, 2005.02
}interface
uses
SysUtils, Classes, Windows, Variants;const
GC32_BLOCK_CAPACITY = 32; //每次申请32个slot供储存对象用 //对于32位代码,不能增大这个数值 GC32_ALL_SLOT_USED = LongWord(0);
GC32_ALL_SLOT_FREE = not GC32_ALL_SLOT_USED;type
TGC32ItemType = (
gc32_FREE,
gc32_OBJECT,
gc32_GET_MEM,
gc32_HANDLE,
gc32_LOCAL_ALLOC,
gc32_GLOBAL_ALLOC,
gc32_PSID
);
TGC32ItemRec = record
case TGC32ItemType of
gc32_FREE: (Any: Pointer);
gc32_OBJECT: (Obj: TObject);
gc32_GET_MEM: (Mem: Pointer);
gc32_HANDLE: (Handle: THandle);
gc32_LOCAL_ALLOC: (LocalAlloc: THandle);
gc32_GLOBAL_ALLOC: (GlobalAlloc: THandle);
gc32_PSID: (SIDPtr: PSID);
end; TGC32Item = object
ItemData: TGC32ItemRec;
procedure Free(aType: TGC32ItemType);
procedure Remove;
end; TGC32ItemTypes = array[0..GC32_BLOCK_CAPACITY-1] of TGC32ItemType; //32 bytes
TGC32Items = array[0..GC32_BLOCK_CAPACITY-1] of TGC32Item; //128 bytes PGC32Block = ^TGC32Block;
TGC32Block = object
public
Prev: PGC32Block;
Next: PGC32Block;
MaxIndex: Integer;
FreeFlag: LongWord;
ItemTypes: TGC32ItemTypes;
Items: TGC32Items;
procedure Init(aPrev: PGC32Block);
function SetItem(
const aItemType: TGC32ItemType;
const aItem: Pointer): Boolean;
function SetItemLast(
const aItemType: TGC32ItemType;
const aItem: Pointer): Boolean;
function FreeItem(
const aItemType: TGC32ItemType;
const aItem: Pointer
): Boolean;
function RemoveItem(
const aItemType: TGC32ItemType;
const aItem: Pointer
): Boolean;
procedure CleanUp;
end; //176 bytes (on Delphi 7) //注意,本对象不能传递给其他过程/函数,非线程安全
IGC32 = object
private
Ordered: Boolean;
AutoDestroy: Variant;
LastBlock: PGC32Block;
FirstBlock: TGC32Block; //第一个块分配在栈上
procedure RegisterAny(const aItemType: TGC32ItemType; const aItem: Pointer);
procedure FreeAny(const aItemType: TGC32ItemType; const aItem: Pointer);
procedure RemoveAny(const aItemType: TGC32ItemType; const aItem: Pointer);
public
procedure Init; //不需显式调用该函数
procedure InitOrdered; //当对象的释放顺序是有要求的时候,应该在函数开始时就调用InitOrdered
procedure FreeAll; //释放所有被记录的对象 procedure RegisterObject(aObj: TObject);
procedure RemoveObject(aObj: TObject);
procedure FreeObject(var aObj);
procedure RegisterGetMem(aMem: Pointer);
procedure FreeMem(var aMem: Pointer);
procedure RegisterHandle(aHandle: THandle);
procedure CloseHandle(aHandle: THandle);
procedure RegisterLocalAlloc(aLocalAlloc: THandle);
procedure LocalFree(aLocalAlloc: THandle);
procedure RegisterGlobalAlloc(aGlobalAlloc: THandle);
procedure GlobalFree(aGlobalAlloc: THandle);
procedure RegisterPSID(aPSID: PSID);
procedure FreeSID(var aPSID: PSID); function CreateList: TList;
procedure Create2List(out aList1, aList2: TList); function CreateStringList(const aCaseSensitive: Boolean = True): TStringList;
procedure Create2StrList(out aStrList1, aStrList2: TStringList);// function CreateMemStr: TChillsMemStr;
// procedure Create2MemStr(out aMemStr1, aMemStr2: TChillsMemStr);// function CreateFileStr(const aFileName: string; const aMode: Word): TChillsFileStream;// function CreateDeleteFile(
// const aFileName: string;
// const aExceptionOnDelete: Boolean): TDeleteFileObject;// procedure CreateComponent(aComponentClass: TComponentClass; var aComp; aOwner: TComponent);// function CreateExplicitTrans(aTransaction: TObject): TTransDelegate;
// function PushScreenCursor(aNewCursor: TCursor): TScrCursorHolder;
// function PushScreenCursorSQLWait: TScrCursorHolder;
// function CreateDSBook(aDS: TDataSet; const aDisableControls: Boolean): TDSBook;
//注意,需要对GetMem/AllocMem返回的内存块执行ReallocMem时,必须使用本对象的ReallocMem方法
function GetMem(const aSize: Integer): Pointer;
function AllocMem(const aSize: Integer): Pointer;
procedure ReallocMem(var aPtr: Pointer; aSize: Integer);
end; //196 bytes (on Delphi 7)
PGC32 = ^IGC32;
TGCVarData = packed record
VType: TVarType;
Reserved1, Reserved2, Reserved3: Word;
GCObj: PGC32; //指向IGC32对象
Reserved4: LongWord;
end; //自定义Variant类型
TGCVariantType = class(TCustomVariantType)
public
procedure Clear(var V: TVarData); override; //清理工作
procedure Copy(var Dest: TVarData; const Source: TVarData;
const Indirect: Boolean); override; //禁止传递
end;var
GCVariantType: TGCVariantType;
const
BIT0 = LongWord($00000001);
BIT1 = BIT0 SHL 1;
BIT2 = BIT0 SHL 2;
BIT3 = BIT0 SHL 3;
BIT4 = BIT0 SHL 4;
BIT5 = BIT0 SHL 5;
BIT6 = BIT0 SHL 6;
BIT7 = BIT0 SHL 7;
BIT8 = BIT0 SHL 8;
BIT9 = BIT0 SHL 9;
BIT10 = BIT0 SHL 10;
BIT11 = BIT0 SHL 11;
BIT12 = BIT0 SHL 12;
BIT13 = BIT0 SHL 13;
BIT14 = BIT0 SHL 14;
BIT15 = BIT0 SHL 15;
BIT16 = BIT0 SHL 16;
BIT17 = BIT0 SHL 17;
BIT18 = BIT0 SHL 18;
BIT19 = BIT0 SHL 19;
BIT20 = BIT0 SHL 20;
BIT21 = BIT0 SHL 21;
BIT22 = BIT0 SHL 22;
BIT23 = BIT0 SHL 23;
BIT24 = BIT0 SHL 24;
BIT25 = BIT0 SHL 25;
BIT26 = BIT0 SHL 26;
BIT27 = BIT0 SHL 27;
BIT28 = BIT0 SHL 28;
BIT29 = BIT0 SHL 29;
BIT30 = BIT0 SHL 30;
BIT31 = BIT0 SHL 31;
const
BITS_ARRAY: array[0..31] of LongWord = (
BIT0, BIT1, BIT2, BIT3, BIT4, BIT5, BIT6, BIT7,
BIT8, BIT9, BIT10, BIT11, BIT12, BIT13, BIT14, BIT15,
BIT16, BIT17, BIT18, BIT19, BIT20, BIT21, BIT22, BIT23,
BIT24, BIT25, BIT26, BIT27, BIT28, BIT29, BIT30, BIT31
);
{ TGCVariantType }procedure TGCVariantType.Clear(var V: TVarData);
var
GCObj: PGC32;
begin
V.VType := varEmpty;
GCObj := TGCVarData(V).GCObj;
if GCObj <> nil then
GCObj^.FreeAll();
end;procedure TGCVariantType.Copy(var Dest: TVarData; const Source: TVarData;
const Indirect: Boolean);
begin
RaiseInvalidOp();
end;{ IGC32 }procedure IGC32.FreeAll;
var
Block, Prev: PGC32Block;
begin
Block := LastBlock;
repeat
Block^.CleanUp();
Prev := Block;
Block := Block^.Prev;
//如果不是首块,则释放它
if Block <> nil then
Dispose(Prev);
until Block = nil; LastBlock := Prev;
LastBlock^.Next := nil;
end;function CreateGCVar(aGC: PGC32): Variant;
begin
VarClear(Result);
TGCVarData(Result).VType := GCVariantType.VarType;
TGCVarData(Result).GCObj := aGC;
end;procedure IGC32.CloseHandle(aHandle: THandle);
begin
FreeAny(gc32_HANDLE, Pointer(aHandle));
end;procedure IGC32.FreeAny(const aItemType: TGC32ItemType;
const aItem: Pointer);
var
Block: PGC32Block;
begin
Block := LastBlock;
repeat
if Block^.FreeItem(aItemType, aItem) then
Exit; Block := Block^.Prev;
until Block = nil; Assert(False, '企图释放一个未注册的自动回收项');
end;procedure IGC32.FreeMem(var aMem: Pointer);
begin
FreeAny(gc32_GET_MEM, aMem);
aMem := nil;
end;procedure IGC32.FreeObject(var aObj);
begin
FreeAny(gc32_OBJECT, Pointer(aObj));
Pointer(aObj) := nil;
end;procedure IGC32.FreeSID(var aPSID: PSID);
begin
FreeAny(gc32_PSID, aPSID);
aPSID := nil;
end;procedure IGC32.GlobalFree(aGlobalAlloc: THandle);
begin
FreeAny(gc32_GLOBAL_ALLOC, Pointer(aGlobalAlloc));
end;procedure IGC32.Init;
begin
if TGCVarData(AutoDestroy).VType = 0 then
begin
Ordered := False;
TGCVarData(AutoDestroy).VType := GCVariantType.VarType;
TGCVarData(AutoDestroy).GCObj := @Self;
FirstBlock.Init(nil);
LastBlock := @FirstBlock;
end;
end;procedure IGC32.LocalFree(aLocalAlloc: THandle);
begin
FreeAny(gc32_LOCAL_ALLOC, Pointer(aLocalAlloc));
end;procedure IGC32.RegisterAny(const aItemType: TGC32ItemType;
const aItem: Pointer);
var
Block: PGC32Block; procedure EInvalidParam;
begin
raise Exception.Create('无效的参数');
// raise EChillsLibrary.CreateWithErrCode(ErrCode_InvalidParam);
end;begin
Init();
case aItemType of
gc32_FREE: EInvalidParam();
gc32_OBJECT, gc32_GET_MEM, gc32_PSID,
gc32_HANDLE, gc32_LOCAL_ALLOC, gc32_GLOBAL_ALLOC:
if aItem = nil then
EInvalidParam();
else
Assert(False);
end;
if not Ordered then
begin
Block := LastBlock;
repeat
if Block^.SetItem(aItemType, aItem) then
Exit;
Block := Block^.Prev;
until Block = nil;
end
else
begin
Block := LastBlock;
repeat
if Block^.SetItemLast(aItemType, aItem) then
Exit; Block := Block^.Prev;
until Block = nil;
end; New(Block);
Block^.Init(LastBlock);
LastBlock^.Next := Block;
LastBlock := Block;
Block^.SetItem(aItemType, aItem);
end;procedure IGC32.RegisterGetMem(aMem: Pointer);
begin
RegisterAny(gc32_GET_MEM, aMem);
end;procedure IGC32.RegisterGlobalAlloc(aGlobalAlloc: THandle);
begin
RegisterAny(gc32_GLOBAL_ALLOC, Pointer(aGlobalAlloc));
end;procedure IGC32.RegisterHandle(aHandle: THandle);
begin
RegisterAny(gc32_HANDLE, Pointer(aHandle));
end;procedure IGC32.RegisterLocalAlloc(aLocalAlloc: THandle);
begin
RegisterAny(gc32_LOCAL_ALLOC, Pointer(aLocalAlloc));
end;procedure IGC32.RegisterObject(aObj: TObject);
begin
RegisterAny(gc32_OBJECT, aObj);
end;procedure IGC32.RegisterPSID(aPSID: PSID);
begin
RegisterAny(gc32_PSID, aPSID);
end;function IGC32.AllocMem(const aSize: Integer): Pointer;
begin
Result := SysUtils.AllocMem(aSize);
RegisterAny(gc32_GET_MEM, Result);
end;procedure IGC32.Create2List(out aList1, aList2: TList);
begin
aList1 := TList.Create();
RegisterAny(gc32_OBJECT, aList1); aList2 := TList.Create();
RegisterAny(gc32_OBJECT, aList2);
end;
procedure IGC32.Create2StrList(out aStrList1, aStrList2: TStringList);
begin
aStrList1 := TStringList.Create();
RegisterAny(gc32_OBJECT, aStrList1); aStrList2 := TStringList.Create();
RegisterAny(gc32_OBJECT, aStrList2);
end;
function IGC32.CreateList: TList;
begin
Result := TList.Create();
RegisterAny(gc32_OBJECT, Result);
end;function IGC32.CreateStringList(
const aCaseSensitive: Boolean): TStringList;
begin
Result := TStringList.Create();
RegisterAny(gc32_OBJECT, Result);
Result.CaseSensitive := aCaseSensitive;
end;function IGC32.GetMem(const aSize: Integer): Pointer;
begin
System.GetMem(Result, aSize);
RegisterAny(gc32_GET_MEM, Result);
end;procedure IGC32.ReallocMem(var aPtr: Pointer; aSize: Integer);
begin
if aPtr <> nil then
FreeAny(gc32_GET_MEM, aPtr); aPtr := GetMem(aSize);
end;procedure IGC32.RemoveAny(const aItemType: TGC32ItemType;
const aItem: Pointer);
var
Block: PGC32Block;
begin
Block := LastBlock;
repeat
if Block^.RemoveItem(aItemType, aItem) then
Exit; Block := Block^.Prev;
until Block = nil; Assert(False, '企图移除一个未注册的自动回收项');
end;procedure IGC32.RemoveObject(aObj: TObject);
begin
RemoveAny(gc32_OBJECT, aObj);
end;procedure IGC32.InitOrdered;
begin
Init();
Ordered := True;
end;
begin
case aType of
gc32_FREE: ;
gc32_OBJECT: ItemData.Obj.Free();
gc32_GET_MEM: FreeMem(ItemData.Mem);
gc32_HANDLE: if ItemData.Handle <> 0 then CloseHandle(ItemData.Handle);
gc32_LOCAL_ALLOC: LocalFree(ItemData.LocalAlloc);
gc32_GLOBAL_ALLOC: GlobalFree(ItemData.GlobalAlloc);
gc32_PSID: FreeSid(ItemData.SIDPtr);
else
Assert(False);
end; ItemData.Any := nil;
end;
procedure TGC32Item.Remove;
begin
ItemData.Any := nil;
end;{ TGC32Block }procedure TGC32Block.CleanUp;
var
I: Integer;
begin
if FreeFlag = GC32_ALL_SLOT_FREE then
Exit; //从后面开始清除
for I := MaxIndex downto 0 do
begin
if ItemTypes[I] <> gc32_FREE then
begin
Items[I].Free(ItemTypes[I]);
ItemTypes[I] := gc32_FREE;
end;
end;
MaxIndex := -1;
FreeFlag := GC32_ALL_SLOT_FREE;
end;function TGC32Block.FreeItem(const aItemType: TGC32ItemType;
const aItem: Pointer): Boolean;
var
I: Integer;
begin
Result := False; if FreeFlag = GC32_ALL_SLOT_FREE then
Exit; for I := MaxIndex downto 0 do
//注意,指针相同不一定就是要释放的项,因为有些项存储的不一定是指针,有些是Handle
if (Items[I].ItemData.Any = aItem) and (ItemTypes[I] = aItemType) then
begin
FreeFlag := FreeFlag or BITS_ARRAY[I]; //set free flag
ItemTypes[I] := gc32_FREE;
Items[I].Free(aItemType);
Result := True;
if I = MaxIndex then
Dec(MaxIndex);
Exit;
end;
end;procedure TGC32Block.Init(aPrev: PGC32Block);
var
I: Integer;
begin
Prev := aPrev;
Next := nil;
FreeFlag := GC32_ALL_SLOT_FREE;
MaxIndex := -1;
for I := 0 to GC32_BLOCK_CAPACITY-1 do
begin
ItemTypes[I] := gc32_FREE;
// Items[I].ItemData.Any := nil;
end;
end;function TGC32Block.RemoveItem(const aItemType: TGC32ItemType;
const aItem: Pointer): Boolean;
var
I: Integer;
begin
Result := False; if FreeFlag = GC32_ALL_SLOT_FREE then
Exit; for I := MaxIndex downto 0 do
if (Items[I].ItemData.Any = aItem) and (ItemTypes[I] = aItemType) then
begin
FreeFlag := FreeFlag or BITS_ARRAY[I]; //set free flag
ItemTypes[I] := gc32_FREE;
Items[I].Remove();
Result := True;
if I = MaxIndex then
Dec(MaxIndex);
Exit;
end;
end;
{ 正向位扫描 从位0到位31,返回扫描到的第一个为1的位索引号(0 based) }
function BitScanForward(
const aWordToScan: LongWord): Byte; overload;
asm
BSF EDX, EAX
MOV EAX, EDX
end;function BitScanForward(
aPtrToScan: Pointer): LongWord; overload;
asm
BSF EDX, [EAX]
MOV EAX, EDX
end;
function TGC32Block.SetItem(
const aItemType: TGC32ItemType;
const aItem: Pointer
): Boolean;
var
Idx: Integer;
begin
Result := FreeFlag <> GC32_ALL_SLOT_USED;
if Result then
begin
Idx := BitScanForward(FreeFlag);
if Idx > MaxIndex then
MaxIndex := Idx;
FreeFlag := FreeFlag and not BITS_ARRAY[Idx]; //clear free flag
ItemTypes[Idx] := aItemType;
Items[Idx].ItemData.Any := aItem;
end;
end;function TGC32Block.SetItemLast(const aItemType: TGC32ItemType;
const aItem: Pointer): Boolean;
var
Idx: Integer;
begin
Result := FreeFlag <> GC32_ALL_SLOT_USED;
if Result then
begin
for Idx := GC32_BLOCK_CAPACITY-1 downto 0 do
begin
if ItemTypes[Idx] = gc32_FREE then
begin
if Idx > MaxIndex then
MaxIndex := Idx;
FreeFlag := FreeFlag and not BITS_ARRAY[Idx]; //clear free flag
ItemTypes[Idx] := aItemType;
Items[Idx].ItemData.Any := aItem;
Exit;
end;
end;
end;
end;initialization
////////////////////////////////////////////////////////////////////////////////
begin
GCVariantType := TGCVariantType.Create();
end;finalization
begin
GCVariantType.Free();
end;end.
一开始的开发的意愿是突然有了这么一个想法,自己想看看能否实现,也就做出来了,主要是减少代码中try/fainlly结构,用了以后相对代码比较清晰,比如,原来我们可能这样写代码:procedure Proc;
var
obj1, obj2: TList;
obj3: TOtherClass;
begin
obj1 := TList.Create();
try
DoSomethingWith(obj1);
if ... then
Exit;
obj2 := TList.Create();
try
DoSomethingWith(obj2);
if ... then
Exit;
obj3 := TOtherClass.Create();
try
DoSomethingWith(obj3);
finally
obj3.Destroy();
end;
finally
obj2.Destroy();
end;
finally
obj1.Destroy();
end;
end;如果使用类似于IGC32这样的东西,代码可以写成这样:procedure Proc;
var
obj1, obj2: TList;
obj3: TOtherClass;
GC: IGC32;
begin
GC.Create2List(obj1, obj2);
obj3 := TOtherClass.Create();
GC.RegisterObject(obj3);
DoSomethingWith(obj1);
if ... then Exit;
DoSomethingWith(obj2);
if ... then Exit;
DoSomethingWith(obj3);
end;
上面的例子,只要注册了obj1,obj2,obj3,那么就不用关心他们的释放了,他们将会在函数退出以前自动被释放,如果要在函数退出前显式释放obj2,则可以
GC.FreeObject(obj2);对于其他资源,如果handle,内存,数据库事务,Cursor,DataSetBook等等都可以用这一套东西来处理举个例子,比如处理数据库事务,我们常常是这样写:procedure Example(aTrans: TTransaction);
var
DataSet: TDataSet;
begin
aTrans.StartTransaction();
try
DataSet := TAnyQuery.Create(nil);
try
Dataset.SQL.Text := '....';
Dataset.Transaction := aTrans;
DataSet.Execute();
finall
DataSet.Destroy();
end;
except
aTrans.Rollback();
DoCleanup();
raise;
end; aTrans.Commit();
end;我常常这么写(虽然用的不是IGC32):
先声明一个这样一个辅助类:
type
TExplicitTransHolder = class
private
fTrans: TTransaction;
fTransEnd: Boolean;
fDefaultCommit: Boolean;
public
constructor Create(aTrans: TTransaction; const aDefaultCommit: Boolean = False);
destructor Destroy; override; procedure Commit;
procedure Rollback;
end;constructor TExplicitTransHolder.Create(aTrans: TTransaction; const aDefaultCommit: Boolean);
begin
Assert(aTrans <> nil);
fTrans := aTrans;
fDefaultCommit := aDefaultCommit;
if fTrans.InTransaction then
fTrans.Commit();
fTrans.StartTransaction();
end;destructor TExplicitTransHolder.Destroy;
begin
if not fTransEnd and fTrans.InTransaction then
if fDefaultCommit then
fTrans.Commit()
else fTrans.Rollback();
end;procedure TExplicitTransHolder.Commit;
begin
fTrans.Commit();
fTransEnd := True;
end;procedure TExplicitTransHolder.Rollback;
begin
fTrans.Rollback();
fTransEnd := True;
end;然后,我就这样写前面的Example:procedure Example(aTrans: TTransaction);
var
DataSet: TDataSet;
ExplicitTrans: TExplicitTransHolder;
GC: IGC32;
begin
ExplicitTrans := TExplicitTransHolder.Create(aTrans, False);
GC.RegisterObject(ExplicitTrans); DataSet := TDataSet.Create(nil);
GC.RegisterObject(DataSet); DataSet.Transaction := aTrans;
DataSet.SQL.Text := '...';
DataSet.Execute(); aTrans.Commit();
end;这个写法和前面的写法,语义上基本上是一样的,但是就比较清晰
其实对待很多资源都可以这样
可是:
1、delphi中大部分的类型的create参数中都有owner参数,owner会负责其释放。只有象tstringlist之类的没有owner参数的需要显示的释放。
2、这种东西最好在编译器一级做,在应用程序做,带来了方便,同时也带来了麻烦。
3、try结构不光是为了释放对象,还有别的用处想法很好,走了弯路
在未搞懂try..finally的底层运作之前,我也不敢用其他函数去代替它,要是DELPHI哪个版本以后对try..finally做了调整,恐怕就得不偿失了。