DELPHI盒子
!实时搜索: 盒子论坛 | 注册用户 | 修改信息 | 退出
检举帖 | 全文检索 | 关闭广告 | 捐赠
技术论坛
 用户名
 密  码
自动登陆(30天有效)
忘了密码
≡技术区≡
DELPHI技术
移动应用开发
Web应用开发
数据库专区
报表专区
网络通讯
开源项目
论坛精华贴
≡发布区≡
发布代码
发布控件
文档资料
经典工具
≡事务区≡
网站意见
盒子之家
招聘应聘
信息交换
论坛信息
最新加入: 13992888967
今日帖子: 19
在线用户: 37
导航: 论坛 -> 发布代码 斑竹:liumazi,ruralboy  
作者:
男 hardnut (麦轲数据管家) ★☆☆☆☆ -
普通会员
2019/7/7 16:17:28
标题:
代码分享: npResGuard.pas: * 资源自动释放辅助结构体 * 浏览:951
加入我的收藏
楼主: 近日得闲,准备将自己的一些代码整理共享出来,但不知道大家是否有兴趣,以及代码质量如何,先在网上贴一些,供大家点评、吐槽。。。

(*
  本文件是《麦轲共享代码包》(MyKore Share Pack For Delphi)的一部分;
  本文件是从《麦轲数据管家》的源代码中提取、整理而来的;
  你可以自由、免费地使用本文件,但要保留本版权声明;
  完整许可协议请查看readme.chs.txt

  版权所有:Copyright(C) 2013-2019 九力软件工作室
  官方网站:http://www.mksjgj.com
  电子邮箱:mksjgj@qq.com
*)
unit npResGuard;
(*
  通用资源保护器,安全方便地实现资源的自动释放(回收)

2019-07-01: 构思, 实现, 代码Review

SafeGuard是jcl中提供的内存自动释放机制,
包括对象(TObject)与动态内存(GetMem)释放,
  但是这两类内存要分开,在本单元中进行了如下改进:
    1.简化并封装成Record,使用更简单了
    2.对象(TObject)与动态内存(GetMem/FreeMem)释放统一
    3.可扩展性,可以处理任意类别的资源
    4.添加了常见的对象,内存分配功能.
    5.增加了文件删除功能
    6.增加了finally method调用功能

依赖原则:
  本单元只依赖Delphi本身提供的单元


使用示例:
例1.
var
  sgd:TnpGuard;
  sl:TStringList;
begin
  sl:=TStringList.Create;
  sgd.Guard(sl);
  sl.Add('this is a very good improve');
  TnpExc.ShowMsg(sl.Text,[]);
end;

例2.
var
  sgd:TnpGuard;
  sl:TStringList;
begin
  sl:=sgd.NewStrList;
  sl.Add('this is a very good improve');
  TnpExc.ShowMsg(sl.Text,[]);
end;


History:
2019-06-01: 从《麦轲数据管家》的源代码中提取并进行初步整理
2019-07-01: 基本搞定
2019-07-03: + 移植漏掉的NewObject、NewComponent
*)
{$I Nipow.inc}

interface

uses
  Contnrs, SysUtils, Classes, IOUtils, Forms, Controls, Types;

