EOutOfMemory bei gleichzeitiger Verwendung von TStringlist und dynamischen Arrays

[Günter Portisch]

Hallo,

bei gleichzeitiger Verwendung von Dynamischen Arrays und TStringlist-en tritt nach einige Tausend Einträgen ein EOutOfMemory Fehler auf. <P>

Wenn ich das Füllen der TStringlist-en oder des Dynamischen Array herausnehme kann ich über 100000 Einträge füllen ohne eine Fehlermeldung.

Hier ein Beispielprogramm, bei dem dieser Fehler auf meinem Computer nach ca. 2500 Einträgen auftritt.

Wie kann ich mit diesem Fehler umgehen? Gib es eine einfache Lösung hierzu?
In unserer Applikation haben wir sehr oft komplexere Vorgänge, die Stringlist-en und dynamische Arrays gleichzeitig füllen. Auch weil manche Standardkomponenten auch diese Techniken verwenden.

<PRE>
procedure TForm1.Button1Click(Sender: TObject);
type
TrecDaten = Record
ID : ShortString;
BLZ : ShortString;
Bez : ShortString;
lfdNr : ShortString;
end;

var
LcSQL : String;
Lii,
Li : Integer;
LLstID,
LLstBLZ,
LLstBez,
LLstlfdNr : TStringList;
x,y,z : Integer;
Bez : String;
FarrDaten : array of TrecDaten;
begin
Screen.Cursor := crSQLWait;

try
Lii := 0;
LLstID := TStringList.Create;
LLstBLZ := TStringList.Create;
LLstBez := TStringList.Create;
LLstlfdNr := TStringList.Create;
try

LLstID.Sorted := True;
LLstBLZ.Sorted := True;
LLstBez.Sorted := True;
LLstlfdNr.Sorted := True;
LLstID.Duplicates := dupIgnore;

SetLength(FarrDaten, 0);

While true do
begin
inc(Lii);
while true do
begin

SetLength(FarrDaten, Length(FarrDaten) + 1);
Li := Length(FarrDaten) - 1;
x := Trunc(Random(10000000)+1);
y := Trunc(Random(10000000)+1);
z := Trunc(Random(10000000)+1);
bez := 'lsjdlgkjsdlkgjs'+ IntToStr(Trunc(Random(10000000)+1)) + 'dfsjkdfhgjk' + IntToStr(Trunc(Random(10000000)+1));

FarrDaten[Li].ID := IntToStr(x);
FarrDaten[Li].BLZ := IntToStr(y);
FarrDaten[Li].Bez := bez;
FarrDaten[Li].lfdNr := IntToStr(z);

x := Trunc(Random(10000000)+1);
y := Trunc(Random(10000000)+1);
z := Trunc(Random(10000000)+1);
bez := 'lsjdlgkjsdlkgjs'+ IntToStr(Trunc(Random(10000000)+1)) + 'dfsjkdfhgjk' +IntToStr(Trunc(Random(10000000)+1));

Inc(Li);
LLstID.Add(IntToStr(x));
LLstBLZ.Add(IntToStr(y));
LLstBez.Add(Bez);
LLstlfdNr.Add(IntToStr(z));

Label1.Caption := IntToStr(Lii) + ', ' + IntToStr(Li);
// if Li = 1000 then Exit;
Refresh;
Application.ProcessMessages;

end;

Application.ProcessMessages;
end;

