DruckenMister WongFacebook

Dateien patchen
System Win9x, WinNT, Win2000, WinXP, Vista, Win7
Ab Delphi-Version Delphi 1
Letzte Änderung 28.09.2010

Mit folgender Routine ist es möglich, in einer Datei nach einer Zeichenkette zu suchen und diese durch eine gleichlange Zeichenkette zu ersetzen. Vorsicht ist bei Dateien geboten, bei denen zwischendurch das Zeichen #0 vorkommt (beispielsweise bei EXE-Dateien). Die Routine bricht an einer solchen Stelle ab.

Die Funktion erwartet vier Parameter. Dem ersten Parameter wird der Dateiname übergeben. Die Parameter AOldText und ANewText enthalten die zu ersetzenden Strings. Der letzte Parameter gibt den Suchmodus an (siehe Dokumentation unter "StringReplace (Funktion)").

type
TReplaceFlags = set of (rfReplaceAll, rfIgnoreCase);

function PatchFile(const AFilename: string; AOldText, ANewText: string;
         Flags: TReplaceFlags): boolean;
const
  cMaxBuffer = 128*1024;
var
  f: TFileStream;
  i: integer;
  Buf: array[0..cMaxBuffer-1] of Char;
  OldStr: string;
  StrBuf: string;
begin
  result := false;
  if Length(AOldText) <>  Length(ANewText) then
    exit;
  ZeroMemory(@Buf, cMaxBuffer);
  if rfIgnoreCase in Flags then
    OldStr := AnsiLowerCase(AOldText)
  else
    OldStr := AOldText;

  f := TFileStream.Create(AFilename, fmOpenReadWrite or fmShareDenyWrite);
  try

    while f.Read(Buf, cMaxBuffer) > Length(AOldText) do
    begin
      StrBuf := Buf;
      f.Seek(-Length(AOldText), soFromCurrent);
      if rfIgnoreCase in Flags then
        StrBuf := AnsiLowerCase(StrBuf);

      repeat
       i := Pos(OldStr, StrBuf);
       if i > 0 then
       begin
         result := true;
         Delete(StrBuf, i, length(AOldText));
         Insert(ANewText, StrBuf, i);
         if not (rfReplaceAll in Flags) then
           break;
       end;  {if i > 0}
     until i = 0;
     f.Position := Max(f.Position + Length(AOldText) - cMaxBuffer, 0);
     f.Write(Pointer(StrBuf)^, Length(StrBuf));
     if result and not (rfReplaceAll in Flags) then
       exit;

    end;  {while}
  finally
    f.Free;
  end;
end;

Aufgerufen werden kann die Funktion beispielsweise so:

procedure TForm1.Button1Click(Sender: TObject);
begin
  if PatchFile('c:\abc.abc', 'Test', 'Text', [rfIgnoreCase, rfReplaceAll]) then
    ShowMessage('gefunden')
  else
    ShowMessage('Nicht gefunden');
end;
Ähnliche Seiten: