|
Antwort |
Registriert seit: 23. Nov 2005 119 Beiträge Delphi 7 Professional |
#11
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... |
Zitat |
Registriert seit: 23. Nov 2005 119 Beiträge Delphi 7 Professional |
#12
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)... |
Zitat |
(Moderator)
Registriert seit: 23. Sep 2003 Ort: Bockwen 12.235 Beiträge Delphi 2006 Professional |
#13
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?
Jens
Mit Source ist es wie mit Kunst - Hauptsache der Künstler versteht's |
Zitat |
Registriert seit: 23. Nov 2005 119 Beiträge Delphi 7 Professional |
#14
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.) |
Zitat |
Registriert seit: 23. Nov 2005 119 Beiträge Delphi 7 Professional |
#15
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
Delphi-Quellcode:
Fehlerbericht vom letzten Mal:
// 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]xxxxxxxx@gmx.net[/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.
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 |
Zitat |
(Moderator)
Registriert seit: 23. Sep 2003 Ort: Bockwen 12.235 Beiträge Delphi 2006 Professional |
#16
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:
Du vergrößerst das dynamische Array immer wieder um 1 was den gleichen Effekt hat wie bei den Strings.
for i := 1 To Folder.Items.Count do
begin [...] SetLength(licenseSet1, Length(licenseSet1)+1); 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
Jens
Mit Source ist es wie mit Kunst - Hauptsache der Künstler versteht's |
Zitat |
Ansicht |
Linear-Darstellung |
Zur Hybrid-Darstellung wechseln |
Zur Baum-Darstellung wechseln |
ForumregelnEs ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus. Trackbacks are an
Pingbacks are an
Refbacks are aus
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
LinkBack URL |
About LinkBacks |