Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Object-Pascal / Delphi-Language (https://www.delphipraxis.net/32-object-pascal-delphi-language/)
-   -   Delphi Stringreplace einmal auslösen für alle Umlaute? (https://www.delphipraxis.net/64421-stringreplace-einmal-ausloesen-fuer-alle-umlaute.html)

Schaedel 3. Mär 2006 12:46


Stringreplace einmal auslösen für alle Umlaute?
 
Hallo und guten Tag,
ich hab eine ca 700MB große Textfile die von umlauten befreit werden soll.
Ich suche die schnellst mögliche Lösung dieses Probems.
Also ich weiß das Stringreplace in verbindung mit einem Memo sehr schnell ist...

Aber ich muss alle Umlaute ersetzen.
d.h. 6* Stringreplace...
Habt ihr eine Idee wie ich die Umlaute in einem Rutsch umbenennen kann?
Es sollte dabei schneller als Stringreplace sein ;)

Ich hab von Sakura ein Stück Assambler gefunden welches mir jedes mal die nächste Position von einem String gibt...

Was ist nun schneller?
Und hat jemand einen sehr schnellen Lösungsansatz...
Dank im Vorraus!

Die Muhkuh 3. Mär 2006 13:30

Re: Stringreplace einmal auslösen für alle Umlaute?
 
Hi,

vllt. wären auch RegEx was für dich.

Angel4585 3. Mär 2006 13:35

Re: Stringreplace einmal auslösen für alle Umlaute?
 
Zitat:

Zitat von Schaedel
Ich hab von Sakura ein Stück Assambler gefunden welches mir jedes mal die nächste Position von einem String gibt...

Ich hoffe das ist nicht das : Sakuras Ersatz für String Replace

Ansonsten wär das mein Vorschlag

xaromz 3. Mär 2006 13:41

Re: Stringreplace einmal auslösen für alle Umlaute?
 
Liste der Anhänge anzeigen (Anzahl: 1)
Hallo,

da ich meine Routinen schon lange mal aufbohren wollte, hab ich Deine Frage zum Anlass genommen, mein StringReplace zu überarbeiten.
Die Methode findest Du im Anhang.
Ein möglicher Aufruf wäre:
Delphi-Quellcode:
procedure TForm1.Button1Click(Sender: TObject);
var
  Old, New: array of AnsiString;
  S: AnsiString;
begin
  SetLength(Old, 7);
  SetLength(New, 7);
  Old[0] := 'ä';
  Old[1] := 'ö';
  Old[2] := 'ü';
  Old[3] := 'Ä';
  Old[4] := 'Ö';
  Old[5] := 'Ü';
  Old[6] := 'ß';

  New[0] := 'ae';
  New[1] := 'oe';
  New[2] := 'ue';
  New[3] := 'Ae';
  New[4] := 'Oe';
  New[5] := 'Ue';
  New[6] := 'ss';

  S := StringReplaceMultiple(Memo1.Text, Old, New);
  Memo1.Text := S;
end;
Das Problem ist aber natürlich, dass Du zwei 700 MB große Strings im Speicher liegen hast. Wenn das kein Problem ist, probier das hier mal aus.

Ich hab das übrigens schnell mal in einer Viertelstunde hingeschmiert, scheint aber zu funktionieren. :wink:

Gruß
xaromz

//Edit: Anhang aktualisiert

ichbins 3. Mär 2006 14:33

Re: Stringreplace einmal auslösen für alle Umlaute?
 
Bei einer 700MB großen Textfile solltest du dich aber auch fragen ob das Zeug überhaupt in den RAM passt - selbst bei 2 GB könntest du Probleme bekommen.

Ich würde das in einer Datei-Kopier-Funktion lösen:
Delphi-Quellcode:
var
  f,g:file of byte;
  i:integer;
  readbuf:array[1..4096] of byte;
  readbytes:integer;
  writebuf:array[1..8192] of byte;
  writebytes,writebufpos:integer;
begin
  assignfile(f,filename);
  assignfile(g,writefilename);
  reset(f);
  rewrite(g);
  while not eof(f) do begin
    blockread(f,readbuf,length(readbuf),readbytes);
    writebytes:=readbytes*2;
    writebufpos:=low(writebuf)-2;
    for i:=low(readbuf) to high(readbuf) do begin
      writebufpos:=writebufpos+2;
      case readbytes[i] of
        'ä': begin
               writebuf[writebufpos]:='A';
               writebuf[writebufpos+1]:='E';
             end;
        'ö': begin
         
        [...]

        'ß': begin
               writebuf[writebufpos]:='S';
               writebuf[writebufpos+1]:='S';
             end;

      end else
      begin
        writebuf[writebufpos]:=readbuf[readbufpos];
        writebufpos:=writebufpos-1;
        writebytes:=writebytes-1;
      end;    
    end;
    blockwrite(g,writebuf,writebytes);
  end;
  closefile(f);
  closefile(g);
end;

marabu 3. Mär 2006 15:15

Re: Stringreplace einmal auslösen für alle Umlaute?
 
Liste der Anhänge anzeigen (Anzahl: 1)
Ich spendiere auch noch was. Ohne safety code. Die Übersetzungstabelle kann auch einfach über eine StringList eingelesen werden - wenn es universell sein soll.

Grüße vom marabu

SirThornberry 3. Mär 2006 15:21

Re: Stringreplace einmal auslösen für alle Umlaute?
 
duch was willst du die Umlaute ersetzen? "ü" durch "ue" oder durch etwas anderes. Am einfachsten wäre es wenn du "Ü" durch ein zeischen ersetzen willst welches genau so lang ist.

Aufgrund der Dateigröße ist es am sinnvollsten direkt auf der Festplatte zu arbeiten. Wenn zum Beispiel "ü" durch mehr als 1 zeischen ersetzt werden soll wäre es wohl am sinnvollsten erst alle umlaute zu zählen (ohne ändern) um die neue benötigte Dateigröße zu bekommen. Anschließend würde man in dem Fall dann die Dateigröße ändern (datei vergrößern) und von hinten her die Datei neu schreiben. (somit bräuchte man keine temp-datei und auch keine zweite Datei)
[Edit]
Ich bastel für diese Variante mal ein Beispiel (sollte recht schnell gehen)
[/Edit]

SirThornberry 3. Mär 2006 16:20

Re: Stringreplace einmal auslösen für alle Umlaute?
 
So, hier der Source (ist doch etwas umfangreicher geworden)
Delphi-Quellcode:
procedure FileReplaceChars(AFilename: String);
const
  GBufSize = 500000;
  //Datei durchgehen und umlaute suchen um neue Dateigröße zu berechnen
  function LGetNewSize(AStream: TStream): Int64;
  var LGiveback: Int64;
      LBytes,
      LCount  : Integer;
      LBuffer : String;
  begin
    LGiveback := 0;
    SetLength(LBuffer, GBufSize);

    LBytes := AStream.Read(LBuffer[1], GBufSize);
    if LBytes > 0 then
    begin
      repeat
        for LCount := 1 to LBytes do
          if LBuffer[LCount] in ['ä','ö','ü','Ä','Ö','Ü'] then
            inc(LGiveback, 2)
          else
            inc(LGiveback);
         LBytes := AStream.Read(LBuffer[1], GBufSize);
      until LBytes = 0;
    end;
    result := LGiveback;
  end;

  //Umlaut schreiben
  procedure LWriteToStr(var AStr: String; var APos: Integer; const AToWrite: String);
  begin
    AStr[APos] := AToWrite[1];
    AStr[APos + 1] := AToWrite[2];
    inc(APos, 2);
  end;

  //Umlaute in Buffer ersetzen
  function LReplaceInBuf(var ASrc, ADst: String; ACnt: Integer): Integer;
  var LCount,
      LPosDst: Integer;
  begin
    LPosDst := 1;
    for LCount := 1 to ACnt do
    begin
      case ASrc[LCount] of
        'ä': LWriteToStr(ADst, LPosDst, 'ae');
        'ö': LWriteToStr(ADst, LPosDst, 'oe');
        'ü': LWriteToStr(ADst, LPosDst, 'ue');
        'Ä': LWriteToStr(ADst, LPosDst, 'AE');
        'Ö': LWriteToStr(ADst, LPosDst, 'OE');
        'Ü': LWriteToStr(ADst, LPosDst, 'UE');
        else begin
          ADst[LPosDst] := ASrc[LCount];
          inc(LPosDst);
        end;
      end;
    end;
    result := LPosDst - 1;
  end;
 
  //Aus Stream lesen, links von Position
  function LReadBuf(AStream: TStream; APos: Int64; var ABuffer): Integer;
  var LCnt: Integer;
  begin
    if APos < GBufSize - 1 then
      LCnt := APos + 1
    else
      LCnt := GBufSize;
    AStream.Position := APos - LCnt + 1;  
    result := AStream.Read(ABuffer, LCnt);
  end;
 
  //Datei durchgehen und umlaute ersetzen
  procedure LReplace(AStream: TStream; LOldSize: Int64);
  var LBufferDst,
      LBufferSrc : String;
      LBytes    : Integer;
      LPosDst,
      LPosSrc   : Int64;
  begin
    SetLength(LBufferDst, GBufSize * 2);
    SetLength(LBufferSrc, GBufSize);
    LPosSrc := LOldSize - 1;
    LPosDst := AStream.Size;

    LBytes := LReadBuf(AStream, LPosSrc, LBufferSrc[1]);
    if (LBytes > 0) then
    begin
      repeat
        LPosSrc := LPosSrc - LBytes;

        LBytes := LReplaceInBuf(LBufferSrc, LBufferDst, LBytes);
        LPosDst := LPosDst - LBytes;
        AStream.Position := LPosDst;
        AStream.Write(LBufferDst[1], LBytes);

        LBytes := LReadBuf(AStream, LPosSrc, LBufferSrc[1]);
      until LBytes = 0;
    end;
  end;
var LFile   : TFileStream;
    LNewSize,
    LOldSize : Int64;
begin
  if FileExists(AFilename) then
  begin
    LFile := TFileStream.Create(AFilename, fmOpenReadWrite);
    LOldSize := LFile.Size;
    LNewSize := LGetNewSize(LFile);
    if (LOldSize <> LNewSize) then //Nur was machen wenn Umlaute gefunden wurden
    begin
      LFile.Size := LNewSize;
      LReplace(LFile, LOldSize);
    end;
    LFile.Free;
  end;
end;
In der dritten zeile findet sich
Delphi-Quellcode:
GBufSize = 500000;
Dies gibt an wie groß der Buffer ist der jeweils aus der Datei eingelesen wird. Zusätzlich zu diesem Buffer der eingelesen wird gibt es noch einen Buffer der wieder rausgeschrieben wird. Dieser ist doppelt so groß angelegt. Werden also 500 000 Zeischen aus der Datei gelesen müssen im schlimmsten fall 1 000 000 geschrieben werden (wenn alle Zeischen Umlaute sind). Deshalt ist der Schreibbuffer auch doppelt so groß. In dem Quelltext oben hab ich den Buffer mal auf ein halbes MByte gesetzt so das im Speicher für die beiden Buffer dann 1,5 MByte belegt sind. Die Zahl ist recht gering, es dürfte also keine Probleme geben wenn der Puffer zum Beispiel auf 20 MByte größe gesetzt wird (dann wären 30 MByte im Arbeitsspeicher dafür vorgesehen).

Schaedel 7. Mär 2006 15:08

Re: Stringreplace einmal auslösen für alle Umlaute?
 
Funktioniert super gut und super schnell!
1A! Lob an dich SirThornberry!
Vielen dank!

MarLe 8. Mär 2006 15:28

Re: Stringreplace einmal auslösen für alle Umlaute?
 
Super Funktion von SirThornberry.

Wie würde das denn aussehen wenn man als Zieldatei nicht die Quelldatei verwenden möchte

Delphi-Quellcode:
procedure FileReplaceChars(AFileName, BFileName: String);


Alle Zeitangaben in WEZ +1. Es ist jetzt 11:29 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