时间关系,不废话了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;

解决方案 »

  1.   

    implementation//Bits
    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;
      

  2.   

    { TGC32Item }procedure TGC32Item.Free(aType: TGC32ItemType);
    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.
      

  3.   

    用处不太大,所以就公开了:()
    一开始的开发的意愿是突然有了这么一个想法,自己想看看能否实现,也就做出来了,主要是减少代码中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;这个写法和前面的写法,语义上基本上是一样的,但是就比较清晰
    其实对待很多资源都可以这样
      

  4.   

    明白你的意思了,想做类似垃圾收集的自动释放的功能。
    可是:
      1、delphi中大部分的类型的create参数中都有owner参数,owner会负责其释放。只有象tstringlist之类的没有owner参数的需要显示的释放。
      2、这种东西最好在编译器一级做,在应用程序做,带来了方便,同时也带来了麻烦。
      3、try结构不光是为了释放对象,还有别的用处想法很好,走了弯路
      

  5.   

    未够水平研究这类代码
    在未搞懂try..finally的底层运作之前,我也不敢用其他函数去代替它,要是DELPHI哪个版本以后对try..finally做了调整,恐怕就得不偿失了。