在大型文本文件中查找和替换文本（Delphi XE5）

Question

我正在尝试在文本文件中查找和替换文本。过去，我可以使用以下方法来完成此操作：

procedure SmallFileFindAndReplace(FileName, Find, ReplaceWith: string);
begin
  with TStringList.Create do
    begin
    LoadFromFile(FileName);
    Text := StringReplace(Text, Find, ReplaceWith, [rfReplaceAll, rfIgnoreCase]);
    SaveToFile(FileName);
    Free;
  end;
end;

当文件相对较小的时候，以上内容可以正常工作。但是，当文件大小达到170 Mb左右时，上述代码会导致以下错误：EOutOfMemory，信息为“内存不足” 我已经尝试了以下方法，并取得了成功，不过运行时间很长：

procedure Tfrm_Main.button_MakeReplacementClick(Sender: TObject);
var
  fs : TFileStream;
  s  : AnsiString;
  //s  : string;
begin
  fs := TFileStream.Create(edit_SQLFile.Text, fmOpenread or fmShareDenyNone);
  try
    SetLength(S, fs.Size);
    fs.ReadBuffer(S[1], fs.Size);
  finally
    fs.Free;
  end;
  s := StringReplace(s, edit_Find.Text, edit_Replace.Text, [rfReplaceAll, rfIgnoreCase]);
  fs := TFileStream.Create(edit_SQLFile.Text, fmCreate);
  try
    fs.WriteBuffer(S[1], Length(S));
  finally
    fs.Free;
  end;
end;

我刚接触“Streams”和缓冲区相关的工作。

是否有更好的方法来处理这个问题？

谢谢。

- Mark Davich

---

打开文件，读取一定数量的行并执行搜索/替换，然后将结果写入另一个临时文件。继续读取、替换和写入，直到文件结束。之后，删除原始文件并将临时文件重命名为原始名称。 - LU RD

Answer 1

在第一个代码示例中，您有两个错误，在第二个示例中，您有三个错误：

1. 不要在内存中加载整个大文件，特别是在32位应用程序中。如果文件大小超过~1 GB，则始终会出现“内存不足”错误。
2. StringReplace 对于较大的字符串速度会变慢，因为需要反复进行内存重新分配。
3. 在第二个代码示例中，您没有使用文件的文本编码，因此（对于Windows），您的代码“认为”文件具有UCS2编码（每个字符两个字节）。但是，如果文件编码是Ansi（每个字符一个字节）或UTF8（字符大小可变），则会发生什么？

因此，为了正确地查找和替换，您必须使用文件编码并读取/写入文件部分，如LU RD所说：

interface

uses
  System.Classes,
  System.SysUtils;

type
  TFileSearchReplace = class(TObject)
  private
    FSourceFile: TFileStream;
    FtmpFile: TFileStream;
    FEncoding: TEncoding;
  public
    constructor Create(const AFileName: string);
    destructor Destroy; override;

    procedure Replace(const AFrom, ATo: string; ReplaceFlags: TReplaceFlags);
  end;

implementation

uses
  System.IOUtils,
  System.StrUtils;

function Max(const A, B: Integer): Integer;
begin
  if A > B then
    Result := A
  else
    Result := B;
end;

{ TFileSearchReplace }

constructor TFileSearchReplace.Create(const AFileName: string);
begin
  inherited Create;

  FSourceFile := TFileStream.Create(AFileName, fmOpenReadWrite);
  FtmpFile := TFileStream.Create(ChangeFileExt(AFileName, '.tmp'), fmCreate);
end;

destructor TFileSearchReplace.Destroy;
var
  tmpFileName: string;
begin
  if Assigned(FtmpFile) then
    tmpFileName := FtmpFile.FileName;

  FreeAndNil(FtmpFile);
  FreeAndNil(FSourceFile);

  TFile.Delete(tmpFileName);

  inherited;
end;

