使用Delphi向Firebird BLOB字段批量添加文档时内存溢出

问题根源分析 #

你的代码里主要有两个核心问题导致内存占用飙升：

1. 数据集默认全量加载记录：Delphi的数据集默认FetchAll=True，会把查询到的几千条记录全部缓存到内存中，处理过程中这些记录不会自动释放，内存占用随处理条数持续增长。
2. 隐性资源积累：虽然你手动释放了流对象，但数据集缓存的记录包含Blob字段的元数据，长期积累后也会占用大量内存。

修复方案 #

1. 关闭数据集全量加载，改为逐条获取

在打开数据集前设置FetchAll := False，让数据集仅加载当前处理的单条记录，处理完下一条后自动释放上一条的内存，从根源减少内存占用。

2. 优化代码结构（可选但推荐）

避免使用with语句，改为显式引用数据集，既提升代码可读性，也能避免意外的对象引用错误。

修改后的完整代码 #

procedure TfrmMigration.Button1Click(Sender: TObject);
var
  DocFile: string;
  Blob: TStream;
  fs: TFileStream;
begin
  DM.qImageList.Close;
  DM.qImageList.SQL.Text := ImgListSQL;
  // 关键设置：禁止全量加载，仅获取当前处理的记录
  DM.qImageList.FetchAll := False;
  DM.qImageList.Open;
  try
    while not DM.qImageList.Eof do
    begin
      if DM.qImageList.FieldByName('Document_Files').IsNull then
      begin
        DocFile := Trim(gsDocumentPath + '\' + DM.qImageList.FieldByName('ImageName').AsString);
        if FileExists(DocFile) then
        begin
          DM.qImageList.Edit;
          Blob := DM.qImageList.CreateBlobStream(DM.qImageList.FieldByName('Document_Files'), bmWrite);
          try
            fs := TFileStream.Create(DocFile, fmOpenRead or fmShareDenyWrite);
            try
              Blob.CopyFrom(fs, fs.Size);
            finally
              fs.Free;
            end;
          finally
            Blob.Free;
          end;
          DM.qImageList.Post;
        end;
      end;
      DM.qImageList.Next;
    end;
  finally
    DM.qImageList.Close;
  end;
end;

额外优化建议 #

• 分批处理超大记录量：如果处理上万条记录，可将查询拆成分批次执行，比如每次查询100条，处理完后关闭数据集再加载下一批，进一步降低内存峰值。
• 用FastMM检测泄漏：开启Delphi的FastMM内存检测工具，排查是否存在其他隐性资源泄漏（如未释放的字段对象）。
• 调整Firebird驱动参数：检查Firebird客户端驱动配置，确保大Blob不会被不必要地缓存到内存中。

内容的提问来源于stack exchange，提问作者Homer Jones