(Moderator)
Registriert seit: 23. Sep 2003
Ort: Bockwen
12.235 Beiträge
Delphi 2006 Professional
|
Re: Stringreplace einmal auslösen für alle Umlaute?
3. Mär 2006, 17: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
|