Delphi下在栈上创建对象

引子，昨天看一份贴子，上面有兄弟提到用basm在栈上创建对象的问题，我一时兴起就开始试验了，其实我也一直有这样的想法，但是因为Delphi本身就支持老式的object，这个pascal遗产特性，就是一个结构加函数，带有一点面向对象的性质，能够象结构一样，直接在栈上声明，有些情况下，我也挺喜欢用object的，不过现在大多数类都是class声明，不再是object声明了，为了让class能在stack上分配，昨天不懈努力，耕耘到凌晨3点，终于基本做出来了，就是没怎么测试，今天也化了一个小时整理了一下，就急不可待拿出来与各位Delphi爱好者共同探讨了，哈哈哈，献丑也无所谓，就当是抛砖引玉吧，只是切勿用于营利

鸣谢：其中有一段利用fs:[4],fs:[8]值判断指针是否在线程的栈上的代码，是根据EXETOOLS上的GoldenEgg的意见写出的，但是因为这个方法应该是没有纳入Windows文档的，所以不推荐使用

时间关系，别的不说了，有兴趣的玩一下，测试一下，提出宝贵意见，万分欢迎，
没兴趣的，顶一下也是ok的

更多 0 分享到：

相关主题推荐：对象 delphi 栈面向对象结构

相关帖子推荐：

对我有用[0] 丢个板砖[0] 引用 | 举报 | 管理

回复次数：25

: 关注; alphax; alphax; 等级：

#1 得分：0 回复于： 2004-10-15 18:05:43

//用类单元

unit ChillsObjOnStk;

{$DEFINE ALIGN_INSTANCE_SIZE}
{$DEFINE STK_USE_API}

interface

{
  LISENCE:
    GNU GENERAL PUBLIC LICENSE (ver 2, 1991)

  AUTHOR:
    alphax

  VERSION:
    se 1.0
}

type
  TStkObjAllocator = object
  {
    注：在一个过程内只能有一个Allocator对象，
        并且Allocator对象不应该传递到过程外
  }
  public
    {
      初始化例程，必须在过程开始时调用
    }
    constructor Initialize;

    {
      结束例程，必须在过程结束前（最后）调用，
      尤其是过程中存在生存期自管理变量（包括隐含的，有编译器引入的）时
    }
    destructor Finalize;

    {
      1. 在当前的栈上分配一个对象的空间，
      并初始化对象的数据字段(参见: System.pas|TObject.InitInstance)

      2. 同时，修改类的FreeInstance方法的地址指针，使得其释放时并不真正释放空间，
        通过该方法创建的对象可以调用对象的Destroy方法
    }
    function AllocObjOnStack(aClass: TClass): TObject;

    {
      在当前的栈上分配一个对象的空间，
      并初始化对象的数据字段(参见: System.pas|TObject.InitInstance)
      但不修改类的FreeInstance方法的地址指针，通过该方法创建的对象不能调用Destroy
      方法，必须手工调用StkFreeInstance

      注意：该方法只适用于创建那些Destroy方法没有任何操作的类，如TObject
      对于Destroy方法有操作的类，建议创建一个Fake类，重载FreeInstance方法,
      参见下面的USAGE部分
    }
    function AllocObjOnStackNoPatch(aClass: TClass): TObject;

  private
    OrgStackPtr: Integer;
  end;

{ 检查一个类的FreeInstance指针是否已经被修改过 }
function StkIsFreeInstancePatched(aClass: TClass): Boolean;

{ 手工释放一个分配在栈上的对象 }
procedure StkFreeInstance(Self: TObject);

如果您对CSDN论坛有意见和建议请直接在本帖指教

对我有用[0] 丢个板砖[0] 引用 | 举报 | 管理

: 关注; alphax; alphax; 等级：

#2 得分：0 回复于： 2004-10-15 18:06:25

implementation
uses
  SysUtils, { RaiseLastOSError}
  Windows { Virtual Memory API }
  ;

{$IF False}
{
  ******************************************************************************
  * * * * * USAGE
  ******************************************************************************
}
procedure DoSomething(aObj: TObject);
begin
  //do something
end;

type
  TObjNoFreeMem = class(TObject)
  public
    constructor Create;
    procedure FreeInstance; override;
  end;

  TObjHasDestroyAction = class
    { ... }
  public
    constructor Create(aParam: Pointer);
    destructor Destroy; override;
  end;

  TObjHasDestroyActionStkEdition = class(TObjHasDestroyAction)
  public
    procedure FreeInstance; override;
  end;

constructor TObjNoFreeMem.Create;
begin
  DoSomething(Self);
end;

procedure TObjNoFreeMem.FreeInstance;
begin
  CleanupInstance();
  //NO FreeMem
end;

constructor TObjHasDestroyAction.Create(aParam: Pointer);
begin
  DoSomething(Self);
end;

destructor TObjHasDestroyAction.Destroy;
begin
  DoSomething(Self);
  inherited ;
end;

procedure TObjHasDestroyActionStkEdition.FreeInstance;
begin
  CleanupInstance();
  //NO FreeMem
end;

procedure USAGE_StkObjAllocator;
var
  Alloc: TStkObjAllocator;
  Obj: TObject;
begin
  //First, initialize the Allocator
  Alloc.Initialize();

  Obj := Alloc.AllocObjOnStack(TObject);
  try
    DoSomething(Obj);
  finally
    Obj.Free();
  end;

  //At last, call the finalize
  Alloc.Finalize();
end;

procedure USAGE_StkObjAllocatorNoPatch;
var
  Alloc: TStkObjAllocator;
  Obj1, Obj2: TObject;
  Obj3, Obj4: TObjHasDestroyAction;
begin
  //First, initialize the Allocator
  Alloc.Initialize();

  Obj1 := Alloc.AllocObjOnStackNoPatch(TObject);
  try
    DoSomething(Obj1);
  finally
    StkFreeInstance(Obj1); //you must use StkFreeInstance to free the object
  end;

  Obj2 := Alloc.AllocObjOnStackNoPatch(TObjNoFreeMem);
  try
    Obj2.Create();        //do NOT forget call the constructor,
                          //if the constructor has any action
    DoSomething(Obj2);
  finally
    Obj2.Destroy();       //you can call destroy method,
                          //because the class's FreeInstance no FreeMem operation
  end;

  Obj3 := TObjHasDestroyAction.Create(nil);
  try
    Obj3.Create(nil);
    DoSomething(Obj3);
  finally
    Obj3.Destroy();
  end;

  Obj4 := TObjHasDestroyAction(Alloc.AllocObjOnStackNoPatch(TObjHasDestroyActionStkEdition));
  try
    Obj4.Create(nil); //do NOT forget call the constructor, if the constructor has any action
    DoSomething(Obj4);
  finally
    Obj3.Destroy(); //It's FreeInstance will not FreeMem
  end;

  //At last, call the finalize
  Alloc.Finalize();
end;
{
  ******************************************************************************
                                                                 USAGE * * * * *
  ******************************************************************************
}

{$IFEND}

社区问答第6期：芈峮 iOS测试指南

对我有用[0] 丢个板砖[0] 引用 | 举报 | 管理

: 关注; alphax; alphax; 等级：

#3 得分：0 回复于： 2004-10-15 18:06:31

CSDN投诉事项说明

对我有用[0] 丢个板砖[0] 引用 | 举报 | 管理

: 关注; alphax; alphax; 等级：

#4 得分：0 回复于： 2004-10-15 18:08:11

//简单的测试

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;

type
  TObjOnStack = class
  public
    S: string;
    I: Integer;
    J: Integer;
    K: Integer;
    B: Byte;
    E: Extended;
  end;

  TForm1 = class(TForm)
    procedure FormShow(Sender: TObject);
    procedure FormDblClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
uses
  Unit2, ChillsObjOnStk, Math;

{$R *.dfm}
procedure TForm1.FormShow(Sender: TObject);
var
  Obj1, Obj2: TObjOnStack;
  S: string;
  Creator: TStkObjAllocator;
begin
  Creator.Initialize();

  Randomize();

  Obj1 := TObjOnStack(Creator.AllocObjOnStackNoPatch(TObjOnStack));
  Obj1.Create();
  try
    Obj2 := TObjOnStack(Creator.AllocObjOnStackNoPatch(TObjOnStack));
    Obj2.Create();
    try
      Obj1.S := 'ABC';
      Obj2.S := 'DEF';

      S := Obj1.S;
      Obj1.S := Obj2.S;
      Obj2.S := S;
      Caption := Obj1.S + Obj2.S;

      if RandomRange(1, 10) = 5 then
        raise Exception.Create('test');
    finally
      StkFreeInstance(Obj2);
    end;
  finally
    StkFreeInstance(Obj1);
  end;

  Obj1 := TObjOnStack.Create();
  Obj1.Free();

  Creator.Finalize();
end;

procedure TForm1.FormDblClick(Sender: TObject);
var
  Frm: TForm2;
  Creator: TStkObjAllocator;
begin
  Creator.Initialize();
  Frm := TForm2(Creator.AllocObjOnStack(TForm2));
  Frm.Create(Self);
  try
    Frm.ShowModal();
  finally
    Frm.Destroy();
  end;
  Creator.Finalize();
end;

end.

本站仅提供存储服务，所有内容均由用户发布，如发现有害或侵权内容，请点击举报。