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>
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>
Comment