AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Suchen und Löschen von Text in Memos

Ein Thema von Cumgrinder · begonnen am 11. Apr 2010 · letzter Beitrag vom 13. Apr 2010
Antwort Antwort
Seite 1 von 2  1 2      
Cumgrinder

Registriert seit: 11. Apr 2010
7 Beiträge
 
#1

Suchen und Löschen von Text in Memos

  Alt 11. Apr 2010, 13:18
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
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.163 Beiträge
 
Delphi 12 Athens
 
#2

Re: Suchen und Löschen von Text in Memos

  Alt 11. Apr 2010, 13:36
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.
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests
  Mit Zitat antworten Zitat
fatalerror
(Gast)

n/a Beiträge
 
#3

Re: Suchen und Löschen von Text in Memos

  Alt 11. Apr 2010, 13:45
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 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 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
  Mit Zitat antworten Zitat
Benutzerbild von jfheins
jfheins

Registriert seit: 10. Jun 2004
Ort: Garching (TUM)
4.579 Beiträge
 
#4

Re: Suchen und Löschen von Text in Memos

  Alt 11. Apr 2010, 13:57
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)
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.163 Beiträge
 
Delphi 12 Athens
 
#5

Re: Suchen und Löschen von Text in Memos

  Alt 11. Apr 2010, 14:44
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.
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests
  Mit Zitat antworten Zitat
Cumgrinder

Registriert seit: 11. Apr 2010
7 Beiträge
 
#6

Re: Suchen und Löschen von Text in Memos

  Alt 11. Apr 2010, 16:16
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
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.
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.


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;
  Mit Zitat antworten Zitat
Cumgrinder

Registriert seit: 11. Apr 2010
7 Beiträge
 
#7

Re: Suchen und Löschen von Text in Memos

  Alt 11. Apr 2010, 22:42
Danke für eure Hilfe. Schönes Board
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
43.163 Beiträge
 
Delphi 12 Athens
 
#8

Re: Suchen und Löschen von Text in Memos

  Alt 12. Apr 2010, 08:47
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
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>
Garbage Collector ... Delphianer erzeugen keinen Müll, also brauchen sie auch keinen Müllsucher.
my Delphi wish list : BugReports/FeatureRequests
  Mit Zitat antworten Zitat
Cumgrinder

Registriert seit: 11. Apr 2010
7 Beiträge
 
#9

Re: Suchen und Löschen von Text in Memos

  Alt 12. Apr 2010, 23:15
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:

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]
  Mit Zitat antworten Zitat
mkinzler
(Moderator)

Registriert seit: 9. Dez 2005
Ort: Heilbronn
39.851 Beiträge
 
Delphi 11 Alexandria
 
#10

Re: Suchen und Löschen von Text in Memos

  Alt 12. Apr 2010, 23:18
Achtung falsche Grenze und Richtung!
For y := filelist.Count-1 downto 0 Do
Markus Kinzler
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 1 von 2  1 2      


Forumregeln

Es 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

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 15:44 Uhr.
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