type
  (*TnpGuard
  资源自动释放保护器
  *)
  PnpGuard=^TnpGuard;
  TnpGuard=record
  private
  type
    IResGuard=Interface
    end;
    TResGuardImpl=class(TInterfacedObject,IResGuard)
    private
      FObjectList:TObjectList;
    public
      constructor Create;
      destructor Destroy;override;
    end;
  private
    FResGuard:IResGuard;  //TnpGuard实例超出范围时会自动将FResGuard置为nil
    function PrepGuard:TObjectList;
  public
    procedure GuardObj(const AObj: TObject); //-->UnguardObj
    procedure GuardFreeMem(AMem:Pointer); //-->UnguardCustRes
    function GetMem(ASize: Integer; AZeroMem: Boolean=False):Pointer;   //-->UnguardCustRes
    procedure GuardFile(const AFileName:string);//-->UnguardCustRes

    procedure UnguardObj(AObj: TObject;ToFreeIt:Boolean=False); inline;
    procedure UnguardCustRes(const AResDes:string;ToFreeIt:Boolean=False);
    procedure FreeAllRes; inline;
    function Count:Integer;

    procedure NewObject(out AObject{:TObject};AClass:TClass);
    procedure NewComponent(out AComponent{:TComponent}; ACompClass: TComponentClass;
        ATag:Integer=0; AOwner:TCompon_ent=nil);

    function NewStrList(const AFileName:TFileName='): TStringList;
    function NewMemStream(const AFileName:TFileName='): TMemoryStream;
    function NewFileStream(const AFileName:TFileName;AForReading: Boolean): TFileStream;

    procedure GuardFinally(ABeginProc,AEndProc:TProc);//无Unguard办法
    procedure GuardWaitCursor; //无Unguard办法
  end;

  (*TCustomResWrapper
    将资源包裹在一个对象内,在对象析构时释放资源

  *)
  TCustomResWrapper=class
  protected
    FResDes:string; //resource descriptor, 资源描述符, 描述绑定的资源,
                    //格式: classname|res data, 如: 'TFileDeleter|c:\a.txt'
  protected
    procedure FreeRes;virtual; abstract; //子类重载,释放资源
  public
    constructor CreateOf(const ARes); overload;
    destructor Destroy; override;
    function UnWrap:string;
    class function GenResDes(const ARes):string;virtual;abstract;
    class procedure ParseResDes(const AResDes:string;out ARes);virtual;abstract;
    procedure GetRes(out ARes);
    Property ResDes:string read FResDes;  //resource descriptor
  const
    SepChar:Char='|';
  end;

  (*TMemWrapper
  内存包裹器,内存在对象创建时申请,在对象释放时释放
  System.AllocMem/GetMem  <----> System.FreeMem

  FResDes 中保存的是 内存的指针(转换成整数)
  *)
  TMemWrapper=class(TCustomResWrapper)
  protected
    procedure FreeRes;override;
  public
    constructor Create(ASize: Integer; AZeroMem: Boolean);overload;
    class function GenResDes(const ARes):string;override;
    class procedure ParseResDes(const AResDes:string;out ARes);override;
  end;

  (*TFileDeleter
  自动删除临时文件
  FResDes 中保存的是 文件名(字符串)
  *)
  TFileDeleter = class(TCustomResWrapper)
  public
    procedure FreeRes;override;
    class function GenResDes(const ARes{:string}):string;override;
    class procedure ParseResDes(const AResDes:string;out ARes{:string});override;
  end;

type
  (*TProcRunner
    执行指定匿名方法的对象

    对象释放时执行指定方法,要注意对象的生命周期.

    不能从TCustomResWrapper派生,因为涉及到复杂的 Anonymous Methods 的绑定及生命周期管理
  *)
  TProcRunner = class
  private
    FProc:TProc;
  public
    constructor Create(AProc:TProc);
    destructor Destroy; override;
  end;

implementation

完整文件见附件
----------------------------------------------
麦轲数据管家--您最贴心的个人数据/知识管理工具
作者:
男 hardnut (麦轲数据管家) ★☆☆☆☆ -
普通会员
2019/7/7 16:19:35
1楼: 附件加不上啊, 感兴趣的到这里下载: 
https://pan.baidu.com/s/1ntn2w4L#list/path=%2Fmksjgj

在子目录 “08.麦轲共享代码包” 内
----------------------------------------------
麦轲数据管家--您最贴心的个人数据/知识管理工具
作者:
男 hardnut (麦轲数据管家) ★☆☆☆☆ -
普通会员
2019/7/8 17:46:52
2楼: 看来我发布了一段让人不知道如何评价的代码^__^
----------------------------------------------
麦轲数据管家--您最贴心的个人数据/知识管理工具
作者:
男 sun2grit (Asun) ★☆☆☆☆ -
盒子活跃会员
2019/7/8 22:07:56
3楼: 支持~!
----------------------------------------------
快递查询 淘宝相册 免费淘宝相册一键式测量仪
作者:
男 lzhg_kn (lzhg_kn) ★☆☆☆☆ -
盒子活跃会员
2019/7/11 8:55:14
4楼: 必须点赞
----------------------------------------------
-
作者:
男 minjiu (Bruce) ★☆☆☆☆ -
普通会员
2019/7/11 12:11:19
5楼: 這個東西蠻讚的~~
但請問 TStrings 的 AddObject() 要如何自動釋放呢? 謝謝

var
  ItemList : TStringList;
  AutoFree : TnpGuard;
begin
  ItemList := TStringList.Create;
  AutoFree.GuardObj(ItemList);

  ItemList.AddObject('11',TObject(NewStr('1111'));  << 要如何自動釋放資源?
  ItemList.AddObject('22',TObject(NewStr('2222'));  << 要如何自動釋放資源?
end;
----------------------------------------------
-
作者:
男 hardnut (麦轲数据管家) ★☆☆☆☆ -
普通会员
2019/7/11 21:03:11
6楼: 可以使用如下两种方法:

  ItemList := TStringList.Create(True);
  AutoFree.GuardObj(ItemList);

或者:
  ItemList := AutoFree.NewStrList;
  ItemList.OwnsObjects := True;
----------------------------------------------
麦轲数据管家--您最贴心的个人数据/知识管理工具
作者:
男 hardnut (麦轲数据管家) ★☆☆☆☆ -
普通会员
2019/7/13 15:16:37
7楼: 我感觉论坛里没有几个人认识到了这个小单元的价值,当时我发现JCL的这个功能时,感到相当的开心,觉得这个功能太好用了:只管创建对象然后绑定,就不用管了,大大降低了代码中try/finally的使用,这简直可以媲美ARC啊。后来经过我的改进,更加简单、通用、可扩展。目前已经成为我重用度最高的类,我统计了一下,我的代码中用了200多次,现在我的代码中只有极个别的地方有try/finally, 99%的对资源释放都用TnpGuard搞定了,代码因此更加简洁。
  比如下面两段相同功能的代码,对比太强烈了,一个多重嵌套,一个直线排列,对读代码的人来讲,理解难度一下就下来了。

1.Delphi的标准写法:

  var
    sl1,sl2:TStringList;
  begin
    sl1:=TStringList.Create;
    try
      sl.Add('this is a very good improve');
      sl2 := TStringList.Create;
      try
        sl2.LoadFromFile(...);
        sl1.AddStrings(sl2);
      finally
        s2.Free;
      end;
      TnpExc.ShowMsg(sl1.Text,[]);
    finally
      sl1.Free;
    end;
  end;

2.使用TnpGuard的标准写法: 
  
  var
    sgd:TnpGuard;
    sl1,sl2:TStringList;
  begin
    sl1:=TStringList.Create;
    sgd.Guard(sl1);
    sl1.Add('this is a very good improve');
    
    sl2:=TStringList.Create;
    sgd.Guard(sl2);   
    sl2.LoadFromFile(...);
    
    sl1.AddStrings(sl2);    
    TnpExc.ShowMsg(sl1.Text,[]);
  end;
  

----------------------------------------------
麦轲数据管家--您最贴心的个人数据/知识管理工具
作者:
男 chencong5025 (Nicosoft) ▲▲△△△ -
注册会员
2019/7/19 13:46:37
8楼: procedure TForm1.Button1Click(Sender: TObject);
var
  arr: TStringList;
  guard: TnpGuard;
begin
  // arr := TStringList.Create(True);
  // guard.GuardObj(arr);
  // arr.AddObject('11', TObject(NewStr('1111')));
  // arr.Add('觉得姐姐的的');

  arr := guard.NewStrList();
  arr.OwnsObjects := True;
  arr.AddObject('11', TObject(NewStr('1111')));
  arr.Add('觉得姐姐的的');

end;

2种方式  均崩溃  在点击按钮时就崩溃。

不加OwnsObjects   或者 Create 时候参数不设置True  则泄露。字符串OK
----------------------------------------------
-
作者:
男 hardnut (麦轲数据管家) ★☆☆☆☆ -
普通会员
2019/7/19 14:44:22
9楼: 你的这种用法是不对的:
     TObject(NewStr('1111'))
这种强制转换是错误的, AddObject的第二个参数必须是一个真正的对象指针,即TObject实例, 不能这样随便强制转换.

如果你要保存两个关联的string, 你可以使用TStringList的Name-Value模式:
相关的方法及属性: TStrings.KeyNames, TStrings.Names,TStrings.NameValueSeparator等

----------------------------------------------
麦轲数据管家--您最贴心的个人数据/知识管理工具
作者:
男 ysai (ysai) ★☆☆☆☆ -
盒子活跃会员
2019/7/19 15:36:29
10楼: 楼主你这个还要定义变量
可以看一看mormot里SynCommons.pas中的TAutoFree类

    /// protect one local TObject variable instance life time
    // - for instance, instead of writing:
    // !var myVar: TMyClass;
    // !begin
    // !  myVar := TMyClass.Create;
    // !  try
    // !    ... use myVar
    // !  finally
    // !    myVar.Free;
    // !  end;
    // !end;
    // - you may write:
    // !var myVar: TMyClass;
    // !begin
    // !  TAutoFree.One(myVar,TMyClass.Create);
    // !  ... use myVar
    // !end; // here myVar will be released

----------------------------------------------
-
作者:
男 hardnut (麦轲数据管家) ★☆☆☆☆ -
普通会员
2019/7/19 22:48:13
11楼: TAutoFree.One是class method, 这样看来在只需管理一个对象实例时是简单了一点点,不过TAutoFree 与 我的TnpGuard原理一样,但TnpGuard功能是更丰富一些.
----------------------------------------------
麦轲数据管家--您最贴心的个人数据/知识管理工具
作者:
男 minjiu (Bruce) ★☆☆☆☆ -
普通会员
2019/7/22 18:40:21
12楼: 樓主的 TnpGuard 的確是蠻實用的東西,很感謝可以分享給大家使用,但希望可以更 Smart 一些,如在自動釋放資源時,若指定資源已被手動釋放,則可自動不再重覆釋放,不然若在關閉程式時會發生嚴重錯誤,或有時無出現錯誤,但整個程式會卡在記憶體中,而且佔用很高的CPU,必須手動以"工作管理員"強制結束該程式。

var
  tsItem : TStringList;
begin
  tsItem := TStringList.Create;
  AutoFree.GuardObj(tsItem);   << 使用了 TnpGuard

  try
    tsItem.Add('111');
    tsItem.Add('222');
    tsItem.Add('333');
  finally
    tsItem.Free;   << 但又不小心手動釋放物件
  end;
end;
----------------------------------------------
-
作者:
男 hardnut (麦轲数据管家) ★☆☆☆☆ -
普通会员
2019/7/24 15:13:21
13楼:   “如在自動釋放資源時,若指定資源已被手動釋放,則可自動不再重覆釋放”----这个想法不错, 但很难实现。FassMM中有这个功能,但它只是用在debug模式下跟踪问题用,因为有性能上的损失,而且也不是100%可靠。
  最好的办法还是养成习惯,比如我现在的代码中基本上就都是Guard,不再Free. 你可以通过文本查找工具,查找“.Free”来查看自己有没有即guard又free

----------------------------------------------
麦轲数据管家--您最贴心的个人数据/知识管理工具
信息
登陆以后才能回复
Copyright © 2CCC.Com 盒子论坛 v2.1 版权所有 页面执行42.96875毫秒 RSS