procedure TFileSearchReplace.Replace(const AFrom, ATo: string;
  ReplaceFlags: TReplaceFlags);
  procedure CopyPreamble;
  var
    PreambleSize: Integer;
    PreambleBuf: TBytes;
  begin
    // Copy Encoding preamble
    SetLength(PreambleBuf, 100);
    FSourceFile.Read(PreambleBuf, Length(PreambleBuf));
    FSourceFile.Seek(0, soBeginning);

    PreambleSize := TEncoding.GetBufferEncoding(PreambleBuf, FEncoding);
    if PreambleSize <> 0 then
      FtmpFile.CopyFrom(FSourceFile, PreambleSize);
  end;

  function GetLastIndex(const Str, SubStr: string): Integer;
  var
    i: Integer;
    tmpSubStr, tmpStr: string;
  begin
    if not(rfIgnoreCase in ReplaceFlags) then
      begin
        i := Pos(SubStr, Str);
        Result := i;
        while i > 0 do
          begin
            i := PosEx(SubStr, Str, i + 1);
            if i > 0 then
              Result := i;
          end;
        if Result > 0 then
          Inc(Result, Length(SubStr) - 1);
      end
    else
      begin
        tmpStr := UpperCase(Str);
        tmpSubStr := UpperCase(SubStr);
        i := Pos(tmpSubStr, tmpStr);
        Result := i;
        while i > 0 do
          begin
            i := PosEx(tmpSubStr, tmpStr, i + 1);
            if i > 0 then
              Result := i;
          end;
        if Result > 0 then
          Inc(Result, Length(tmpSubStr) - 1);
      end;
  end;

var
  SourceSize: int64;

  procedure ParseBuffer(Buf: TBytes; var IsReplaced: Boolean);
  var
    i: Integer;
    ReadedBufLen: Integer;
    BufStr: string;
    DestBytes: TBytes;
    LastIndex: Integer;
  begin
    if IsReplaced and (not(rfReplaceAll in ReplaceFlags)) then
      begin
        FtmpFile.Write(Buf, Length(Buf));
        Exit;
      end;

    // 1. Get chars from buffer
    ReadedBufLen := 0;
    for i := Length(Buf) downto 0 do
      if FEncoding.GetCharCount(Buf, 0, i) <> 0 then
        begin
          ReadedBufLen := i;
          Break;
        end;
    if ReadedBufLen = 0 then
      raise EEncodingError.Create('Cant convert bytes to str');

    FSourceFile.Seek(ReadedBufLen - Length(Buf), soCurrent);

    BufStr := FEncoding.GetString(Buf, 0, ReadedBufLen);
    if rfIgnoreCase in ReplaceFlags then
      IsReplaced := ContainsText(BufStr, AFrom)
    else
      IsReplaced := ContainsStr(BufStr, AFrom);

    if IsReplaced then
      begin
        LastIndex := GetLastIndex(BufStr, AFrom);
        LastIndex := Max(LastIndex, Length(BufStr) - Length(AFrom) + 1);
      end
    else
      LastIndex := Length(BufStr);

    SetLength(BufStr, LastIndex);
    FSourceFile.Seek(FEncoding.GetByteCount(BufStr) - ReadedBufLen, soCurrent);

    BufStr := StringReplace(BufStr, AFrom, ATo, ReplaceFlags);
    DestBytes := FEncoding.GetBytes(BufStr);
    FtmpFile.Write(DestBytes, Length(DestBytes));
  end;

var
  Buf: TBytes;
  BufLen: Integer;
  bReplaced: Boolean;
