AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Sprachen und Entwicklungsumgebungen Object-Pascal / Delphi-Language Delphi Stringreplace einmal auslösen für alle Umlaute?

Stringreplace einmal auslösen für alle Umlaute?

Ein Thema von Schaedel · begonnen am 3. Mär 2006 · letzter Beitrag vom 8. Mär 2006
 
Benutzerbild von SirThornberry
SirThornberry
(Moderator)

Registriert seit: 23. Sep 2003
Ort: Bockwen
12.235 Beiträge
 
Delphi 2006 Professional
 
#8

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

  Alt 3. Mär 2006, 16:20
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
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).
Jens
Mit Source ist es wie mit Kunst - Hauptsache der Künstler versteht's
  Mit Zitat antworten Zitat
 

Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

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 00:15 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz