Out of Memory

[simlei]

Jaa ich hab gaanz viele Datensätze eingelesen (es waren etwa 23000 mit jeweils 16 string-Feldern), da kam nicht sehr überraschend "Out of Memory". Ich habe 2048 MB RAM, wo kann ich einstellen, dass Delphi mehr davon nutzt?

[SirThornberry]

Das ist eigentlich sache des Betriebssystems. Es kommt hauptsächlich darauf an wie du den Speicher anforderst. In der Regel bekommt man das Problem wenn man zu viel Zusammenhängenden Speicher anfordert (Zum Beispiel bei einem Array etc.)

[Der_Unwissende]

Hi,
wohin liest Du denn die Datensätze ein? An sich wird Delphi was den genutzen Speicher angeht nicht wirklich durch die Größe Deines RAM beschränkt. Vielmehr wird Speicher vom Betriebsystem angefordert und dieses lagert eben auch auf die Festplatte aus (virtuelle Speicher).
Hier wäre es schön, wenn Du kurz zeigen kannst, wie Du die Datensätze ausliest und sagst, was Du mit denen vor hast. Es sollte selten (oder gar nicht) nötig sein, dass Du wirklich 23.000 Datensätze gleichzeitig betrachten musst.

Gruß Der Unwissende

[Bernhard Geyer]

Höhrt sich für mich nach einem Fehler/Problem des Standardmemory-Managers von Delphi (bis zu Version 2006) an.
Probier mal FastMM. Damit solltest du auch dein vermutlich noch im Programm vorhandnen Speicherlücken auch entdecken.

[Luckie]

Gar nicht. Dein Prozess bekommt von Windows einen virtuellen Adressraum von effektiven 2 GB zugewiesen. Und das muss reichen. Mehr gibt es nicht. Du solltest also besser dein Design überdenken oder deine Speicherverwaltung überarbeiten.

[simlei]

das System wurde gerade erst eingerichtet...
Ich lese sehr viele Kundendaten aus Outlook aus. Dabei müssen viele Emails verschmolzen werden (die Daten), ohne dass ich vorher weiß welche und wieviele. das erkenne ich erst wenn ich sie auslese (Schlüssel steht in den Mials selbst). Deshalb kann ich nicht einfach einen Teil abarbeiten und dann den nächsten nehmen, da _vielleicht_ das allererste und das allerletzte Item zusammengehören und ich sie so im Speicher halten muss.

[Der_Unwissende]

Zitat:

Zitat von simlei

Ich lese sehr viele Kundendaten aus Outlook aus. Dabei müssen viele Emails verschmolzen werden (die Daten), ohne dass ich vorher weiß welche und wieviele. das erkenne ich erst wenn ich sie auslese (Schlüssel steht in den Mials selbst). Deshalb kann ich nicht einfach einen Teil abarbeiten und dann den nächsten nehmen, da _vielleicht_ das allererste und das allerletzte Item zusammengehören und ich sie so im Speicher halten muss.

Da solltest Du Dich mit der Idee eines Index beschäftigen. Ist eigentlich klassisch in jedem DBS zu finden! Du liest einfach die Datensätze ein und erstellst einen Index über die Schlüssel. Hier solltest Du einen Schlüssel finden können, der deutlich kleiner als der komplette Inhalt der Mail ist oder sind gerade die 16 String Felder Dein Schlüssel? Wichtig bei der Idee wäre, dass Du eben nicht die mails selbst im Speicher hälst, sondern nur die Liste der Schlüssel und Verweise auf alle mails zu einem Schlüssel (da sollte es schon dauern, bis Du 2 GByte voll bekommst!). Hast Du so vorsortiert, kannst Du dann gezielt immer zwei mails zusammenführen. Sollte Dein Index auch hier noch zu groß werden, dann unterteile weiter, verwalte z.B. einfach einen Präfixbaum, der wiederum die einzelnen Strukturen verwaltet, die eben alle einen Schlüssel haben der mit genau diesem Präfix beginnt (ausgehend davon, dass man im Mittel eine angenäherte Gleichverteilung hat).

[SirThornberry]

wie bereits erwähnt kommt der Fehler in den meisten Fällen wenn große zusammenhängende Speicherbereiche angefordert werden.
Stell dir vor du hast insgesamt 2 GB platz. Alle 50 MB liegt ein Stück von einer Größe von einem Byte. Somit ist es jetzt nicht möglich ein zusammenhängendes Stück vom 100 MB zu bekommen weil ja alle 50 MB was dazwischen liegt.

Bei einigen Speichermanagern kann es aus diesem Grund auch zu dem Fehler kommen wenn du einen String immer wieder verlängerst.
Denn:
1.) String = 5 Zeischen liegt im Speicher bei Position 0
2.) Die Größe wird auf 6 Zeischen gesteigert => Ein neuer String von 6 Zeischen wird intern angelegt. Dieser beginnt an Position 5 (von 0 bis 4 liegt ja der alte string). Dann werd der alte 5 Zeischen lange String an den Beginn des 6 Zeischen langen Strings kopiert und der Speicherbereich von 0 bis 4 kann frei gegeben werden
3.) Die Größe wird auf 7 Zeischen gesteigert => Ein neuer String von 7 Zeischen wird intern angelegt. Dieser beginnt an Position 11 (von 5 bis 10 liegt ja der alte string und 0 bis 4 ist zu wenig platz). Dann werd der alte 6 Zeischen lange String an den Beginn des 7 Zeischen langen Strings kopiert und der Speicherbereich von 5 bis 10 kann frei gegeben werden.

So setzt sich das immer weiter fort. Resultat ist das du zwar freien Speicher hast aber eben irgendwann nicht mehr genügend zusammenhängenden Speicher.

[simlei]

helfen da solche defrag-programme was (nicht für die festplatte jetzt ;) ) ?

[SirThornberry]

da helfen keine Defrag-Programme. Da hilft die Verwendung eines anderen Speichermanager oder besser, die Verwendung eines algorythmus der das beachtet.
Zum Beispiel anstelle tausend mal an einen String etwas anzuhängen kann man vorher die benötigte Länge berechnen, 1 mal die Länge des Strings setzen und dann in diesen String (also in den Speicherbereich des Strings) die Daten rein kopieren.
negativ Beispiel:

Delphi-Quellcode:

var
  lCount  : Integer;
  lquelle,
  lzeile  : String;
begin
  lQuelle := 'abc';
  lZiel   := '';
  for lCount := 0 to 999 do
  begin
    lZiel := lZiel + lQuelle;
  end;

besser:

Delphi-Quellcode:

var
  lCount,
  lLenQuelle : Integer;
  lquelle,
  lzeile    : String;
begin
  lQuelle := 'abc';
  lLenQuelle := Length(lQuelle);
  SetLength(lZiel, 1000 * lLenQuelle);
  for lCount := 0 to 999 do
  begin
    move(lQuelle[1], lZiel[1 + lCount * lLenQuelle], lLenQuelle);
  end;

[simlei]

Ich habe aber eigentlich nur Typen, die Werte enthalten. Im Programm werden nur AnsiMidStr und Zuweisungen ausgeführt, also keine Aneinanderkettung. Die Zeichenketten werden eben in diese Typen gespeichert, man muss auch sagen, dass es 14 Felder pro Typ gibt. Diese sind jedoch maximal 100 chars lang. Das ergäbe bei mir großzügig gerechnet:

30000(Datensätze) * 14(Felder) * 100(Chars) * 1 Byte(ein Char)
=42 MB.

Selbst wenn man berücksichtigt, dass effektiv nicht ein, sondern vier Byte genutzt werden, komme ich auf 168 MB. Bevor ich das Programm starte, hatte ich noch ca. 1500 MB ungenutzten Speicher. naja, ich weiß nicht was ich davon halten soll, alle Rechnerei ist ja ganz schön, aber...

[simlei]

ich hab jetzt eine Compileranweisung gefunden...

{$MINSTACKSIZE number}
{$MAXSTACKSIZE number}

hilft mir das vielleicht weiter? (habe keine Zeit nochmal 4 Stunden laufen zu lassen bis vielleicht EOutOfMemory)...

