Delphi-PRAXiS
Seite 1 von 2  1 2      

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Object-Pascal / Delphi-Language (https://www.delphipraxis.net/32-object-pascal-delphi-language/)
-   -   Delphi Suchen und Löschen von Text in Memos (https://www.delphipraxis.net/150248-suchen-und-loeschen-von-text-memos.html)

Cumgrinder 11. Apr 2010 13:18


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:
Haus
Pferd
Apfel
2. Es wird eine weitere Liste geladen. (Liste 2) (mmo_filelist)
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:
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;
Die Blacklist hat ca. 5000 Einträge.
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:

himitsu 11. Apr 2010 13:36

Re: Suchen und Löschen von Text in Memos
 
Kopiere den Memo-Inhalt für die Verarbeitung in eine TStringList oder verwende wenigstens Delphi-Referenz durchsuchenBeginUpdate

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.

fatalerror 11. Apr 2010 13:45

Re: Suchen und Löschen von Text in Memos
 
Zitat:

Zitat von Cumgrinder
Meine Fragen:

Ich hab ein DualCore Rechner, aber nur ein Kern arbeitet. Wie kann ich den 2ten Kern auch ansprechen?

Verwende Threads und teile die Arbeit auf mehrere Threads auf
Zitat:

Zitat von Cumgrinder
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?!

Füge ein Application.Processmessages in die Schleife ein (zb bei jedem 20 Durchlauf)

Zitat:

Zitat von Cumgrinder
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 ?

Siehe himitsus Posting

jfheins 11. Apr 2010 13:57

Re: Suchen und Löschen von Text in Memos
 
Zitat:

Zitat von Cumgrinder
Die Blacklist hat ca. 5000 Einträge.
Liste 2 hat ca. 150000 Zeilen.

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.

Du hast völlig recht, so etwas sollte nicht 2 Minuten dauern. So etwas sollte nur wenige Sekunden dauern. Damit sollten auch die Fragen nach Dualcore-Nutzung und Fortschrittsleiste irrelevant sein. Den Code guck ich mir mal kurz genauer an ;)

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)

himitsu 11. Apr 2010 14:44

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.

Cumgrinder 11. Apr 2010 16:16

Re: Suchen und Löschen von Text in Memos
 
Ah, da hab ich schon ne Menge antworten. Super - Klingt alles viel versprechend.

Zitat:

Die Blacklist sieht wie XML aus, warum wird das nicht gleich als XML genutzt?
Ja ist richtig. Die Sache ist ich hab nicht sonderlich (eher null) Ahnung von XML. Weiss garnicht mal wozu das gut ist ;)

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;

Cumgrinder 11. Apr 2010 22:42

Re: Suchen und Löschen von Text in Memos
 
Danke für eure Hilfe. Schönes Board :dp:

himitsu 12. Apr 2010 08:47

Re: Suchen und Löschen von Text in Memos
 
Zitat:

Code:
filelist.Free;
blacklist.Free;

Wo werden diese Listen denn erstellt?
Sowas sollte immer besser logisch zusammenhängend erstellt und freigegeben werden.


Zitat:

Delphi-Quellcode:
If AnsiPos(...) = 0
then {Falls Nein, mache nichts}
else {Falls Ja, mache:}

Hier hast'e es ja wohl selber mitbekommen :-D
Delphi-Quellcode:
If AnsiPos(...) <> 0 then


Delphi-Quellcode:
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;
Ungetestet, aber ausgehend von nachfolgender Dateiliste dürfte es so funktionieren,
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>

Cumgrinder 12. Apr 2010 23:15

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:
For y := 0 to filelist.Count Do
Ich hab mir mal deinen Code angeguckt und versucht einzubauen, funktioniert leider nicht.
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:
<Directory Name="Blume">
  <Directory Name="Blume2">
    <Directory Name="Blume3">
      <xxxxxxxxxxxxxxxxxxxxx>
      <xxxxxxxxxxxxxxxxxxxxx>
      <xxxxxxxxxxxxxxxxxxxxx>
   </Directory>
  </Directory>
</Directory>
[edit=mkinzler]Code-Tag durch Delphi-Tag ersetzt Mfg, mkinzler[/edit]

mkinzler 12. Apr 2010 23:18

Re: Suchen und Löschen von Text in Memos
 
Achtung falsche Grenze und Richtung!
Delphi-Quellcode:
For y := filelist.Count-1 downto 0 Do


Alle Zeitangaben in WEZ +1. Es ist jetzt 20:42 Uhr.
Seite 1 von 2  1 2      

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz