内存管理[4]
一个使用私有堆的例子:
unit Unit1;
interfaceuses 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;
end.