![]() |
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! |
Re: Stringreplace einmal auslösen für alle Umlaute?
Hi,
vllt. wären auch RegEx was für dich. |
Re: Stringreplace einmal auslösen für alle Umlaute?
Zitat:
![]() Ansonsten wär das mein Vorschlag |
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:
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.
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; Ich hab das übrigens schnell mal in einer Viertelstunde hingeschmiert, scheint aber zu funktionieren. :wink: Gruß xaromz //Edit: Anhang aktualisiert |
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; |
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 |
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] |
Re: Stringreplace einmal auslösen für alle Umlaute?
So, hier der Source (ist doch etwas umfangreicher geworden)
Delphi-Quellcode:
In der dritten zeile findet sich
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;
Delphi-Quellcode:
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).
GBufSize = 500000;
|
Re: Stringreplace einmal auslösen für alle Umlaute?
Funktioniert super gut und super schnell!
1A! Lob an dich SirThornberry! Vielen dank! |
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 21:50 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 by Thomas Breitkreuz