unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
btnBigMem: TButton;
btnSmallMem: TButton;
btn1: TButton;
procedure btnBigMemClick(Sender: TObject);
procedure btnSmallMemClick(Sender: TObject);
procedure btn1Click(Sender: TObject);
private
FList: TList;
procedure ClearList;
public
procedure AfterConstruction; override;
procedure BeforeDestruction; override;
end;
var
Form1: TForm1;
implementation
const
RepeatCount = 5000;
{$R *.dfm}
procedure TForm1.AfterConstruction;
begin
inherited;
FList := TList.Create;
end;
procedure TForm1.BeforeDestruction;
begin
inherited;
FList.Free;
end;
procedure TForm1.btnBigMemClick(Sender: TObject);
var
i: Integer;
tmp, p: Pointer;
begin
tmp := nil;
for i := 1 to RepeatCount do
begin
//GlobalReAllocPtr(FData, i * SizeOf(Pointer), HeapAllocFlags);//换这个就没问题
ReallocMem(tmp, i * SizeOf(Pointer));
GetMem(p, 4);
FList.Add(p);
end;
FreeMem(tmp);
end;
procedure TForm1.btnSmallMemClick(Sender: TObject);
var
i: Integer;
tmp, p: Pointer;
begin
tmp := nil;
for i := 1 to RepeatCount do
begin
ReallocMem(tmp, i * SizeOf(Pointer));
end;
for i := 1 to RepeatCount do
begin
GetMem(p, 4);
FList.Add(p);
end;
FreeMem(tmp);
end;
procedure TForm1.ClearList;
var
i: Integer;
p: Pointer;
begin
for i := 0 to FList.Count - 1 do
begin
p := FList[i];
FreeMem(p);
end;
FList.Clear;
end;
procedure TForm1.btn1Click(Sender: TObject);
begin
ClearList;
end;
end.
//第1次执行btnBigMemClick之后内存暴涨50M,
//而同样程序启动后，执行btnSmallMemClick，内存几乎没有变化
//此问题影响到SetLength和TObject.Create,因为都是用到了类似的内存分配机制
