内存池

http://www.cnblogs.com/hnxxcxg/archive/2012/05/22/2512943.html

 

unit untMemoryPool;interface{$WARNINGS OFF}uses  System.Classes, System.SysUtils, Winapi.Windows;type  //Node for block memory  pMemNode = ^TMemNode;  TMemNode = record    Free : Boolean;                 //Is free?    FSize: Integer;                 //Block Size    FAddr: Pointer;                 //Address pointer to memory allocated    FNext: pMemNode;                //Next block pointer    FPrev: pMemNode;                //Block befor  end;  //Memory pool class  TMemoryPool = class(TObject)  private    FBlkSize: Integer;               //Block size    FBlkCnt : Integer;               //Memory bock count each time allocate    FMemHead: pMemNode;              //Memory list    FreeHead: pMemNode;              //Free memory start position    FMemTail: pMemNode;              //Tail of current memory    FLock   : TRTLCriticalSection;    procedure InitLock;    procedure Lock;    procedure UnLock;    procedure UnInitLock;    procedure GetResource(ABlocks: Integer);    procedure FreeResource;  public    constructor Create(const ABlocks: Integer = 10; const ABlockSize: Integer = 1024);    destructor Destroy; override;    //Get a free buffer    function  GetBuffer: Pointer;    //After use the buffer    function FreeBuffer(const ABuffer: Pointer): Boolean;  published    property BlockSize: Integer read FBlkSize;  end;implementation{ TMemoryPool }{******************************************************************************}{*     Procedure: Create                                                      *}{*       Purpose: constructor of TMemoryPool.                                 *}{*    Paramaters: ABlocks    --  Block to allocate when create.               *}{*                ABlockSize --  Each block size.                             *}{******************************************************************************}constructor TMemoryPool.Create(const ABlocks, ABlockSize: Integer);begin  InitLock;  FBlkCnt := ABlocks;  FBlkSize:= ABlockSize;  FMemHead:= nil;  FMemTail:= nil;  FreeHead:= nil;  GetResource(ABlocks);end;{******************************************************************************}{*     Procedure: Destroy                                                     *}{*       Purpose: Destrucotr of TMemoryPool.                                  *}{*    Paramaters: None.                                                       *}{******************************************************************************}destructor TMemoryPool.Destroy;begin  FreeResource;  UnInitLock;  inherited;end;{******************************************************************************}{*      Function: FreeBuffer                                                  *}{*       Purpose: Free memory buffer allocated.                               *}{*    Paramaters: ABuffer  --  Buffer address to free.                        *}{*        Return: True  --  Block is free.                                    *}{*                False --  Free error or the block not found.                *}{******************************************************************************}function TMemoryPool.FreeBuffer(const ABuffer: Pointer): Boolean;var  m_pTmp: pMemNode;begin  Result:= false;  Lock;  try    if (nil = ABuffer) then exit;    m_pTmp:= FMemHead;    while (m_pTmp <> nil) do    begin      if (ABuffer = m_pTmp.FAddr) then      begin        if FreeHead = nil then          FreeHead:= FMemTail        else          FreeHead:= FreeHead.FPrev;     //Move free head back        //Swap two blocks's content        m_pTmp.Free := false;        m_pTmp.FAddr:= FreeHead.FAddr;        FreeHead.Free := true;        FreeHead.FAddr:= ABuffer;        Result:= true;        exit;      end;      m_pTmp:= m_pTmp.FNext;      // Not find the block, exit      if (m_pTmp = FreeHead) then break;    end;  finally    UnLock;  end;end;{******************************************************************************}{*     Procedure: FreeResource                                                *}{*       Purpose: Free all memory allocated.                                  *}{*    Paramaters: None.                                                       *}{******************************************************************************}procedure TMemoryPool.FreeResource;var  m_pNode: pMemNode;  m_pTmp : pMemNode;begin  m_pNode:= FMemHead;  try    while (m_pNode <> nil) do    begin      m_pTmp:= m_pNode;      m_pNode:= m_pNode.FNext;      FreeMem(m_pTmp.FAddr);      Dispose(m_pTmp);    end;  except  end;  FMemHead:= nil;end;{******************************************************************************}{*      Function: GetBuffer                                                   *}{*       Purpose: Get a memroy block buffer.                                  *}{*    Paramaters: None.                                                       *}{*        Return: Pointer  --  A pointer pointer to buffer.                   *}{******************************************************************************}function TMemoryPool.GetBuffer: Pointer;begin  Lock;  try    //If there's no free memroy, allocate new memory    if (FreeHead = nil) then      GetResource(FBlkCnt);    //Return free memory head address    Result:= FreeHead.FAddr;    //Mark the block is not free    FreeHead.Free:= false;    //Move free head pointer forward    FreeHead:= FreeHead.FNext;  finally    UnLock;  end;end;{******************************************************************************}{*     Procedure: GetResource                                                 *}{*       Purpose: Allocate memroy.                                            *}{*    Paramaters: ABlocks  --  How many blocks to allocate.                   *}{******************************************************************************}procedure TMemoryPool.GetResource(ABlocks: Integer);var  m_pNode: pMemNode;  m_iTmp : Integer;begin  if (ABlocks <= 0) or (FBlkSize <= 0) then exit;  //Get new memory block  new(m_pNode);  m_pNode.Free := true;  m_pNode.FSize:= FBlkSize;  m_pNode.FPrev:= FMemTail;  GetMem(m_pNode.FAddr, FBlkSize);  m_pNode.FNext:= nil;  //If the memroy block list is empty, assign head  if FMemHead = nil then  begin    FMemHead:= m_pNode;    FMemTail:= FMemHead;    FreeHead:= FMemHead;  end  else begin    FMemTail.FNext:= m_pNode;    FMemTail:= m_pNode;  end;  if (FreeHead = nil) then    FreeHead:= m_pNode;  for m_iTmp:= 1 to ABlocks - 1 do  begin    new(m_pNode);    m_pNode.Free := true;    m_pNode.FSize:= FBlkSize;    m_pNode.FNext:= nil;    m_pNode.FPrev:= FMemTail;    GetMem(m_pNode.FAddr, FBlkSize);    FMemTail.FNext:= m_pNode;    FMemTail:= m_pNode;  end;end;procedure TMemoryPool.InitLock;begin  InitializeCriticalSection(FLock);end;procedure TMemoryPool.Lock;begin  EnterCriticalSection(FLock);end;procedure TMemoryPool.UnInitLock;begin  DeleteCriticalSection(FLock);end;procedure TMemoryPool.UnLock;begin  LeaveCriticalSection(FLock);end;end.