Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Library: Object-Pascal / Delphi-Language (https://www.delphipraxis.net/35-library-object-pascal-delphi-language/)
-   -   Delphi Mehrere Strings auf einmal ersetzen (https://www.delphipraxis.net/64738-mehrere-strings-auf-einmal-ersetzen.html)

Matze 7. Mär 2006 16:18


Mehrere Strings auf einmal ersetzen
 
Unser neuer Moderator zeigt hier, wie es möglich ist, mehrere Strings, in seinem Beispiel die Umlaute, in einem Durchgang zu ersetzen, ohne Umwege, wie mehrmaliges Aufrufen von StringReplace.

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;
Bemerkungen hierzu:

Delphi-Quellcode:
GBufSize = 500000;
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 beispielsweise 500.000 Zeichen aus der Datei gelesen, müssen im schlimmsten Fall 1.000.000 Zeichen geschrieben werden (wenn alle Zeischen Umlaute sind). Deshalt ist der Schreibbuffer auch doppelt so groß.
In dem Quelltext ist der Buffer auf ein halbes MByte gesetzt, sodass 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).

CalganX 8. Mai 2006 21:15

Re: Mehrere Strings auf einmal ersetzen
 
Hier findet sich eine Ergänzung/Erweiterung des obigen Source Codes von xaromz.


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