finally
Screen.Cursor := crDefault;
LLstID.Free;
LLstBLZ.Free;
LLstBez.Free;
LLstlfdNr.Free;
end;
except on E:Exception do
ShowMessage(E.Message + #13 + E.ClassName);
end;

end;

Gruß Günter
</PRE>

[Uwe Merckens]

Hi Günther,

also ich weiss zwar auch nicht, warum dyn. Arrays Speicher fressen - aber ich verwende diese auch nur noch für kleine Datenmengen. Ich hab Euer Beispiel bei mir versucht und nach 2031 Einträgen im Array ist auch meine Kiste trotz 1 GB RAM stehengeblieben. <br>
Daher hier mein Vorschlag, den ich getestet habe und der läuft:
<PRE>
unit Work2;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;

// Klasse Zugangsatz
type
TBankSatz_ptr = ^TBankSatz;
TBankSatz = class(TObject)
private
FID : ShortString;
FBLZ : ShortString;
FBez : ShortString;
FlfdNr : ShortString;
public
property ID : ShortString read FID write FID;
property BLZ : ShortString read FBLZ write FBLZ;
property Bez : ShortString read FBez write FBez;
property lfdNr : ShortString read FlfdNr write FlfdNr;
end;

TSortDir = (sdUp,sdDown);

//Klasse BankListe
type
TBankListe_ptr = ^TBankListe;
TBankListe = class(TObject)
private
FList : TList;
function GetCount: Integer;
function GetItem(X: Integer): TBankSatz;
public
constructor Create;
destructor Destroy; override;
function Add : TBankSatz;
procedure Delete(X : Integer);
procedure Clear;
procedure Sort(SortDir : TSortDir);
property Count : Integer read GetCount;
property Items[X : Integer] : TBankSatz read GetItem; default;
end;

var
BankSatz : TBankSatz;
PBankSatz : TBankSatz_ptr;
BankListe: TBankListe;
PBankListe : TBankListe_ptr;

var
Form1: TForm1;

implementation

{$R *.DFM}

function SortItemsDown(I1,I2 : TBankSatz) : Integer;
begin
if I1.lfdNr = I2.lfdNr then
Result:= 0
else
if I1.lfdNr < I2.lfdNr then
Result:= 1
else
Result:= -1;
end;

function SortItemsUp(I1,I2 : TBankSatz) : Integer;
begin
if I1.lfdNr = I2.lfdNr then
Result:= 0
else
if I1.lfdNr > I2.lfdNr then
Result:= 1
else
Result:= -1;
end;

//////////////////////////////////////////////////
/// Klasse TBankListe ///
//////////////////////////////////////////////////

function TBankListe.Add : TBankSatz;
begin
Result:= TBankSatz.Create;
FList.Add(Result)
end;

procedure TBankListe.Clear;
var
iCnt : Integer;
begin
for iCnt:= 0 to FList.Count- 1 do
TObject(FList.Items[iCnt]).Free;
FList.Clear;
end;

constructor TBankListe.Create;
begin
inherited Create;
FList:= TList.Create;
end;

procedure TBankListe.Delete(X: Integer);
begin
TObject(FList.Items[X]).Free;
FList.Delete(X);
end;

destructor TBankListe.Destroy;
begin
Clear;
FList.Free;
inherited Destroy;
end;

function TBankListe.GetCount: Integer;
begin
Result:= FList.Count;
end;

function TBankListe.GetItem(X: Integer): TBankSatz;
begin
Result:= TBankSatz(FList.Items[X]);
end;

procedure TBankListe.Sort(SortDir: TSortDir);
begin
case SortDir of
sdUp : FList.Sort(@SortItemsUp);
sdDown : FList.Sort(@SortItemsDown);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
//LcSQL : String;
Lii, Li : Integer;
LLstID,
LLstBLZ,
LLstBez,
LLstlfdNr : TStringList;
x,y,z : Integer;
Bez : String;
begin
Screen.Cursor := crSQLWait;
try
Lii := 0;
LLstID := TStringList.Create;
LLstBLZ := TStringList.Create;
LLstBez := TStringList.Create;
LLstlfdNr := TStringList.Create;
try
LLstID.Sorted := True;
LLstBLZ.Sorted := True;
LLstBez.Sorted := True;
LLstlfdNr.Sorted := True;
LLstID.Duplicates := dupIgnore;
&#10

[Uwe Merckens]

Hier der zweite Teil:
<PRE>
BankListe:= TBankListe.Create;
PBankListe:= @BankListe;
PBankSatz:= @BankSatz;
While true do
begin
inc(Lii);
while true do
begin
x := Trunc(Random(10000000)+1);
y := Trunc(Random(10000000)+1);
z := Trunc(Random(10000000)+1);
bez := 'lsjdlgkjsdlkgjs'+ IntToStr(Trunc(Random(10000000)+1)) +
'dfsjkdfhgjk' + IntToStr(Trunc(Random(10000000)+1));
PBankSatz^:= PBankListe^.Add;
PBankSatz^.BLZ:= IntToStr(x);
PBankSatz^.ID:= IntToStr(y);
PBankSatz^.lfdNr:= IntToStr(z);
PBankSatz^.Bez:= bez;
x := Trunc(Random(10000000)+1);
y := Trunc(Random(10000000)+1);
z := Trunc(Random(10000000)+1);
bez := 'lsjdlgkjsdlkgjs'+ IntToStr(Trunc(Random(10000000)+1)) +
'dfsjkdfhgjk' +IntToStr(Trunc(Random(10000000)+1));
Inc(Li);
LLstID.Add(IntToStr(x));
LLstBLZ.Add(IntToStr(y));
LLstBez.Add(Bez);
LLstlfdNr.Add(IntToStr(z));
Label1.Caption := IntToStr(Lii) + ', ' + IntToStr(Li);
if Lii = 2 then Exit;
Refresh;
Application.ProcessMessages;
end;
Application.ProcessMessages;
PBankListe^.Sort(sdUp);
end;
finally
Screen.Cursor := crDefault;
LLstID.Free;
LLstBLZ.Free;
LLstBez.Free;
LLstlfdNr.Free;
end;
except on E:Exception do
ShowMessage(E.Message + #13 + E.ClassName);
end;

end;

end.
<PRE>

Gruß
Uw

[Jochen Reichenberg]

Hi,

leider kann ich nicht genug Pascal, um den Fehler zu finden, aber irgendwo muß Speicher reserviert werden, der nicht wieder freigegeben wird.

In meinem BCB gibt es den CodeGuard, der kann mir solche Speicherlecks anzeigen. Wenn's den auch bei Delphi gibt...

Grüße

Jochen

P.S. Da fällt mir noch eine Möglichkeit ein: Bei dynamischen Arrays kann es vorkommen, daß der Speicher zwar freigegeben wird und anschließend auch rechnerisch noch genügend freier Speicher vorhanden ist, aber eben nicht mehr genügend freier Speicher als zusammenhängender Block für die nächste Allozierung

[Ulrich Gerhardt]

<i>In meinem BCB gibt es den CodeGuard, der kann mir solche Speicherlecks anzeigen. Wenn's den auch bei Delphi gibt... </i><br>
CodeGuard kenn ich nicht, aber man kann sich kostenlos MemProof downloaden. Das ist ein nützliches Teil, das u.a. Speicherlecks meldet.
<br>Ciao, Uli

[Torsten Grundke]

Hallo Günter,

wahrscheinlich liegt das Problem im ständigen Aufruf von <pre>SetLength(FarrDaten, Length(FarrDaten) + 1);</pre>. Diese Vorgehensweise ist für den Borland Memory-Manager denkbar ungünstig.

Bei fast jedem Schleifendurchgang muß einer neuer zusammenhängender Speicherbereich angefordert werden. Dann müssen die Daten aus dem alten Speicherbereich in den neuen kopiert werden. Der alte Speicherbereich wird nun innerhalb des Speichermanager als frei markiert, allerdings nicht an das Betriebssystem zurückgegeben. Da bei jedem Durchgang ein größerer Speicherbereich benötigt wird hat der Speichermanager keine Möglichkeit den alten intern freigegebenen Speicher zu "recyceln".

Darüber hinaus ist es für den Speichermanager wahrscheinlich besser wenn statt ShortStrings mit AnsiStrings gearbeitet wird. Dies sollte dem Speichermanager eher liegen.

Wenn Du vor dem Start der Schleifen bereits weißt wieviel Records angelegt werden müssen,
dann reicht ein einmaliger Aufruf von Setlength aus. Falls Dir die Info nicht zur Verfügung steht solltest Du wenigstens bei jedem SetLength gleich Speicher für mehrere Records anfordern (100, 1000, 10000 ... je nach voraussichtlichem Bedarf). Positiver Nebeneffekt -> die Performance wird sich deutlich verbessern.

Den "Speicherverbrauch" des Speichermanagers kann man über die globale Variable AllocMemSize beobachten.

Gruß

Torste

[Torsten Grundke]

Hallo,

mit den ShortStrings ist es so wie ich mir das bereits gedacht hatte. Es ist ein alter "kurzer" Pascalstring mit einer Länge von 255 Zeichen. Dieser Speicherbereich wird immer belegt egal ob der string leer ist, 10 Zeichen oder auch 255 Zeichen umfaßt.

Gruß

Torste

[Uwe Merckens]

Hi,

@Torsten<br>
Du hast natürlich vollkommen recht, mit der Speicheranforderung. Dazu kommt noch eine "hundsmiserable" Performance...<br>
Mit kleinen Objekten habe ich beste Erfahrungen gemacht - insbesondere in Verbindung mit TList. <br>
Die Anregung dazu kam i.Ü. hier aus diesem Forum :-)

Gruss
Uw

[Torsten Grundke]

Hallo Uwe,

bei TList kann man mit List.Capacity auch schon die Anzahl der Listeneinträge mitteilen. Allerdings hilft das für die Speicheranforderungen relativ wenig, weil ein Eintrag ja nur ein Pointer ist (also nur 4 Bytes belegt). Die einzelnen Objekte/Records müssen erst noch selber angelegt werden.

Der Weg über Records und dynamische Array's ist für eine vernünftige Performance schon der richtige Weg, wenn man den Speicher gleich in entsprechend großen Blöcken anfordert.

Gruß

Torste