内存管理四

一个使用私有堆的例子: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; {如果创建失败则退出}
　{从堆中分配内存}
　p := HeapAlloc(MyHeap, 0, 7);
　if p = nil then Exit; {出错退出}
　{获取内存块大小}
　num := HeapSize(MyHeap, 0, p);
　{给内存块的每个字节赋值}
　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);
　{给内存块的每个字节赋值}
　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;