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;