优化Delphi文件记录读取效率及修复时段筛选代码问题

需求与问题 #

• 需求：优化Delphi中大容量二进制文件的记录读取效率，文件内TlFab记录按时间从旧到新排序，支持按用户选择的日期范围加载数据并展示到StringGrid。
• 问题：当前实现代码在起始记录不在选定日期范围时无法正常工作，且读取逻辑存在效率问题。

现有代码 #

Type TlFab = Record
               Value1 : SmallInt;
               Value2 : SmallInt;     
               Value3 : String[10];
               date   : TDateTime;
             End;

Var TabRecords    : Array Of TlFab;

Procedure LoadRecordsFromFile(Sender : Tobject);

Var f        : File;   
    PtrBuf,
    Buf      : ^TlFab;

    i,
    Index,
    PosFile,
    NToRead,
    NReaded        : Integer;

    NbRecords     : Integer;
    i   : Integer; // 重复定义的变量

    SearchFinished : Boolean;

Begin

  AssignFile(f, 'test.bin');
{$I-}
  FileMode := fmOpenRead;
  Reset(f, SizeOf(Buf^));
  FileMode := fmOpenReadWrite; // 只读文件无需设置为读写模式
{$I+}

  If (IoResult <> 0) Then
  Begin
    MessageDlg('Error', mtWarning, [mbOK], 0);
    Exit;
  End;

  i := 0;                 
  NbRecords := Filesize(f);     

  SetLength(TabRecords, NbRecords); // 预先分配全量空间，浪费内存

  NToRead := 65000 Div SizeOf(Buf^);
  GetMem(Buf, Word(NToRead * SizeOF(Buf^)));
  PtrBuf := Buf;
  PosFile := Filesize(f);

  SearchFinished:= FALSE;

  Repeat
  Begin
    NReaded := 0;
    PosFile := PosFile - NToRead;
    If(PosFile < 0) Then
    Begin
      NToRead := NToRead + PosFile; 
      PosFile := 0;
    End;

    Seek(f,PosFile);

    Buf := PtrBuf;
    BlockRead(f,Buf^, NToRead, NReaded);

    Inc(Buf, Pred(NReaded));

    For Index := NReaded Downto 1 Do
    Begin
        // 错误：TabRecords[i]没有DateFin字段，应该是date
        TabRecords[i].DateFin := Buf^.date;

        // 逻辑错误：遇到不在范围的记录就终止，会漏掉中间符合条件的记录
        If (TabRecords[i].DateFin > DateTimePickerDateFin.DateTime)    Or
           (TabRecords[i].DateFin < DateTimePickerDateDebut.DateTime)  Then
        Begin
          SearchFinished := TRUE;
        End

        TabRecords[i].Value1        := Buf^.Value1;
        TabRecords[i].Value2        := Buf^.Value2;
        // 逻辑错误：Value3是字符串，不能做减法运算
        TabRecords[i].Value3        := Buf^.Value3 - i - 1; //** Real position in the file

        Inc(i);

        Dec(Buf);
      End;
  End
  Until (i >= NbRecords) Or
        (NReaded < NToRead) Or
        (PosFile = 0) Or
        (SearchFinished);

  SetLength(TabRecords, i); 
  
  CloseFile(f);       
  FreeMem(PtrBuf);
End;

问题分析 #

1. 变量重复定义：i在Var段被定义了两次，编译会报错。
2. 读取逻辑错误：文件记录按旧到新排序（开头旧，末尾新），代码从末尾倒读，一旦遇到不在日期范围的记录就终止，会漏掉中间符合条件的记录（比如用户选的是中间日期范围，倒读时先读到的新记录可能超出范围，直接终止后读不到前面的符合记录）。
3. 内存浪费：预先分配全量记录的数组空间，大容量文件会占用过多内存。
4. 字段赋值错误：TabRecords[i].DateFin是不存在的字段，应该是date；Value3是字符串类型，不能做减法运算，原注释的"真实文件位置"逻辑错误。
5. 文件模式冗余：只读文件无需设置fmOpenReadWrite，保持fmOpenRead即可。

