本例在建立一个新的堆前后分别通过 GetProcessHeaps 函数获取了当前进程的堆句柄列表, 没想到一个最简单的程序也有 5 个堆.
效果图:
unit Unit1; interface uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls; type
TForm1 = class(TForm)
Memo1: TMemo;
Memo2: TMemo;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
end; var
Form1: TForm1; implementation {$R *.dfm} {把下面两个过程公用的部分提取为一个独立的过程}
procedure GetHeaps(List: TStrings);
var
HeapArr: array[..] of THandle; {对列表数组, 先假定有 10 堆}
n: Integer;
i: Integer;
begin
{获取进程中的堆列表; 函数的参数1是数组大小, 参数2是数组的第一个元素, 返回堆的实际数量}
n := GetProcessHeaps(Length(HeapArr), HeapArr[]);
List.Add(Format('当前进程共有 %d 个堆', [n])); List.Add('它们的句柄分别是:'); for i := to n - do
List.Add(IntToStr(HeapArr[i]));
end; procedure TForm1.FormCreate(Sender: TObject);
begin
Memo1.Clear; {调用公用过程, 在 Memo1 中显示堆句柄列表}
GetHeaps(Memo1.Lines); {再次添加默认堆的句柄}
Memo1.Lines.Add('');
Memo1.Lines.Add('默认堆的句柄是:');
Memo1.Lines.Add(IntToStr(GetProcessHeap));
end; procedure TForm1.Button1Click(Sender: TObject);
var
MyHeap: THandle;
begin
{创建新堆}
MyHeap := HeapCreate(, **, ); {建立个 2M 的堆} Memo2.Clear; {调用公用过程, 在 Memo2 中显示堆句柄列表}
GetHeaps(Memo2.Lines); {再次添加新建堆的句柄}
Memo2.Lines.Add('');
Memo2.Lines.Add('新建堆的句柄是:');
Memo2.Lines.Add(IntToStr(MyHeap)); {销毁新建堆}
HeapDestroy(MyHeap);
end; end.