![]() |
Suchen und Löschen von Text in Memos
Ich hab mir ein kleines Tool geschrieben.
Es funktiniert zwar schon ganz gut, aber ich brauch mal Verbesserungsvorschläge. Zum Programm: 1. Es wird eine Blacklist geladen mit Wörtern. (mmo_blacklist)
Code:
2. Es wird eine weitere Liste geladen. (Liste 2) (mmo_filelist)
Haus
Pferd Apfel Syntax:
Code:
.
<Directory Name="Auto"> <xxxxxxxxxxxxxxxxxxxxx> <xxxxxxxxxxxxxxxxxxxxx> </Directory> <Directory Name="Haus"> <xxxxxxxxxxxxxxxxxxxxx> <xxxxxxxxxxxxxxxxxxxxx> <xxxxxxxxxxxxxxxxxxxxx> </Directory> <Directory Name="Blume"> <xxxxxxxxxxxxxxxxxxxxx> <xxxxxxxxxxxxxxxxxxxxx> <xxxxxxxxxxxxxxxxxxxxx> </Directory> Da in der Blacklist das Wort Haus auftaucht soll in der 2ten Liste foglendes gelöscht werden:
Code:
<Directory Name="Haus">
<xxxxxxxxxxxxxxxxxxxxx> <xxxxxxxxxxxxxxxxxxxxx> <xxxxxxxxxxxxxxxxxxxxx> </Directory> Hoffe das Prinzip ist klar geworden!! Hier mein Code.
Delphi-Quellcode:
Die Blacklist hat ca. 5000 Einträge.
procedure TForm1.b_cleanClick(Sender: TObject);
{Entfernt die vorhandenen Einträge aus der Blacklist aus der Liste} var y,i,j,k:Integer; var start,ende,dauer:TDateTime; var LineNum,ColNum : Word; begin start:=time; For y:= 0 to mmo_blacklist.Lines.Count-1 {Für jedes Wort in der Blacklist gilt} do Begin l_gesamt.Caption := inttostr(y+1)+' von '+inttostr(mmo_blacklist.Lines.Count); {Statusanzeige aktualisieren} If AnsiPos(AnsiLowerCase(mmo_blacklist.Lines[y]),AnsiLowerCase(mmo_filelist.Text))=0 {Kommt Wort in Liste2 vor ?} then {Falls Nein, mache nichts} else {Falls Ja, mache:} begin mmo_filelist.SelStart:=AnsiPos(AnsiLowerCase(mmo_blacklist.Lines[y]),AnsiLowerCase(mmo_filelist.Text)); {Markiere gefundene Stelle} CaretPos(mmo_filelist.Handle,LineNum,ColNum); {Finde Zeile Heraus} j:=LineNum; {Markiere Löschbereich Anfang} i:=j; {Markiere Löschbereich Anfang} While AnsiPos('</Directory>',mmo_filelist.Lines[j])=0 {Suche Löschbereich Ende, und setzte Marker j} do Inc(j); For k:= i to j {Loesche Löschebereich Anfang bis Ende} do mmo_filelist.Lines.Delete(i); end end; mmo_filelist.Lines.SaveToFile(dlgOpen_filelist.FileName); {Abspeichern} ende:=Time; dauer:=ende-start; l_zeit.caption:=timetostr(dauer); end; Liste 2 hat ca. 150000 Zeilen. Meine Fragen: Ich hab ein DualCore Rechner, aber nur ein Kern arbeitet. Wie kann ich den 2ten Kern auch ansprechen? Ich wollte eine Fortschrittsanzeige einbauen aber sobald ich den Vorgang starte, friert das Programm ein und reagiert nicht bis er die Listen abgearbeitet hat. Woran liegt das ? Das muss man ja irgendwie ändern können?! Die Listen sind sehr lang, ist klar dass es nicht mal eben in 2 Minuten funktioniert. Aber nach meheren Stunden spuckt er immernoch nichts aus. Habt ihr generelle Optimierungsvorschläge ? Danke im voraus :thumb: |
Re: Suchen und Löschen von Text in Memos
Kopiere den Memo-Inhalt für die Verarbeitung in eine TStringList oder verwende wenigstens
![]() Die Blacklist sieht wie XML aus, warum wird das nicht gleich als XML genutzt? Ließe sich so doch "leichter" und schneller auslesen, da schon alles fertig ausgelesen/geparst wäre. |
Re: Suchen und Löschen von Text in Memos
Zitat:
Zitat:
Zitat:
|
Re: Suchen und Löschen von Text in Memos
Zitat:
AAAAlso: 1. Wie von himitsu schon gesagt: Nicht auf memo.text zugreifen - jeder Zugriff führt dazu, dass alle Zeilen durchgegangen werden und mit Zeilenumbrüchen aneinander gehangen werden um den Text zu bekommen. Performancekiller. Bitte den Text in einer Stringvariablen zwischenspeichern. (Gilt insb. für die Filelist, siehe Punkt 2) 2. Ich würde durch die Filelist durchgehen und bei jedem Fund durch die Blacklist iterieren, um das zeug rauszuschmeißen. Dann wird das parsen nur einmal gemacht anstatt 5000 mal. 3. Keine GUI Updates während der Verarbeitung. Verlangsamen das ganze nur. Falls wider Erwarten das gnaze Zeug länger als 5 Sekunden braucht, kann man über eine Fortschrittsleiste nachdenken. (Über 1 Sekunde und unter 5 Sekunden ein Sanduhrcursor, unter 1 Sekunde gar nichts) |
Re: Suchen und Löschen von Text in Memos
PS: Threads für soeine sequentielle Abarbeitung sind nicht sonderlich einfach zu handhaben ... wie will man das aufsplitten?
Einzige Lösung für Threads: - die Liste wo gelöscht werden soll müßte aufgeteilt werden - dann werden die Teile jeweils in einem Thread verarbeitet - und am Ende müßten die Ergebnisse wieder zusammengeführt werden > das alles sollte aber nicht sonderlich lange dauern, so daß man es auch zusammen in nur einem Thread machen könnte. PS: Die StringListe in einem Memo arbeitet anders, als eine TStringListe. Diese interne Stingliste ist "nur" eine Umleitung auf das Memo und im Memo wird alles nur in einem Text verarbeitet ... somit sind dort zeilenweise Zugriffe ein Performancekiller. Memo.Text wäre zumindestens hier obtimal, wenn man den Text als ein Stück haben will und Memo.Lines.Text siehe jfheins Punkt 1, also auch ein Killer. Beim Löschen/Einfügen/Ändern von Text aus/in einem Memo wird jedesmal der komplette Text verändert, da alles zusammenhängend ist. TStringList dagegen verwaltet alle Zeilen getrennt. |
Re: Suchen und Löschen von Text in Memos
Ah, da hab ich schon ne Menge antworten. Super - Klingt alles viel versprechend.
Zitat:
Werde mich mal dransetzen und versuchen eure Vorschläge umzusetzen. Ich meld mich dann :thumb: Danke Nachtrag: Hab mal eure Ratschläge umgesetzt: - Application.Messages in 1000er Schritten - Listen werden in TStringList-Element geladen und gehandelt - Es wird die Fileliste durchgegangen und nach Einträgen in der Blacklist gesucht anstatt für jedes Element der Blacklist einmal die Filelist durchzugehen. Es funktioniert super. :cheers: Das mit DualCore war auf dem ersten Blick zu kompliziert für mich. Aber auch mit nur einem Kern war nach 22 Sekunden alles Fertig. :hello:
Delphi-Quellcode:
procedure TForm1.b_cleanClick(Sender: TObject);
{Entfernt die vorhandenen Einträge aus der Blacklist aus der Liste} var y,j,i,k:Integer; var start,ende,dauer:TDateTime; var item:string; begin i:=0; blacklist.CaseSensitive:=False; filelist.CaseSensitive:=False; start:=Time; For y := 0 to filelist.Count Do Begin If y mod 1000 = 0 {Alle 1000 Zeilen ein GUI Update} Then Begin l_gesamt.Caption:=(IntToStr(y)+' von '+inttostr(filelist.count)); Application.ProcessMessages; end; If y < filelist.Count {Da TStringList während der Prozedur immer kleiner wird, muss diese Abfrage rein} then Begin If Copy(filelist[y],1,19) = ' <Directory Name="' {Falls Element der Stringlist so anfängt, muss Dateiname Extrahiert und geprüft werden} Then begin item:=(Copy(filelist[y],20,(length(filelist[y])-21))); {Dateiname herausfinden} If blacklist.IndexOf(AnsiLowerCase(item)) <> -1 {Gibt es den Dateinamen in der Blacklist?}} Then {Wenn ja} Begin k:=y; {Markiere Anfang} While copy(filelist[k],1,16)<>' </Directory>' {Markiere Ende} Do Inc(k); For j:= y to k {Lösche} do filelist.Delete(y); inc(i) {Counter Hoch} end; End; end; end; filelist.SaveToFile('D:\Text.txt'); {Abspeichern} filelist.Free; blacklist.Free; ende:=time; dauer:=ende-start; {Zeit berechnen} l_zeit.Caption:=timetostr(dauer); l_gesamt.Caption:=inttostr(i)+' Datensätze entfernt'; end; |
Re: Suchen und Löschen von Text in Memos
Danke für eure Hilfe. Schönes Board :dp:
|
Re: Suchen und Löschen von Text in Memos
Zitat:
Sowas sollte immer besser logisch zusammenhängend erstellt und freigegeben werden. Zitat:
Delphi-Quellcode:
If AnsiPos(...) <> 0 then
Delphi-Quellcode:
Ungetestet, aber ausgehend von nachfolgender Dateiliste dürfte es so funktionieren,
uses XMLIntf, XMLDoc;
// 'ne private Methode deiner Form procedure TForm1.CleanList(FileList, BlackList: TMemo); var Files: IXMLDocument; FilesRoot: IXMLNodeList; BadWords: TStringList; i: Integer; begin Files := TXMLDocument.Create(nil); Files.LoadFromXML(FileList.Text); FilesRoot := Files.DocumentElement.ChildNodes; BadWords := TStringList.Create; try BadWords.CaseSensitive := False; BadWords.Sorted := True; BadWords.Duplicates := dupIgnore; BadWords.AddStrings(BlackList.Lines); for i := FilesRoot.Count - 1 downto 0 do if BadWords.IndexOf(FilesRoot[i].Attributes['Name']) >= 0 then FilesRoot.Delete(i); FileList.Text := Files.XML.Text; finally BadWords.Free; end; end; procedure TForm1.b_cleanClick(Sender: TObject); {Entfernt die vorhandenen Einträge aus der Blacklist aus der Liste} var Start: TDateTime; begin Start := Time; CleanList(mmo_filelist, mmo_blacklist); mmo_filelist.Lines.SaveToFile(dlgOpen_filelist.FileName); l_zeit.Caption := TimeToStr(Time - Start); end; wenn die entsprechenden Namen komplett mit einem Namen aus der BlackList übereinstimmen. Ansonsten einfach die Vergleichfunktion ändern.
XML-Code:
<Root>
<Directory Name="Auto"> <xxxxxxxxxxxxxxxxxxxxx> <xxxxxxxxxxxxxxxxxxxxx> </Directory> <Directory Name="Haus"> <xxxxxxxxxxxxxxxxxxxxx> <xxxxxxxxxxxxxxxxxxxxx> <xxxxxxxxxxxxxxxxxxxxx> </Directory> <Directory Name="Blume"> <xxxxxxxxxxxxxxxxxxxxx> <xxxxxxxxxxxxxxxxxxxxx> <xxxxxxxxxxxxxxxxxxxxx> </Directory> </Root> |
Re: Suchen und Löschen von Text in Memos
Mein Code scheint in manchen Fällen noch nicht ganz zu funktionieren.
Ich muss den Vorgang mehrmals starten, damit alle Einträge gelöscht werden. Denke aber es liegt an der Abfrage:
Delphi-Quellcode:
Ich hab mir mal deinen Code angeguckt und versucht einzubauen, funktioniert leider nicht.
For y := 0 to filelist.Count Do
Habs versucht aber ich blicke nur halbwegs durch und kann leider nicht sagen was genau nicht funktioniert. (Wie gesagt ich bin froh dass ich die Delphi Grundfunktionen beherrsche, aber von XML hab ich halt garkeine Ahnung) Denke aber es liegt an der Vergleichs Funktion. Es kommt nämlich keine Fehlermeldung, aber an der Filelist wird halt nichts verändert nach Ablauf der Prozedur. (Dauer ca. 1-2 Sekunden) Hast du vllt noch eine Idee? Kann es daran liegen das manchmal die "Directorys" ineinadner verschaltet sind?
Code:
[edit=mkinzler]Code-Tag durch Delphi-Tag ersetzt Mfg, mkinzler[/edit]
<Directory Name="Blume">
<Directory Name="Blume2"> <Directory Name="Blume3"> <xxxxxxxxxxxxxxxxxxxxx> <xxxxxxxxxxxxxxxxxxxxx> <xxxxxxxxxxxxxxxxxxxxx> </Directory> </Directory> </Directory> |
Re: Suchen und Löschen von Text in Memos
Achtung falsche Grenze und Richtung!
Delphi-Quellcode:
For y := filelist.Count-1 downto 0 Do
|
Re: Suchen und Löschen von Text in Memos
Zitat:
Wenn der Index (hier y) über eine For-Schleife durchgezählt wird, dann Löschen immer rückwärts und Einfügen immer vorwärts, (beim bloßen Verändern des Inhalts der Einträge ist es egal) denn durch diese Operationen verschieben sich die Indize der Einträge. Oder man nutzt eine While-Schleife und paßt den Index an. 1 und 2 sollen mit gelöscht werden:
Code:
[/code]
0 1 2 3 4 A
y 0 1 2 3 4 y 0 2 3 4 y 0 2 3 4 U y 0 2 3 4 y 0 2 3 4 - I y 0 2 3 4 - X A = Ausgangsbelegung U = die 2 wird übergangen, da sie vorgerutscht ist, aber y weiterzählte I = Out of Index, da das Schleifenende sich nicht anpaßt und nun ein Eintrag fehlt X = erst Recht Out of Index, da .Count=5, aber der höchte Index um Eines kleiner war (0-basierender Index) |
Re: Suchen und Löschen von Text in Memos
Zitat:
Jetzt funktioniert das Programm nahezu perfekt. |
Re: Suchen und Löschen von Text in Memos
Die Blacklist hat inzwischen fast 20000 Zeilen.
Wenn ich die Zeilen sortiere, kann ich den Vorgang dann beschleunigen ? |
Re: Suchen und Löschen von Text in Memos
Ja, denn die StringList hat für eine sortierte Liste eine besserer Suchmethode, welche durchschnittlich mit nur Log2(SL.Count div 2) Vergleichen einen String in der Liste finden kann.
Wärend es, bei einer unsortierten Liste, durchschnittlich (SL.Count div 2) Vergleiche nötig sind, da im Extrem alle Strings/Zeilen geprüft werden müssen. |
Re: Suchen und Löschen von Text in Memos
Was muss ich tun damit er den für die sortierten Listen optimierten Suchalgorithmus benutzt? Irgendeine Variable setzen?
Oder macht er das automatisch? |
Re: Suchen und Löschen von Text in Memos
Das geht automatisch.
|
Alle Zeitangaben in WEZ +1. Es ist jetzt 11:23 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz