使用Delphi程序从SQL Server提取大量BLOB文件时触发内存不足错误

核心成因 #

1. FetchOptions配置完全错误：你设置了FDQuery1.FetchOptions.Mode := fmAll，这会强制FireDAC把所有查询结果（包括全部BLOB数据）一次性加载到客户端内存，3万条BLOB的总大小直接撑爆内存，和你想通过Unidirectional=True实现单向流式查询的初衷完全矛盾。
2. 字段重复查找的隐性开销：每次循环都调用FieldByName，虽然Delphi会缓存字段对象，但高频调用下仍会产生累积的内存占用与性能损耗。
3. Memo日志未有效清理：如果TrimMemo没有真正移除旧日志条目，Memo中累积的字符串会持续占用内存。

针对性优化方案 #

1. 修正FetchOptions，实现流式分批加载 #

这是解决内存溢出的核心，把一次性加载改为按需/批量加载：

FDQuery1.FetchOptions.Mode := fmOnDemand; // 按需加载，用多少从数据库取多少
FDQuery1.FetchOptions.Unidirectional := True;
FDQuery1.FetchOptions.RowsetSize := 1000; // 可选：每次批量取1000条，减少数据库交互次数

解释：fmOnDemand会让FireDAC只在需要时加载当前行/批量行的数据，配合单向模式，处理完的记录会被及时释放，不会在内存中堆积所有BLOB。

2. 提前绑定字段引用，减少重复开销 #

提前获取字段对象，避免每次循环重复查找，优化后的完整代码：

procedure TForm1.ExtractInvoicesFromBlobs(AMinInvNo, AMaxInvNo: Integer);
var
  PrintDate, FileName, BaseFolder, TargetFolder: string;
  FileStream: TFileStream;
  BlobStream: TStream;
  RecordCount: Integer;
  // 新增字段引用变量
  fPrintedFile: TBlobField;
  fFilename: TField;
  fPrintDateTime: TField;
begin
  // init
  RecordCount := 0;
  Memo1.Clear;

  // retrieve data from db
  FDQuery1.SQL.Clear;
  FDQuery1.SQL.Text := 'SELECT ID, PrintedFile, Filename, PrintDateTime ' +
                       'FROM InvoiceStorage ' +
                       'WHERE Filename BETWEEN :MinFilename AND :MaxFilename';
  FDQuery1.ParamByName('MinFilename').AsString := Format('%d.pdf', [AMinInvNo]);
  FDQuery1.ParamByName('MaxFilename').AsString := Format('%d.pdf', [AMaxInvNo]);
  
  FDQuery1.FetchOptions.Mode := fmOnDemand;
  FDQuery1.FetchOptions.Unidirectional := True;
  FDQuery1.FetchOptions.RowsetSize := 1000;
  
  FDQuery1.Open;
  
  // 提前绑定字段
  fPrintedFile := FDQuery1.FieldByName('PrintedFile') as TBlobField;
  fFilename := FDQuery1.FieldByName('Filename');
  fPrintDateTime := FDQuery1.FieldByName('PrintDateTime');

  while not FDQuery1.Eof do
  begin
    try
      PrintDate := Copy(fPrintDateTime.AsString, 1, 4);
      BaseFolder := IncludeTrailingPathDelimiter(Edit3.Text);
      TargetFolder := Format(BaseFolder + '%s', [PrintDate]);
      ForceDirectories(TargetFolder);
      BlobStream := fPrintedFile.CreateBlobStream(bmRead);
      try
        FileName := IncludeTrailingPathDelimiter(TargetFolder) + fFilename.AsString;
        FileStream := TFileStream.Create(FileName, fmCreate);
        try
          FileStream.CopyFrom(BlobStream, BlobStream.Size);
        finally
          FileStream.Free;
        end;
      finally
        BlobStream.Free;
        BlobStream := nil;
      end;

      // 每1000条处理一次日志与内存
      Inc(RecordCount);
      if RecordCount mod 1000 = 0 then
      begin
        Memo1.Lines.BeginUpdate;
        try
          // 只保留最新的进度日志，清空旧条目释放内存
          Memo1.Lines.Clear;
          Memo1.Lines.Add(Format('%d files processed...', [RecordCount]));
        finally
          Memo1.Lines.EndUpdate;
        end;
        Application.ProcessMessages;
        Sleep(50);
      end;
    except
      on E: Exception do
      begin
        Memo1.Lines.Add(Format('Error while processing record %d: %s', [RecordCount, E.Message]));
        Application.ProcessMessages;
      end;
    end;
    FDQuery1.Next;
  end;
  FDQuery1.Close;
end;

3. 优化BLOB处理的驱动配置 #

在FDConnection的参数中开启LargeBlob=True，让FireDAC以流式方式处理大BLOB，避免将整个BLOB加载到内存：

// 在FDConnection的Params中添加或修改
LargeBlob=True

4. 辅助内存回收（可选） #

在每批处理后强制回收未使用的内存，作为辅助手段（需引用Windows单元）：

if RecordCount mod 1000 = 0 then
begin
  // ... 日志处理 ...
  {$IFDEF MSWINDOWS}
  SetProcessWorkingSetSize(GetCurrentProcess, $FFFFFFFF, $FFFFFFFF);
  {$ENDIF}
end;

内容的提问来源于stack exchange，提问作者Stefan van Roosmalen