[SirThornberry]

Die Stackgröße kann man auch in den Projektoptionen ändern. Und die Stackgröße spielt nur eine Rolle bei Rekusion und lokalen Variablen, insbesondere bei lokalen statichen Arrays.
Wenn du den Fehler erst nach einiger Zeit bekommst vergisst du vielleicht was frei zu geben?!
Könntest du den Quelltext eventuell posten?

[simlei]

ja mache ich... leider erst morgen, da ich den quelltext nicht hier habe. morgen um 8 dann :)
Edit: ich habe ein dynamisches Array mit allen TDatensätzen... und das wächst immer weiter... also wächst auch der Speicherverbrauch...

Source coming soon...
(Ich habe den PC über nacht mal laufen lassen (dort, wo ich morgen sein werde) und der liefert mir dann genaue Infos über Abbruchzeit, Datensatzanzahl usw... Deswegen auch der TRY-EXCEPT-Post vorhin.)

[simlei]

So, ich hab wie gesagt mal laufen lassen, der Fehler ist wie erwartet nochmal aufgetreten.
Zur allgemeinen Info, ich lese aus Outlook Mails aus, ziehe gezielt Informationen heraus und speichere diese ab.
Zurzeit ist eine Mail ein Datensatz. Später werden aber immer 2 Mails zusammengehären, welche an unterschiedlichen Orten liegen und ich weiß zu Beginn nicht, wo, was später eine Schwierigkeit darstellt wegen OutOfMemory.

Der Quelltext: (Delphi 7)
€: Die wichtigsten Prozeduren sind die, die weiter unten stehen...
€2: musste noch ein paar Zensuren vornehmen :P

Delphi-Quellcode:

// Datensatz

TDataSetLic1 = record
  PurchaseOption    : string;
  TypeOfPlatform    : string;
  TypeOf_License    : string;
  Clients_name      : string;

  Contact_person    : string;
  Clients_email     : string;
  Clients_phone     : string;
  Expiration        : string;
  Price             : string;
  server            : string;
  note              : string;

  license_user      : string;
  license_pass      : string;

  folder            : string;
  art               : string;
  subject           : string;
  from              : string;
end;

TMail = record
  body              : string;
  from              : string;
  subject           : string;
  folder            : string;
  time: string;
end;


var
  Form1: TForm1;
  // für Outlook-Zugriff
  Outlook: _Application;  // OutlookApplication; for D5 users
  NmSpace: NameSpace;
  //der aktuelle Order in Outlook
  Folder: MAPIFolder;

  // keine großen Arrays, max. 20 Felder
  folderStrings: array of string;
  forbiddenFolders: array of string;

  // großes Array, bisher liegen hier all Datensätze
  licenseSet1: array of TDataSetLic1;

  //Unwichtig
  testbereich: boolean;

  // Für die Statistik
  start_global_timer: boolean;
  st_timerAll, st_counterAll          : integer;
  st_timerFolder, st_counterFolder    : integer;
  st_speedFolder, st_speedAll, st_ETA : real;
  st_lastMailTime, st_last100MailTime : integer;


implementation

uses Math;

{$R *.dfm}

// Outlook-Zugriff
procedure initializeOutlookAccess();
var
  Unknown: IUnknown;
  Result: HResult;
begin
  {$IFDEF VER120}      // Delphi 4
  Outlook := CoApplication_.Create;
  {$ELSE}              // Delphi 5
  Outlook := CoOutlookApplication.Create;
  {$ENDIF}

  NmSpace := Outlook.GetNamespace('MAPI');
  NmSpace.Logon('', '', False, False);
  Folder := NmSpace.GetDefaultFolder(olPublicFoldersAllPublicFolders);

  Application.ProcessMessages
end;

