The object pool template for the generic implementation of the Delphi new syntax

Now, Delphi supports the syntax of generics, so it can also support Template programming.  //Standard template Unit untpools; interface uses  Classes, Sysutils, untthreadtimer; type  { This is a pair like pool that can pool all tobject pairs like}  {usage:        in a global place definition     var      &NBSP;P ooler:tobjectpool;     Where to use        obj: = Pooler.lockobject as txxx;    &NBS P  try       finally         Pooler.UnlockObject;      & nbsp;end;     Initialize     initialization       pooler: = Tobjectpool.create ( Class name to collect)     finallization       Pooler.Free;    end; } //Pool object status   Tpoolitem = class  private    finstance:tobject; Objects     Flocked:boolean; Are you using     flasttime:tdatetime;//recent active time   public    constructor Create (Ainstance:tobject; Const Islocked:boolean = True);    destructor Destroy; override;  end; //Object pool   Tobjectpool = class  private    fcachedlist:tthreadlist;//objects in the object pool List     Fmaxcachesize,fmincachesize:integer; Object Pool maximum value, minimum   default to 20    fcachehit:cardinal if not set; Number of calls to objects in object pool     fcreationcount:cardinal; Number of objects created     fobjectclass:tclass;    frequestcount:cardinal; Number of call object pools     Fautoreleased:boolean; Automatically frees idle objects     Ftimer:tthreadedtimer; Multi-threaded timers     Fhourinterval:integer;  //Set interval time (hours)     function getcurobjcount:integer;    function Getlockobjcount:integer;     Procedure iniminpools;//initializing the minimum pool object     procedure Setfhourinterval (Ivalue:integer);  protected    function createobject:tobject;//creating objects     procedure Onmytimer (Sender:tobject);  public    Constructor Create (Aclass:tclass; Maxpools,minpools:integer);    destructor DestroY override;     function lockobject:tobject;//get objects     procedure UnlockObject (instance:tobject ); Release Objects       Property Objectclass:tclass Read fobjectclass;    property maxcachesize: Integer read fmaxcachesize;//Pool size     Property cachehit:cardinal read Fcachehit; Number of objects in the pool called     property creationcount:cardinal read fcreationcount;//Create objects     Property Requestcount:cardinal read frequestcount;//Request Pool count     Property Realcount:integer  read getcurobjcount;// Number of objects in pool     Property Lockobjcount:integer read getlockobjcount;//Pool busy objects     property Hourinterval: Integer Read Fhourinterval write setfhourinterval;    procedure Startautofree; Turn on automatic recycling     procedure Stopautofree; Turn off auto-recycle   end;   {tobjectpool<t>}  {The same is true for pools, but supports template}  {usage:        in a Global local definition     var       pooler:tobjectpool< to collect the class name >;     where to use        obj: = pooler.lockobject;       try        finally          Pooler.UnlockObject;  & nbsp    end;     Initialization      initialization       pooler: = tobjectpool< the class name to be collected;. create;    finallization       Pooler.Free;    end; }  Tobjectpool <T:class> = Class (Tobjectpool)   public    constructor Create (const Maxpools:integer = 0;const Minpo Ols:integer = 0);     function lockobject:t;  End; implementation {tpoolitem}  const  msecspermins = secspermin * msecspersec; //return difference of minutes   function Myminutesbetween (const Anow, athen:t DateTime): integer;  var    tmpday:double;  begin    Tmpday: = 0;    If Anow < Athen then     Tmpday: = athen-anow    else      Tmpday: = anow-athen;    Result: = Round (M Insperday * tmpday);  end; constructor tpoolitem.create (ainstance:tobject;const islocked:boolean); begin   inherited create;  finstance: = ainstance;  flocked: = islocked;  Flasttime: = Now;end; destru ctor tpoolitem.destroy;begin  if Assigned (finstance) then Freeandnil (finstance);  inherited;end; { Tobjectpool}constructor tobjectpool.create (aclass:tclass; Maxpools, Minpools:integer);begin  inherited create;  fobjectclass: = aclass;  FCachedList: = tthreadlist.create;  fmaxcachesize: = maxpools;  fmincachesize: = minpools;  If FMaxCacheSize = 0 Then FMax CacheSize: = 20;  //system defaults to 20 concurrency   if fmincachesize > fmaxcachesize then fmincachesize: = fmaxcachesize;//system default Minimum value is 0  Fcachehit: = 0;  Fcreationcount: = 0;  Frequestcount: = 0;  iniminpools; Initialize the minimum pool object   Timing destruction   Ftimer: = Tthreadedtimer.create (nil); Timing   Fhourinterval: = 4; The default idle 4 hours is recycled   Ftimer.interval: = msecspermins * Minsperhour * fhourinterval;  Ftimer.ontimer: = Onmytimer;end;  function tobjectpool.createobject:tobject;begin  Result: = fobjectclass.newinstance;  if result is Tdatamodule then    Tdatamodule (Result). Create (nil)   else if Result is tcomponent then    tcomponent (Result). Create (nil)   else if Result is tpersistent then    tpersistent (Result). create  else Result.create;end; destructor tobjectpool.destroy;var  i:integer;  LockedList: tlist;begin  if Assigned (fcachedlist) then  begin    Lockedlist: = fcachedlist.locklist;    try      for I: = 0 to lockedlist.count-1 do        Tpoolitem (Lockedlist[i]). F ree;    finally      fcachedlist.unlocklist;      FCACHEDLIST.FREE;&NBSP   end;  end;  ftimer.free;  inherited;end; function Tobjectpool.getcurobjcount:integer;var   lockedlist:tlist;begin  Result: = 0;  lockedlist: = fcachedlist.locklist;  try    Result : = lockedlist.count;  finally    fcachedlist.unlocklist;  end;end; function tobjectpool.getlockobjcount:integer;var  lockedlist:tlist;  i:integer;begin  Result: = 0;  Lockedlist: = fcachedlist.locklist;  try    for I: = 0 to lockedlist.count-1 do    begin      If Tpoolitem (Lockedlist[i]). Flocked then Result: = result + 1;    end;  finally    fcachedlist.unlocklist;  End;end;&nbs P;procedure tobjectpool.iniminpools;var  poolsobject:tobject;  lockedlist:tlist;  i:integer;begin   Lockedlist: = fcachedlist.locklist;  try    for I: = 0 to FMinCacheSize-1 do    BEGIN&NB Sp     PoolSObject: = createobject;      If Assigned (poolsobject) then        Lockedlist.add (Tpoo Litem.create (Poolsobject,false));    end;  finally    fcachedlist.unlocklist;  end;end ;  function tobjectpool.lockobject:tobject;var  lockedlist:tlist;  i:integer;begin  Result: = Nil ;  lockedlist: = fcachedlist.locklist;  try    INC (frequestcount);    for I: = 0 to Lockedli St. Count-1 do    begin      If not Tpoolitem (Lockedlist.items[i]). Flocked then      begin        Result: = Tpoolitem (Lockedlist.items[i]). finstance;        Tpoolitem (Lockedlist.items[i]). Flocked: = true;        Tpoolitem (Lockedlist.items[i]). Flasttime: = now;        INC (fcachehit)///number of times taken from the pool         break;    &NBSP ; end;    end;   //    IF Not Assigned (result) then    begin      Result: = createobject;     //assert (the Igned (Result));      INC (fcreationcount);      If Lockedlist.count < fmaxcachesize Then Pool capacity         Lockedlist.add (Tpoolitem.create (result,true));    end;  finally     fcachedlist.unlocklist;  end;end; procedure Tobjectpool.onmytimer (sender:tobject); var   i:integer;  lockedlist:tlist;begin  lockedlist: = fcachedlist.locklist;  try    for I: = Lockedlist.count-1 Downto 0 do    begin      If Myminutesbetween (Now,tpoolitem (Lockedlist.item S[i]). Flasttime) >= Fhourinterval * Minsperhour then//free pool for a long time ado      begin        Tpoo LItem (Lockedlist.items[i]). free;        Lockedlist.delete (I);      end;    end;  finally  &NB Sp Fcachedlist.unlocklist;  end;end; procedure tobjectpool.setfhourinterval (ivalue:integer);begin  if IValue <= 1 Then exit;  if Fhourinterval = Ivalue then exit;  ftimer.enabled: = false;  try    FHourInterval : = ivalue;    Ftimer.interval: = msecspermins * Minsperhour * fhourinterval;  finally    FTimer.E nabled: = true;  end;end; procedure tobjectpool.startautofree;begin  if not FTimer.Enabled then ftimer.enabled: = true;end; procedure tobjectpool.stopautofree;begin  if ftimer.enabled then FTimer.Enabled : = False;end; procedure tobjectpool.unlockobject (instance:tobject);var  lockedlist:tlist;  I: integer;  item:tpoolitem;begin  lockedlist: = fcachedlist.locklist;  try    Item: = nil;    for I: = 0 to lockedlist.count-1 do    begin      Item: = Tpoolitem (Lockedlist.items[i]) ;      If item.finstance = Instance Then      begin        item.flocked: = false;        Item.flasttime: = now;        break;      end;    end;    if not Assigned (Item) Then instance.free;  finally    fcachedlist.unlocklist;  end;end; //generic template defined based on standard template {TObjectPool <T>}constructor Tobjectpool<t>. Create (const maxpools, Minpools:integer);begin  inherited Create (t,maxpools,minpools); end; function Tobjectpool<t>. lockobject:t;begin  Result: = T (inherited lockobject); end; end. //specific template based on the definition of a generic template var  fquerymgr: tobjectpool<tuniquery>; Query pool   FDSPMGR:TOBJECTPOOL&LT;TDATASETPROVIDER&GT;;//DSP Pond   Fcdsmgr:tobjectpool<tclientdataset >;//cds pool   fdsmgr:tobjectpool<tdatasource>;//ds Pond   funisqlmgr:tobjectpool<tunisql>;// Execute SQL Pool   funispmgr:tobjectpool<tunistoredproc>;//stored procedure pool  //Create specific template function Querymgr:tobjectpool<tuniquery>;begin  if not Assigned (fquerymgr) then    fquerymgr: = tobjectpool< Tuniquery>. Create (1000,20);  Result: = Fquerymgr;end;

Http://www.vckbase.com/module/articleContent.php?id=4386

The object pool template for the generic implementation of the Delphi new syntax