1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:

implementation

type
  TSomeData = packed record
    s1: String;
    i1: Cardinal;
    i2, i3: Integer;
    i4, i5: LongInt;
    b1: Byte;
  end;

  PSomeData = ^TSomeData;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
const
  ArrSize = 100000;
  GrowSize = 16;  //muss durch ClaimSize teilbar sein!
  ClaimSize = 1;
var
  TheData: array of PSomeData;
  index: Cardinal;

  procedure GrowArray;
  begin
    SetLength(TheData, High(TheData) + GrowSize+1);
  end;

  procedure ClaimNextBlock;
  var i: Integer;
  begin
    for i := index to index+ClaimSize-1 do
    New(TheData[i]);
  end;

begin
  for index := 0 to ArrSize-1 do
  begin
    If index mod GrowSize = 0 Then GrowArray;
    If index mod ClaimSize = 0 Then ClaimNextBlock;
    TheData[index].s1 := 'Kurzer Text.';
  end;
  ShowMessage('Jetzt im Taskmanager die Speicherbelegung angucken (Win2k).'#13#10+
              'Je nach Größe von GrowSize sind es 8-100MB.');
  for index := ArrSize-1 downto 0 do
    Dispose(TheData[index]);
end;                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:

unit WinMemMan;
interface
uses Windows;

implementation

function WinGetMem(Size: Integer): Pointer;
begin
  Result := GlobalAllocPtr(GMEM_MOVEABLE, Size);
end;

function WinFreeMem(P: Pointer): Integer;
begin
  Result := GlobalFreePtr(P);
end;

function WinReallocMem(P: Pointer; Size: Integer): Pointer;
begin
  Result := GlobalReAllocPtr(P, Size, GMEM_MOVEABLE);
end;


procedure InitializeWinMemManager;
var WinMemManager: TMemoryManager;
begin
  WinMemManager.GetMem := WinGetMem;
  WinMemManager.FreeMem := WinFreeMem;
  WinMemManager.ReallocMem := WinReallocMem;
  SetMemoryManager(WinMemManager);
end;

initialization
  InitializeWinMemManager;

end.