//Testoutput, zeigt den Inhalt des aktuellen Ordners ("Folder") an
procedure listFolder(output:TStrings);
var i: integer;
begin
output.Clear;
output.Add('FOLDER: ' + Folder.Name + ' enthält:' + #13#10 + '~~~~~~~~~~~~~~~~~~~~~~~~');

For i := 1 To Folder.Folders.Count do
  begin
    output.Add(Folder.Folders.Item(i).Name);
  end;
end;

// bessere Funktion zum Suchen von Zeichenfolgen
function pos2(dortsuchen, suchtext: string; suchbeginn: integer) : integer;
 var i, stelle:integer;
     teiltext:string;
begin
stelle := suchbeginn;
 result := -1;
  For i:=suchbeginn To Length(dortsuchen) do
  begin
   teiltext := AnsiMidStr(dortsuchen, i, Length(suchtext));
   if (suchtext = teiltext) then
    begin
     stelle := i;
     result:=stelle;
     break;
    end;
  end;
end;

// AnsiMidStr etwas umgemodelt
function stringbetween(input: string; beginn, ende: integer): string;
begin
 result := AnsiMidStr(input, beginn, ende-beginn);
end;

// Test. ob der aktuelle Ordner zulässig ist.
function isInForbiddenList(name: string): boolean;
var i: integer;
begin
  result := false;
  for i := 0 To Length(forbiddenFolders)-1 do if forbiddenFolders[i] = name then result := true;
end;

//Eine Angabe der Form "Ordner_1\Ordner_1_1\xy" in ["Ordner_1", "Ordner_1_1", "xy"] umwandeln.
procedure getFolderStrings(inputP: string);
var i, beginn, ende: integer;
    act_name, input: string;
    done: boolean;
begin

   SetLength(folderStrings, 0);
   done := false;

   input := '\' + inputP;
   i := 1;

  while not done do
  begin

   beginn := pos2(input, '\', i);
   ende := pos2(input, '\', beginn+1);

   done := false;

   if ende > 0 Then
   begin
     act_name := stringbetween(input, beginn+1, ende);
     SetLength(folderStrings, Length(folderStrings)+1);
     folderStrings[Length(folderStrings)-1] := act_name;
   end;

   i := ende;
   if i > 10000 Then done := true;

   if ende = -1 Then
   begin
     act_name := stringbetween(input, beginn+1, Length(input)+1);
     SetLength(folderStrings, Length(folderStrings)+1);
     folderStrings[Length(folderStrings)-1] := act_name;
     done := true;
   end;
  end;
end;

//den aktuellen Ordner (Folder) wechseln, mmithilfe getFolderStrings
procedure changeFolder(absolut: boolean; path: string);
var act_name, temp_name: string;
    i, k: integer;
    changed: boolean;
begin
  getFolderStrings(path);
  i := 0;

  if absolut Then Folder := NmSpace.GetDefaultFolder(olPublicFoldersAllPublicFolders);
  for i := 0 To Length(folderStrings)-1 do
  begin
    changed := false;
    if folderStrings[i] = '..' Then
    begin
     Folder := (Folder.Parent as MAPIFolder)
    end
    else
    begin
      for k := 1 To Folder.Folders.Count do
      begin
        temp_name := Folder.Folders.Item(k).Name;
        if temp_name = folderStrings[i] Then
        begin
          Folder := Folder.Folders.Item(k);
          changed := true;
          break;
        end;
      end;
      if not changed Then ShowMessage('Ordner ''' + FolderStrings[i] + ''' nicht gefunden!');
    end;
  end;
end;

// Welche Art Mail ist es? Per Subject und ausgewählten Teilen aus dem Mail-Body entscheiden
function characterizeMail(input: TMail): integer;
var possibility1, possibility2, possibility3, best: integer;
begin
possibility1 := 0;
possibility2 := 0;
possibility3 := 0;

if pos2(stringbetween(input.subject, 1, 16), 'ESET LLC', 1) <> -1 Then possibility1 := possibility1 + 2;
if pos2(stringbetween(input.subject, 1, 16), 'ESET - NOD32', 1) <> -1 Then possibility2 := possibility2 + 2;
if pos2(stringbetween(input.subject, 1, 16), 'Registrierung NOD32', 1) <> -1 Then possibility3 := possibility3 + 2;

if pos2(stringbetween(input.body, 320, 500), 'TypeOf_License', 1) <> -1 Then possibility1 := possibility1 + 2;
if pos2(stringbetween(input.body, 85, 145), 'has been used to register', 1) <> -1 Then possibility2 := possibility2 + 2;
if pos2(stringbetween(input.body, 1, 50), 'Schritt:', 1) <> -1 Then possibility3 := possibility3 + 2;

if ( possibility1 = 4 ) or ( possibility2 = 4  )or ( possibility3 = 4 ) Then
begin
  if possibility1 = 4 Then result := 1;
  if possibility2 = 4 Then result := 2;
  if possibility3 = 4 Then result := 3;
end
else result := 4;

(*
Mail-Art 1 - Andere sind noch nicht eingebaut.
---------------------------------------------------
SUBJECT: ESET LLC Order - NOD32 Xxxxxxx Xxxx
--------------------------------------------------

ESET's Partner/Reseller: DATSEC, DEUTSCH

Thank you!

Your order, pursuant to the below specification was received and processed.
Please, double check the information received to ensure timeliness of our services and customers satisfaction.

UserName:Password=AV-626xxxx:xxxxxxxxx
 PurchaseOption: License renewal (1 year update/upgrade)
 TypeOfPlatform: NOD32 for Win9x/Me/NT/2000/XP/2003+DOS
 TypeOf_License: 1
   Clients_name: Xxxxxxx Xxxx
 Contact_person: Xxxxxxx Xxxx
  Clients_email: [email][e-mail][/email]
  Clients_phone:
     Expiration: 08/14/2008
          Price: xx,xx
        Servers: 0
           Note:
*)

end;

// Leerzeichen Uund vllt auch noch was anderes löschen
function purgeString(input_P: string): string;
var input: string;
begin
  input := input_P;
  input := StringReplace(input, ' ', '', [rfReplaceAll]);
  Result := input;
  //input := StringReplace(input, ' ', '', [rfReplaceAll]);
end;

// Aus einer Mail den Wert einer bestimmten Zeile lesen, zB bei obigem Beispiel:
// getValueOf(Beispiel.Body, 'Expiration', ':') = '08/14/2008'
function getValueOf(input_P, name, separator: string): string;
var pos, nextbr, separatorpos: integer;
    done: boolean;
    input, line, tempName, value: string;
begin
  pos := 0;
  input := input_P + #13#10;
  done := false;

  while not done do
  begin
    nextbr := pos2(input, #13#10, pos);
    if nextbr <> -1 Then
    begin
      line := stringbetween(input, pos, nextbr);
      if pos2(line, separator, 1) <> -1 Then
      begin
        separatorpos := pos2(line, separator, 1);
        tempName := purgeString(stringbetween(line, 1, separatorpos));
        if ( LowerCase(tempName) = LowerCase(name) )
        or ( ( LowerCase(tempName)=LowerCase('Nr.Servers') ) and ( LowerCase(name) = LowerCase('Servers') ) )
        or ( ( LowerCase(tempName)=LowerCase('Price(USD)') ) and ( LowerCase(name) = LowerCase('Price') ) ) Then
        begin
           value := stringbetween(line, separatorpos+1, Length(line)+1);
           done := true;
        end;
      end;
    end
    else
    begin
      ShowMessage('NICHT GEFUNDEN: ' + #13#10 + 'getValueOf: ' + name + #13#10 + 'IN:' + #13#10 + input);
      break;
    end;

    pos := nextbr+2;
  end;
  if done Then result := value else result := '$$not found$$';
end;


//wandelt ein TMail in ein TDataSetLic1 um, mit getValueOf
function progressMail_1(input: TMail): TDataSetLic1;
var body, lic, licUser, licPass: string;
begin
  body := input.body;
  result.PurchaseOption := getValueOf(body, 'PurchaseOption', ':');
  result.TypeOfPlatform := getValueOf(body, 'TypeOfPlatform', ':');
  result.TypeOf_License := getValueOf(body, 'TypeOf_License', ':');
  result.Clients_name := getValueOf(body, 'Clients_name', ':');
  result.Contact_person := getValueOf(body, 'Contact_person', ':');
  result.Clients_email := getValueOf(body, 'Clients_email', ':');
  result.Clients_phone := getValueOf(body, 'Clients_phone', ':');
  result.Expiration := getValueOf(body, 'Expiration', ':');
  result.Price := getValueOf(body, 'Price', ':');
  result.server := getValueOf(body, 'Servers', ':');
  result.note := getValueOf(body, 'Note', ':');

  lic := getValueOf(body, 'UserName:Password', '=');

  licUser := stringbetween(lic, 1, pos2(lic, ':', 1));
  licPass := getValueOf(lic, licUser, ':');

  licPass := StringReplace(licPass, #13, '', [rfReplaceAll]);
  licPass := StringReplace(licPass, #10, '', [rfReplaceAll]);

  result.license_user := licUser;
  result.license_pass := licPass;

  result.folder := input.folder;
  result.art := 'not yet supported';
  result.subject := input.subject;
  result.from := input.from;
end;

//Statistiken
procedure printstatistics(folderLength, progress: integer);
var tick: integer;
    timeFolder, timeAll: integer;
begin
  tick := GetTickCount;
  with Form1 do
  begin
    timeFolder := tick - st_timerFolder;
    timeAll := tick - st_timerAll;
    Label17.Caption := IntToStr(timeFolder div 1000) + ' s';
    Label18.Caption := IntToStr(timeAll div 1000) + ' s';
    Label19.Caption := IntToStr(st_counterFolder);
    Label20.Caption := IntToStr(st_counterAll);
    st_speedFolder := (st_counterFolder*1000) / (tick-st_timerFolder);
    st_speedAll := (st_counterAll*1000) / (tick-st_timerAll);
    Label15.Caption := FloatToStr(RoundTo(st_speedFolder, -2)) + ' M/s';
    Label16.Caption := FloatToStr(RoundTo(st_speedAll, -2)) + ' M/s';
    st_ETA := folderLength/st_speedFolder - progress/st_speedFolder;
    Label23.Caption := FloatToStr(Round(st_ETA) ) + ' s';
  end;
end;

//~~~~~~~~~~~~~~~~~~~~~
// HAUPTPROZEDUR
// REKURSIV - durchsucht alle Unterordner des aktuellen Folder (MAPIFolder)
//~~~~~~~~~~~~~~~~~~~~~
procedure getFolderMails(folderName: string);
var i, modulo: integer;
    tempmail: TMail;
     //Lokale Statistik
    stloc_mailcounter, stloc_mailcounter100, stloc_mailtime, stloc_mail100time: integer;
begin
 TRY
  //Statistik:
  if start_global_timer Then
  begin
    st_timerAll := GetTickCount;
    start_global_timer := false;
  end;
  st_timerFolder := GetTickCount;
  st_counterFolder := 0;


  Form1.Label1.Caption := '0 / ' + IntToStr(Folder.Items.Count);
  Form1.ProgressBar1.Max := Folder.Items.Count;
  Form1.ProgressBar1.Position := 0;
  Form1.Label2.Caption := 'Processing: ';
  Form1.Label4.Caption := 'Folder:     ' + folderName;
  Application.ProcessMessages;
  //----

  modulo := Folder.Items.Count div 400;
  if modulo < 4 Then modulo := 4;

  for i := 1 To Folder.Items.Count do
  begin
    //Statistik
    stloc_mailtime := GetTickCount-stloc_mailcounter;
    stloc_mailcounter := GetTickCount;
    if st_counterFolder mod 100 = 1 Then stloc_mailcounter100 := GetTickCount;
    if st_counterFolder mod 100 = 0 Then stloc_mail100time := GetTickCount-stloc_mailcounter100;

    //Auslesen einer Mail, umwandeln von MailItem in TMail
    try
     tempmail.subject := (Folder.Items.Item(i) as MailItem).Subject;
     tempmail.from := (Folder.Items.Item(i) as MailItem).SenderName;
     tempmail.body := (Folder.Items.Item(i) as MailItem).Body;
     tempmail.folder := folderName;
     tempmail.time := DateTimeToStr((Folder.Items.Item(i) as MailItem).ReceivedTime);
    except
     Form1.Memo2.Lines.Add('FOLDER: ' + folderName + ': Fehler in Item ' + IntToStr(i));
    end;

    // Wenn sich herausstellt, dass die Mail Lizenzdaten enthält:
    if characterizeMail(tempmail) = 1 Then
    begin
      //Statistik
      inc(st_counterAll);
      inc(st_counterFolder);

      //Hinzufügen der Mail zu den anderen Daten
      SetLength(licenseSet1, Length(licenseSet1)+1);
      licenseSet1[High(licenseSet1)] := progressMail_1(tempmail);

      // Fortschrittsausgabe
      if i mod modulo = 0 Then
      begin
        Form1.Label1.Caption := IntToStr(i)+ ' / ' + IntToStr(Folder.Items.Count);
        Form1.ProgressBar1.Position := i;
        Form1.Label3.Caption := IntToStr(Round((i*100)/Folder.Items.Count)) + ' %';
        Application.ProcessMessages;
        Form1.Label2.Caption := 'Processing:                     ' + licenseSet1[High(licenseSet1)].license_user
        + ' <-> ' + licenseSet1[High(licenseSet1)].license_pass + '   |   ' + licenseSet1[High(licenseSet1)].Clients_name;


        printstatistics(Folder.Items.Count, st_counterFolder);
        Form1.Label21.Caption := IntToStr(stloc_mailtime) + ' ms';
        Form1.Label22.Caption := IntToStr(stloc_mail100time div 1000) + ' s';
      end;
    end;

  end;

  Form1.Label1.Caption := IntToStr(i-1)+ ' / ' + IntToStr(Folder.Items.Count);
  Form1.ProgressBar1.Position := i-1;

  // Nachdem alle Mails aus dem Ordner ausgelesen wurden, werden
  // nun die Unterordner rekursiv durchsucht
  for i:=1 To Folder.Folders.Count do
  begin
    if not isInForbiddenList(Folder.Folders.Item(i).Name) Then
    begin
      Folder := Folder.Folders.Item(i);
      getFolderMails(folderName + '\' + Folder.Name);
      Folder := (Folder.Parent as MAPIFolder);
    end;
  end;
 EXCEPT
   //Fehlermeldung, wahrscheinlich Out Of Memory
   //Diese Daten vom letzten Abschnitt stehen unten
   on E:SysUtils.Exception do
   begin
    Form1.Memo1.Lines.Add(' OOMemory!');
    Form1.Memo1.Lines.Add(' Folder: ' + folderName);
    Form1.Memo1.Lines.Add(' Step: ' + IntToStr(st_counterFolder));
    Form1.Memo1.Lines.Add(' Array: ' + IntToStr(Length(licenseSet1)) + ' Felder');
    Form1.Memo1.Lines.Add(' Exception: ' + E.Message + ' |  ' + E.ClassName);

    Form1.Memo1.Lines.Add('############');
    Form1.Memo1.Lines.Add('EXCEPTION');
    Form1.Memo1.Lines.Add('#Ergebnisse:#');
    Form1.Memo1.Lines.Add('############');
    Form1.Memo1.Lines.Add(IntToStr(st_counterAll) + ' Datensätze');
    Form1.Memo1.Lines.Add(IntToStr(GetTickCount-st_timerAll) + ' millisekunden');

    Form1.Memo1.Lines.SaveToFile('C:\log' + IntToStr(Random(4000)) + '.txt');
   end;
 END;
end;


//Testbereich ausklappen
procedure TForm1.Button1Click(Sender: TObject);
begin
 if testbereich then testbereich := false else testbereich := true;
 if testbereich then
 begin
   Form1.Height := 860;
   GroupBox1.Visible := true;
 end
 else
 begin
   Form1.Height := 660;
   GroupBox1.Visible := false;;
 end;
end;

// Testbutton
procedure TForm1.Button3Click(Sender: TObject);
var i: integer;
begin
  (*getFolderStrings('Datsec\Einrichtung');
  Memo1.Lines.Clear;
  For i := 0 To Length(folderStrings)-1 do Memo1.Lines.Add(folderStrings[i]);*)
  listFolder(Memo1.Lines);
end;


// gesamtes Auslesen starten!
procedure TForm1.Button2Click(Sender: TObject);
begin
  start_global_timer := true;
  st_counterAll := 0;

  // Folder auswählen
  changeFolder(true, '_Zugangsdaten');
  getFolderMails(Folder.Name);


  //Statistik
  Memo1.Lines.Add('############');
  Memo1.Lines.Add('Ende');
  Memo1.Lines.Add('#Ergebnisse:#');
  Memo1.Lines.Add('############');
  Memo1.Lines.Add(IntToStr(st_counterAll) + ' Datensätze');
  Memo1.Lines.Add(IntToStr(GetTickCount-st_timerAll) + ' millisekunden');

  Memo1.Lines.SaveToFile('C:\log' + IntToStr(Random(4000)) + '.txt');
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  //changeFolder(true, Edit2.Text);
  listFolder(Memo1.Lines);
end;

procedure TForm1.Button5Click(Sender: TObject);
var testmail: TMail;
begin
  (*testmail.body := Memo1.Text;
  testmail.subject := Edit4.Text;
  Edit3.Text := IntToStr(characterizeMail(testmail));*)
  //ShowMessage(IntToStr(pos2(Memo1.Text, #13#10, 1)));
  //ShowMessage('|' + getValueOf(Memo1.Text, Edit3.Text, ':') + '|');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  testbereich := false;
  if testbereich then
  begin
    Form1.Height := 860;
    GroupBox1.Visible := true;
  end
  else
  begin
    Form1.Height := 660;
    GroupBox1.Visible := false;;
  end;

  anz_liz1 := 0;
  SetLength(forbiddenFolders, 30);
  forbiddenFolders[0] := 'NFR';
  forbiddenFolders[1] := 'reseller';
  forbiddenFolders[2] := 'ct_renewal';
  forbiddenFolders[3] := 'xxxxxxxxxxxxx';
  forbiddenFolders[4] := 'xxxxx';
  forbiddenFolders[5] := '';
  forbiddenFolders[6] := 'unklar';
  forbiddenFolders[7] := 'Zugangsdaten_defekt';
  forbiddenFolders[8] := 'Zugangsdaten_gesperrt';
  forbiddenFolders[9] := '';
  forbiddenFolders[10] := '';
  forbiddenFolders[11] := '';
  forbiddenFolders[12] := '';
  forbiddenFolders[13] := '';
  forbiddenFolders[14] := '';
  forbiddenFolders[15] := '';
  forbiddenFolders[16] := '';
  forbiddenFolders[17] := '';
  forbiddenFolders[18] := '';
  forbiddenFolders[19] := '';

  initializeOutlookAccess;
end;

end.

Fehlerbericht vom letzten Mal:

Zitat:

OOMemory!
Folder: _Zugangsdaten\abgearbeitet\no_special\2006
Step: 2264
Array: 19780 Felder
Exception: Out of memory | EOutOfMemory
############
EXCEPTION
#Ergebnisse:#
############
19781 Datensätze
2822843 millisekunden

[SirThornberry]

Ich hab es nur mal kurz überflogen.
Es wäre hilfreich aussagekräftige Variablennamen zu verwenden (nicht Memo1 etc.)
Bezüglich Speicher ist mit der bereits erwähte Verdacht unter gekommen:

Delphi-Quellcode:

for i := 1 To Folder.Items.Count do 
begin 
  [...] 
  SetLength(licenseSet1, Length(licenseSet1)+1);

Du vergrößerst das dynamische Array immer wieder um 1 was den gleichen Effekt hat wie bei den Strings.
Setz die länge zu Begin auf die maximal mögliche Größe von "Folder.Items.Count" und wenn die schleife durchgelaufen ist kannst du es auf die tatsächlich benötigte Größe zurück verkleinern.
Du solltest den ganzen Quelltext diesbezüglich etwas überdenken/überarbeiten

[simlei]

Gut, das werde ich mal ausprobieren.