对象池泛型模板

对象池泛型模板

delphi和lazarus都适用。泛型配合继承，无敌的存在。

//cxg 2024-9-2
//对象池的泛型模板
unit sys.pool;
{$i def.inc}

interface

uses
  //system--------
  Generics.Collections, Classes, SysUtils;

type
  TPool<T> = class
  private
    //连接池的空闲连接
    FList: TthreadList<T>;
    //池大小
    FPoolSize: Integer;  f: tclass;
  public
    constructor Create(poolSize: Integer); virtual;
    destructor Destroy; override;
  private
    //初始化
    procedure Init;
  protected
    //新建一个对象
    function NewObj: T; virtual; abstract;
  public
    //从池中取一个对象
    function Lock: T; virtual;
    //归还池中
    procedure Unlock(Value: T); virtual;
  end;

implementation

constructor TPool<T>.Create(poolSize: Integer);
begin
  FList := TThreadList<T>.Create;
  Self.FPoolSize := poolSize;    //根据实际情况，合理设置
  self.Init;
end;

destructor TPool<T>.Destroy;
begin
  FList.Clear;
  FreeAndNil(FList);
  inherited Destroy;
end;

procedure TPool<T>.Init;
var
  list: TList<T>;
begin
  list := FList.LockList;
  try
    while list.Count < Self.FPoolSize do
      List.Add(NewObj);
  finally
    FList.UnlockList;
  end;
end;

function TPool<T>.Lock: T;
var
  list: TList<T>;
begin
  list := FList.LockList;
  try
    if list.Count > 0 then
    begin
      Result := list.Last;
      List.Remove(Result);
    end
    else
    begin //池中已无可用对象，池容量+1
      List.Add(NewObj);
      Result := list.Last;
      List.Remove(Result);
    end;
  finally
    FList.UnlockList;
  end;
end;

procedure TPool<T>.Unlock(Value: T);
begin
  FList.Add(Value);
end;

end.

具体的对象池

//cxg 2024-9-2
//mormot2 THttpClientSocket-pool
unit mormot2.httpclientpool;
{$i def.inc}

interface

uses
  //system-----
  SysUtils,
  //mormot----------
  mormot.net.client,
  //my---------
  sys.pool;

type
  ThttpclientPool = class(TPool<THttpClientSocket>)
  public
    constructor Create(poolSize: Integer); override;
    function NewObj: THttpClientSocket; override;
    procedure unlock(Value: THttpClientSocket); override;
  end;

implementation

uses proxy.global;

constructor ThttpclientPool.Create(poolSize: Integer);
begin
  inherited;
  writeln('New THttpClientSocket-pool, poolSize: ' + poolSize.ToString);
end;

function ThttpclientPool.NewObj: THttpClientSocket;
begin
  Result := THttpClientSocket.Create;
end;

procedure ThttpclientPool.Unlock(Value: THttpClientSocket);
begin
  Value.close;
  Value.CloseSockIn;
  Value.CloseSockOut;
  inherited;
end;

end.