内存池

内存池

/// <author>cxg 2020-9-8</author>
/// 支持D7，更低版本没有测试，支持跨OS
unit MemPool;

interface

uses
  Math, Classes, SysUtils, SyncObjs;

type
  {$if CompilerVersion < 18} //before delphi 2007
  TBytes = array of Byte;
  {$ifend}
  TMemBlock = record
    buf: Pointer;
    size: Cardinal;
  end;

  pMemBlock = ^TMemBlock;

  TMemPool = class
  private
    FList: TList;
    FBlockSize: Cardinal;
    FCS: TCriticalSection;
  private
    procedure Lock;
    procedure UnLock;
    procedure newBlocks(const BlockNum, blockSize: Cardinal);
  public
    constructor Create(const blockNum: Cardinal; const blockSize: Cardinal);
    destructor Destroy; override;
  public
    function GetBlock: Pointer;
    procedure backBlock(const block: Pointer);
  end;

type
  TMemList = class
  private
    FPool: TMemPool;
    FList: TList;
  private
    function GetSize: Int64;
  public
    constructor Create(pool: TMemPool);
    destructor Destroy; override;
  public
    procedure addBuf(const buf: Pointer; const len: Cardinal);
    procedure backList;
    procedure fromStream(ms: TMemoryStream);
    procedure toStream(ms: TMemoryStream);
    function toBytes: tbytes;
    function toBuf: Pointer;
  public
    property list: TList read FList;
    property size: Int64 read GetSize;
  end;

implementation

{ TMemPool }
constructor TMemPool.Create(const BlockNum, BlockSize: Cardinal);
begin
  FCS := TCriticalSection.Create;
  FList := TList.Create;
  FBlockSize := BlockSize;
  newBlocks(BlockNum, FBlockSize);
end;

destructor TMemPool.Destroy;
begin
  FreeAndNil(FList);
  FreeAndNil(FCS);
  inherited;
end;

procedure TMemPool.backBlock(const block: Pointer);
begin
  Lock;
  try
    FList.Add(block);
  finally
    UnLock;
  end;
end;

function TMemPool.GetBlock: Pointer;
begin
  Lock;
  try
    if FList.Count = 0 then
      newBlocks(1, FBlockSize);
    Result := FList.Last;
    FList.Delete(FList.Count - 1);
  finally
    UnLock;
  end;
end;

procedure TMemPool.newBlocks(const BlockNum, blockSize: Cardinal);
var
  i: Integer;
  p: pMemBlock;
begin
  for i := 1 to BlockNum do
  begin
    New(p);
    GetMem(p.buf, BlockSize);
    FList.Add(p);
  end;
end;

procedure TMemPool.Lock;
begin
  FCS.Enter;
end;

procedure TMemPool.UnLock;
begin
  FCS.Leave;
end;

{ TMemList }

procedure TMemList.addBuf(const buf: Pointer; const len: Cardinal);
var
  p: pMemBlock;
begin
  p := FPool.GetBlock;
  p.buf := buf;
  p.size := len;
  FList.Add(p);
end;

constructor TMemList.Create(pool: TMemPool);
begin
  FPool := pool;
  FList := TList.Create;
end;

destructor TMemList.Destroy;
begin
  FreeAndNil(FList);
  inherited;
end;

procedure TMemList.backList;
var
  p: pMemBlock;
  i: integer;
begin
  for i := flist.Count - 1 downto 0 do
  begin
    p := pmemblock(flist[i]);
    FPool.backBlock(p);
    flist.Delete(i);
  end;
end;

function TMemList.GetSize: Int64;
var
  i: Integer;
begin
  Result := 0;
  for i := 0 to FList.Count - 1 do
    Result := Result + pmemblock(FList[i]).size;
  //i := FList.Count;
 // Result := FPool.FBlockSize * (i - 1) + pMemblock(FList[i - 1]).size;
end;

function TMemList.toBuf: Pointer;
var
  i: integer;
  p: pMemBlock;
begin
  New(Result);
  GetMem(Result, self.getsize);
  for i := 0 to flist.Count - 1 do
  begin
    p := pmemblock(list[i]);
    Move(p.buf^, Result^, p.size);
    if i < flist.Count - 1 then
      Result := Pointer(Cardinal(Result) + p.size);
  end;
end;

function TMemList.toBytes: tbytes;
var
  i: integer;
  p: pMemBlock;
begin
  SetLength(result, self.GetSize);
  for i := 0 to flist.Count - 1 do
  begin
    p := pmemblock(list[i]);
    Move(p.buf^, Result[i * p.size], p.size);
  end;
end;

procedure TMemList.toStream(ms: TMemoryStream);
var
  i: integer;
  p: pMemBlock;
begin
  ms.SetSize(Self.GetSize);
  for i := 0 to flist.Count - 1 do
  begin
    p := pmemblock(list[i]);
    ms.Write(p.buf^, p.size);
  end;
end;

procedure TMemList.fromStream(ms: TMemoryStream);
var
  p: pMemBlock;
  qty, remain, n, i: Integer;
begin
  backList;
  qty := Ceil(ms.Size / FPool.FBlockSize);
  n := qty - 1;
  remain := ms.Size - (n * FPool.FBlockSize);
  for i := 1 to qty do
  begin
    p := FPool.GetBlock;
    if i = qty then
    begin
      ms.Read(p.buf, remain);
      p.size := remain;
    end
    else
    begin
      ms.Read(p.buf, FPool.FBlockSize);
      p.size := FPool.FBlockSize;
    end;
    flist.Add(p);
  end;
end;

end.