unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  MyHeap: THandle; {堆句柄}
  p: Pointer;

procedure TForm1.Button1Click(Sender: TObject);
var
  i,num: Integer;
  p2: Pointer;
  str: string;
begin
  {建立堆}
  MyHeap := HeapCreate(HEAP_ZERO_MEMORY, 1024*1024*2, 0); {建立個 2M 的堆}
  if Myheap = 0 then Exit; {如果創(chuàng)建失敗則退出}

  {從堆中分配內存}
  p := HeapAlloc(MyHeap, 0, 7);
  if p = nil then Exit; {出錯退出}

  {獲取內存塊大小}
  num := HeapSize(MyHeap, 0, p);

  {給內存塊的每個字節(jié)賦值}
  p2 := p;
  for i := 0 to num - 1 do
  begin
    Byte(p2^) := i + 65;
    p2 := Ptr(Integer(p2) + 1);
  end;

  {取值}
  p2 := p;
  str := '';
  for i := 0 to num - 1 do
  begin
    str := str + Chr(Byte(p2^));
    p2 := Ptr(Integer(p2) + 1);
  end;

  {顯示內存塊的內容與大小}
  ShowMessageFmt('%s,%d',[str,num]); {ABCDEFG,7}

  /////////////////////////////////////////////////////

  {擴充內存, 只此一句不同, 下面都是重復上面的代碼}
  p := HeapReAlloc(MyHeap, 0, p, 26);
  if p = nil then Exit; {出錯退出}

  {獲取內存塊大小}
  num := HeapSize(MyHeap, 0, p);

  {給內存塊的每個字節(jié)賦值}
  p2 := p;
  for i := 0 to num - 1 do
  begin
    Byte(p2^) := i + 65;
    p2 := Ptr(Integer(p2) + 1);
  end;

  {取值}
  p2 := p;
  str := '';
  for i := 0 to num - 1 do
  begin
    str := str + Chr(Byte(p2^));
    p2 := Ptr(Integer(p2) + 1);
  end;

  {顯示內存塊的內容與大小}
  ShowMessageFmt('%s,%d',[str,num]); {ABCDEFGHIJKLMNOPQRSTUVWXYZ,26}

  /////////////////////////////////////////////////////

  {釋放內存}
  HeapFree(MyHeap, 0, p);

  {銷毀堆}
  HeapDestroy(MyHeap);
end;

end.