内存池
/// <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.
标签:begin,end,FList,TMemPool,内存,procedure,size From: https://www.cnblogs.com/hnxxcxg/p/17488766.html