begin
  FSourceFile.Seek(0, soBeginning);
  FtmpFile.Size := 0;
  CopyPreamble;

  SourceSize := FSourceFile.Size;
  BufLen := Max(FEncoding.GetByteCount(AFrom) * 5, 2048);
  BufLen := Max(FEncoding.GetByteCount(ATo) * 5, BufLen);
  SetLength(Buf, BufLen);

  bReplaced := False;
  while FSourceFile.Position < SourceSize do
    begin
      BufLen := FSourceFile.Read(Buf, Length(Buf));
      SetLength(Buf, BufLen);
      ParseBuffer(Buf, bReplaced);
    end;

  FSourceFile.Size := 0;
  FSourceFile.CopyFrom(FtmpFile, 0);
end;

使用方法：

procedure TForm2.btn1Click(Sender: TObject);
var
  Replacer: TFileSearchReplace;
  StartTime: TDateTime;
begin
  StartTime:=Now;
  Replacer:=TFileSearchReplace.Create('c:\Temp\123.txt');
  try
    Replacer.Replace('some текст', 'some', [rfReplaceAll, rfIgnoreCase]);
  finally
    Replacer.Free;
  end;

  Caption:=FormatDateTime('nn:ss.zzz', Now - StartTime);
end;

- kami

---

谢谢。那个完美地运行了。还要感谢您的代码批评，非常有帮助。那是一个非常好的课程，我将能够从中学到很多东西。 - Mark Davich

Answer 2

你第一次尝试会在内存中创建文件的多个副本:

1. 它将整个文件加载到内存中 (TStringList)
2. 访问 .Text 属性时，它会创建该内存的一个副本
3. 当将该字符串传递给 StringReplace 时，它会创建另一个该内存的副本 (该副本是在 StringReplace 中生成的结果。)

你可以尝试通过去除其中一个或多个副本来解决内存不足的问题:

例如，将文件读入简单字符串变量而不是 TStringList， 或保留字符串列表，但对每行分别运行 StringReplace，并逐行将结果写入文件。

这将增加代码可以处理的最大文件大小，但仍会因巨大的文件而耗尽内存。如果要处理任意大小的文件，则应采用第二种方法。

- dummzeuch

---

谢谢。指出多个副本非常有用，您为将来提供了更好的实践方法。 - Mark Davich

Answer 3

我认为需要改进Kami的代码以解决找不到字符串的问题，但字符串的新实例可能出现在缓冲区的末尾。else语句是不同的：

if IsReplaced then begin
    LastIndex := GetLastIndex(BufStr, AFrom);
    LastIndex := Max(LastIndex, Length(BufStr) - Length(AFrom) + 1);
end else
    LastIndex :=Length(BufStr) - Length(AFrom) + 1;

- Guy Glirbas

Answer 4

不，我认为第二种选项（如果您想要一个完全通用的任意大小文件的搜索和替换功能）没有更快的方法。如果根据您的要求编写代码，可能可以制作更快的版本，但是作为通用的搜索和替换功能，我认为无法加速...例如，您确定需要不区分大小写的替换吗？我预计这将是替换功能中花费大量时间的一部分。尝试（只是为了好玩）去掉该要求，并查看在大文件上执行是否不会加快执行速度（这取决于StringReplace函数的内部编码方式 - 如果它具有特定的优化以进行区分大小写的搜索）。

- HeartWare

---

谢谢。我按照您的建议操作，发现时间上没有太大差异： 使用：[rfReplaceAll, rfIgnoreCase] --> 时间 = 30.299 秒 使用：[rfReplaceAll] --> 时间 = 31.040 秒。 所以我现在选择第二个选项。 - Mark Davich

@MarkDavich：这让我有点惊讶。当进行区分大小写的搜索时，我本来期望它会更快一些... - HeartWare

Answer 5

正确的修复方法是这个:

if IsReplaced then
begin
    LastIndex := GetLastIndex(BufStr, AFrom);
    LastIndex := Max(LastIndex, Length(BufStr) - Length(AFrom) + 1);
end
else
  if FSourceFile.Position < SourceSize then
    LastIndex := Length(BufStr) - Length(AFrom) + 1
  else
    LastIndex := Length(BufStr);

- mikese