内存池

unit MemPool;

interface

uses windows;

const
  HEAP_ZERO_MEMORY = $00000008;
  ITEM_SIZE = 16; //单数据尺寸
  BUF_SIZE  = 30 * (ITEM_SIZE+1); //池总大小，"+1"用于表示该行数据是否使用
var
  pBuffer : Pointer; //内存池指针

procedure AllocateBuffer;
procedure ReleaseBuffer;
procedure WriteBuffer(data:Pointer; len:Integer=ITEM_SIZE);
function ReadBuffer:Pointer;

implementation

var
  CurrPos : Pointer;   //当前要读出的数据
  FreePos : Pointer;   //空缓冲指针
  LastPos : Pointer;   //最后一个数据的位置

////////////////////////////////////////////////////////////////////////////////
//初始化缓冲区
////////////////////////////////////////////////////////////////////////////////
procedure AllocateBuffer;
begin
  pBuffer:=nil;
  CurrPos:=nil;
  FreePos:=nil;
  LastPos:=nil;
  pBuffer:=HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY,BUF_SIZE);
  CurrPos:=pBuffer; //当前位置指向缓冲区头
  FreePos:=pBuffer; //所有内存均为空
  LastPos:=PChar(pBuffer) + BUF_SIZE - ITEM_SIZE -1;//计算最后一个数据的位置
end;


// 此部分准备改成再分配,还未改完
procedure AllocateBuffer1;
begin
   HeapAlloc(GetProcessHeap + BUF_SIZE , HEAP_ZERO_MEMORY,BUF_SIZE);
//  CurrPos:=pBuffer; //当前位置指向缓冲区头
//  FreePos:=pBuffer; //所有内存均为空
//  LastPos:=PChar(pBuffer) + BUF_SIZE - ITEM_SIZE -1;//计算最后一个数据的位置
end;

////////////////////////////////////////////////////////////////////////////////
//释放缓冲区
////////////////////////////////////////////////////////////////////////////////
procedure ReleaseBuffer;
begin
  HeapFree(GetProcessHeap, 0, pBuffer);
  pBuffer:=nil;
  CurrPos:=nil;
  FreePos:=nil;
  LastPos:=nil;
end;

////////////////////////////////////////////////////////////////////////////////
//写入缓冲区
////////////////////////////////////////////////////////////////////////////////
procedure WriteBuffer(data:Pointer; len:Integer=ITEM_SIZE);
begin
  MoveMemory(PChar(FreePos)+1,data,len);//写入数据
  Byte(FreePos^):=1;              //标志位置为可读
  if FreePos=LastPos then
    FreePos:=pBuffer
  else
    inc(PChar(FreePos),ITEM_SIZE+1);
end;

function ReadBuffer:Pointer;
begin
  Result:=nil;
  if Byte(CurrPos^)=0 then exit;  // 根据标志来判断
  Result:=PChar(CurrPos)+1;       // 移到下一块的第一个位置
  Byte(CurrPos^):=0;
  if CurrPos=LastPos then
    CurrPos:=pBuffer
  else
    inc(PChar(CurrPos),ITEM_SIZE+1);
end;

end.

调用部分

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,MemPool;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    ListBox1: TListBox;
    Edit1: TEdit;
    Button4: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Memo1.Clear;
  AllocateBuffer;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  ReleaseBuffer;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i,j:Integer;
  s:String;
begin
  Memo1.Lines.Clear;
  j:=0;
  s:=format('%.8d',[0])+':  ';
  for i:=0 to BUF_SIZE-1 do
  begin
    inc(j);
    s:=s+inttohex(pByte(pchar(pBuffer)+i)^,2)+' ';
    if j=ITEM_SIZE+1 then
    begin
      Memo1.Lines.Add(s);
      s:=format('%.8d',[i])+':  ';
      j:=0;
    end;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  WriteBuffer(PChar(Edit1.Text),Edit1.GetTextLen);
  Button1.Click;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  b:array[1..16] of byte;
  i:Integer;
  s:string;
  d:pointer;
begin
  d:=ReadBuffer;
  if d=nil then exit;
  MoveMemory(@b,d,16);
  s:='';
  for i:=1 to 16 do
    s:=s+IntToHex(b[i],2)+' ';
  listbox1.Items.Add(s);
  Button1.Click;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  AllocateBuffer;
  Button1Click(nil);
end;

end.