AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Code-Bibliothek Library: Object-Pascal / Delphi-Language Delphi Mehrere Strings auf einmal ersetzen
Thema durchsuchen
Ansicht
Themen-Optionen

Mehrere Strings auf einmal ersetzen

Ein Thema von Matze · begonnen am 7. Mär 2006 · letzter Beitrag vom 8. Mai 2006
Antwort Antwort
Benutzerbild von Matze
Matze
(Co-Admin)

Registriert seit: 7. Jul 2003
Ort: Schwabenländle
14.929 Beiträge
 
Turbo Delphi für Win32
 
#1

Mehrere Strings auf einmal ersetzen

  Alt 7. Mär 2006, 17:18
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:

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).
  Mit Zitat antworten Zitat
CalganX

Registriert seit: 21. Jul 2002
Ort: Bonn
5.403 Beiträge
 
Turbo Delphi für Win32
 
#2

Re: Mehrere Strings auf einmal ersetzen

  Alt 8. Mai 2006, 22:15
Hier findet sich eine Ergänzung/Erweiterung des obigen Source Codes von xaromz.
  Mit Zitat antworten Zitat
Antwort Antwort

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 12:43 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