解决方案 #

利用记录按时间排序的特性，用二分查找快速定位符合日期范围的起始记录，再从该位置顺序读取直到超出结束日期，这样只加载需要的记录，既解决逻辑问题又提升效率。

修正后的代码 #

Type TlFab = Record
               Value1 : SmallInt;
               Value2 : SmallInt;     
               Value3 : String[10];
               date   : TDateTime;
               FilePos: Integer; // 新增字段存储记录在文件中的位置
             End;

Var TabRecords    : Array Of TlFab;

// 辅助函数：读取指定位置的单个记录
function ReadRecordAtPos(const FileHandle: file; Pos: Integer): TlFab;
var
  BytesRead: Integer;
begin
  Seek(FileHandle, Pos);
  BlockRead(FileHandle, Result, 1, BytesRead);
  if BytesRead <> 1 then
    FillChar(Result, SizeOf(TlFab), 0);
end;

Procedure LoadRecordsFromFile(Sender : Tobject);
Var 
  f               : file of TlFab;
  StartPos, EndPos, MidPos, TotalRecords : Integer;
  TargetStartDate, TargetEndDate : TDateTime;
  CurrentRecord   : TlFab;
  RecordCount     : Integer;
begin
  TargetStartDate := DateTimePickerDateDebut.DateTime;
  TargetEndDate := DateTimePickerDateFin.DateTime;

  AssignFile(f, 'test.bin');
{$I-}
  Reset(f);
{$I+}
  if IoResult <> 0 then
  begin
    MessageDlg('无法打开文件', mtWarning, [mbOK], 0);
    Exit;
  end;

  TotalRecords := FileSize(f);
  if TotalRecords = 0 then
  begin
    CloseFile(f);
    SetLength(TabRecords, 0);
    Exit;
  end;

  // 二分查找第一个 >= TargetStartDate 的记录位置
  StartPos := 0;
  EndPos := TotalRecords - 1;
  while StartPos < EndPos do
  begin
    MidPos := (StartPos + EndPos) div 2;
    CurrentRecord := ReadRecordAtPos(f, MidPos);
    if CurrentRecord.date < TargetStartDate then
      StartPos := MidPos + 1
    else
      EndPos := MidPos;
  end;

  // 确认起始位置的记录是否符合范围
  CurrentRecord := ReadRecordAtPos(f, StartPos);
  if CurrentRecord.date > TargetEndDate then
  begin
    CloseFile(f);
    SetLength(TabRecords, 0);
    Exit;
  end;

  // 从起始位置开始读取所有符合范围的记录
  RecordCount := 0;
  SetLength(TabRecords, 0);
  Seek(f, StartPos);
  while not Eof(f) do
  begin
    BlockRead(f, CurrentRecord, 1);
    if CurrentRecord.date > TargetEndDate then
      Break;

    // 记录文件位置
    CurrentRecord.FilePos := StartPos + RecordCount;
    // 动态扩容数组
    Inc(RecordCount);
    SetLength(TabRecords, RecordCount);
    TabRecords[RecordCount-1] := CurrentRecord;
  end;

  CloseFile(f);
end;

优化点说明 #

1. 二分查找定位起始点：避免全量读取，直接定位到第一个符合起始日期的记录，大幅提升大容量文件的读取效率。
2. 顺序读取符合范围的记录：从起始点开始读取，直到记录日期超出结束日期，确保所有符合条件的记录都被加载。
3. 动态内存分配：按需扩容数组，避免预先分配全量内存，减少内存占用。
4. 修正字段错误：新增FilePos字段存储记录在文件中的位置，替换原错误的Value3运算逻辑。
5. 简化文件操作：使用file of TlFab类型，无需手动计算记录大小，代码更简洁。

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