Subversion Repositories delphiutils

Rev

Blame | Last modification | View Log | RSS feed

  1. unit BinarySafeReplace;
  2.  
  3. // BinarySafeReplace.pas
  4. // Version 1.1
  5. // by Daniel Marschall
  6. // http://www.delphipraxis.net/post778431.html
  7.  
  8. interface
  9.  
  10. uses
  11.   StrUtils, SysUtils, Classes;
  12.  
  13. // Binary-Safe. Der Parameter AString wird direkt ersetzt.
  14. // Die Anzahl der durchgefühten Ersetzungen wird als Ergebnis zurückgegeben.
  15. function StringReplacesBinarySafe(var AString: string; const ASearchPattern, AReplaceWith: string): integer;
  16.  
  17. // Direkter Ersatz für StringReplace(), Binary-Safe.
  18. // Veränderter String wird als Eregebnis zurückgegeben.
  19. function StringReplaceBinarySafe(const AString, ASearchPattern, AReplaceWith: string): string;
  20.  
  21. // BinarySafeReplaceFileContents
  22. // Die Anzahl der durchgefühten Ersetzungen wird als Ergebnis zurückgegeben.
  23. function BinarySafeReplaceFileContents(const AInputFile, AOutputFile, ASearchPattern, AReplaceWith: string): integer;
  24.  
  25. implementation
  26.  
  27. uses
  28.   PosEx;
  29.  
  30. function StringReplacesBinarySafe(var AString: string; const ASearchPattern, AReplaceWith: string): integer;
  31. var
  32.   iPos: Integer;
  33.   lastpos: Integer;
  34.   ueberhang: integer;
  35. begin
  36.   result := 0;
  37.  
  38.   if AString = '' then exit;
  39.   if ASearchPattern = '' then exit;
  40.  
  41.   UniqueString(AString); // Referenzzählung beachten. Dank an shmia für den Hinweis.
  42.  
  43.   ueberhang := length(AReplaceWith) - length(ASearchPattern);
  44.   lastpos := 1;
  45.  
  46.   while true do
  47.   begin
  48.     iPos := _PosEx(ASearchPattern, AString, lastpos);
  49.  
  50.     if iPos <= 0 then break;
  51.     if result = 7 then
  52.  
  53.     if Pred(iPos) > Length(AString) - Length(AReplaceWith) + 1 {Bugfix, Added +1. Ersetzungen am StringEnde} then break;
  54.  
  55.     if ueberhang > 0 then
  56.     begin
  57.       setlength(AString, length(AString)+ueberhang);
  58.       Move(AString[iPos], AString[iPos+ueberhang], length(AString)-iPos); // Bugfix: Hier stand length(AString)-iPos-1
  59.     end;
  60.  
  61.     Move(AReplaceWith[1], AString[iPos], Length(AReplaceWith));
  62.  
  63.     if ueberhang < 0 then
  64.     begin
  65.       Move(AString[iPos+length(ASearchPattern)], AString[iPos+length(AReplaceWith)], length(AString)-iPos-length(AReplaceWith));
  66.       setlength(AString, length(AString)+ueberhang);
  67.       ueberhang := -1;
  68.     end;
  69.  
  70.     lastpos := iPos + ueberhang + 1;
  71.     inc(result);
  72.   end;
  73. end;
  74.  
  75. function StringReplaceBinarySafe(const AString, ASearchPattern, AReplaceWith: string): string;
  76. var
  77.   tmp: string;
  78. begin
  79.   tmp := AString;
  80.   StringReplacesBinarySafe(tmp, ASearchPattern, AReplaceWith);
  81.   result := tmp;
  82. end;
  83.  
  84. function BinarySafeReplaceFileContents(const AInputFile, AOutputFile, ASearchPattern, AReplaceWith: string): integer;
  85. var
  86.   fst: TFileStream;
  87.   str: string;
  88. begin
  89.   result := -1;
  90.  
  91.   if not FileExists(AInputFile) then exit;
  92.   if not ForceDirectories(ExtractFilePath(AOutputFile)) then exit;
  93.  
  94.   fst := TFileStream.Create(AInputFile, fmOpenRead or fmShareDenyWrite);
  95.   try
  96.     fst.Position := 0;
  97.     setlength(str, fst.Size);
  98.     fst.Read(str[1], fst.Size);
  99.   finally
  100.     fst.free;
  101.   end;
  102.  
  103.   result := StringReplacesBinarySafe(str, ASearchPattern, AReplaceWith);
  104.  
  105.   fst := TFileStream.Create(AOutputFile, fmCreate);
  106.   try
  107.     fst.Position := 0;
  108.     fst.Write(str[1], length(str));
  109.   finally
  110.     fst.free;
  111.   end;
  112. end;
  113.  
  114. end.
  115.