如何用Delphi将多类型文档迁移至Firebird数据库BLOB字段

核心思路 #

• 借助Delphi数据库组件（FireDAC/IBX）定位目标记录
• 用TBlobStream直接关联数据库BLOB字段，通过流式写入避免大文件占用过多内存
• 同步提取并更新文件扩展名字段，用于后续文档展示逻辑

FireDAC组件库代码示例 #

procedure MigrateFilesToBlob(const ADatabase: TFDConnection; const ATable: string);
var
  Qry: TFDQuery;
  FileStream: TFileStream;
  BlobStream: TBlobStream;
  FilePath: string;
  Ext: string;
begin
  Qry := TFDQuery.Create(nil);
  try
    Qry.Connection := ADatabase;
    // 筛选未迁移的记录，假设磁盘文件名存于DiskFileName字段
    Qry.SQL.Text := Format('SELECT ID, DiskFileName FROM %s WHERE BlobField IS NULL', [ATable]);
    Qry.Open;

    while not Qry.Eof do
    begin
      FilePath := Qry.FieldByName('DiskFileName').AsString;
      if FileExists(FilePath) then
      begin
        // 提取不带点的小写扩展名
        Ext := LowerCase(ExtractFileExt(FilePath));
        if Length(Ext) > 0 then
          Ext := Copy(Ext, 2, MaxInt);

        // 事务保证迁移原子性
        ADatabase.StartTransaction;
        try
          Qry.Edit;
          // 创建写入模式的BLOB流
          BlobStream := TBlobStream.Create(Qry.FieldByName('BlobField') as TBlobField, bmWrite);
          try
            FileStream := TFileStream.Create(FilePath, fmOpenRead or fmShareDenyWrite);
            try
              // 流式复制文件内容到BLOB
              BlobStream.CopyFrom(FileStream, 0);
            finally
              FileStream.Free;
            end;
          finally
            BlobStream.Free;
          end;
          // 更新扩展名字段
          Qry.FieldByName('FileExt').AsString := Ext;
          Qry.Post;

          ADatabase.Commit;
        except
          ADatabase.Rollback;
          Writeln(Format('迁移失败：%s', [FilePath]));
          raise;
        end;
      end
      else
      begin
        Writeln(Format('文件不存在：%s', [FilePath]));
      end;

      Qry.Next;
    end;
  finally
    Qry.Free;
  end;
end;

IBX组件库代码示例 #

procedure MigrateFilesToBlobIBX(const ADatabase: TIBDatabase; const ATable: string);
var
  Qry: TIBQuery;
  Transaction: TIBTransaction;
  FileStream: TFileStream;
  BlobStream: TBlobStream;
  FilePath: string;
  Ext: string;
begin
  Transaction := TIBTransaction.Create(nil);
  Qry := TIBQuery.Create(nil);
  try
    Transaction.DefaultDatabase := ADatabase;
    Qry.Database := ADatabase;
    Qry.Transaction := Transaction;

    Transaction.StartTransaction;
    Qry.SQL.Text := Format('SELECT ID, DiskFileName FROM %s WHERE BlobField IS NULL', [ATable]);
    Qry.Open;

    while not Qry.Eof do
    begin
      FilePath := Qry.FieldByName('DiskFileName').AsString;
      if FileExists(FilePath) then
      begin
        Ext := LowerCase(ExtractFileExt(FilePath));
        if Length(Ext) > 0 then
          Ext := Copy(Ext, 2, MaxInt);

        try
          Qry.Edit;
          BlobStream := TBlobStream.Create(Qry.FieldByName('BlobField') as TBlobField, bmWrite);
          try
            FileStream := TFileStream.Create(FilePath, fmOpenRead or fmShareDenyWrite);
            try
              BlobStream.CopyFrom(FileStream, 0);
            finally
              FileStream.Free;
            end;
          finally
            BlobStream.Free;
          end;
          Qry.FieldByName('FileExt').AsString := Ext;
          Qry.Post;

          // 保留事务上下文，提升批量处理效率
          Transaction.CommitRetaining;
        except
          Transaction.RollbackRetaining;
          Writeln(Format('迁移失败：%s', [FilePath]));
          raise;
        end;
      end
      else
      begin
        Writeln(Format('文件不存在：%s', [FilePath]));
      end;

      Qry.Next;
    end;
    Transaction.Commit;
  finally
    Qry.Free;
    Transaction.Free;
  end;
end;

优化建议 #

• 批量事务提交：每处理100-200条记录提交一次事务，避免长时间占用数据库资源
• 日志记录：完善错误日志，记录失败文件的路径和异常信息，方便后续补迁
• 索引临时禁用：迁移前禁用BlobField和FileExt的索引，迁移完成后重建，大幅提升写入速度
• 大文件适配：流式写入（CopyFrom）无需加载整个文件到内存，完美支持大体积文档

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