tFileStream读写之间循环时间差异的原因是什么？

Question

我尝试将库存数据读写到文件中。

相同的循环计数会产生巨大的差异。实际的写作循环大约需要30分钟。

这仅仅是因为驱动器写入速度的物理限制？

有没有办法改善写作过程？

webSecurity

Answer 1

使用缓冲文件I / O.以更大的块读/写文件，根据需要管理每个块中的单个值。德尔福甚至在10.1柏林及以后都有TBufferedFileStream课程。

此外，填写列表时，请提前预先分配列表的容量，以避免在向列表中添加新项目时重新分配列表内部数组的开销。

尝试更像这样的事情：

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.StdCtrls, System.Generics.Collections;

type
  tSymbol = record
    CloseList: TList<Integer>;
    OpenList: TList<Integer>;
    VolumeList: TList<Integer>;
    constructor Create(InitialCapacity: Integer);
    procedure Cleanup;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    ProgressBar1: TProgressBar;
    Memo1: TMemo;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    ReadList, WriteList: TList<tSymbol>;
  end;

constructor tSymbol.Create(InitialCapacity: Integer);
begin
  CloseList := TList<Integer>.Create;
  CloseList.Capacity := InitialCapacity;

  OpenList := TList<Integer>.Create;
  OpenList.Capacity := InitialCapacity;

  VolumeList: TList<Integer>.Create;
  VolumeList.Capacity := InitialCapacity;
end;

procedure tSymbol.Cleanup;
begin
  CloseList.Free;
  OpenList.Free;
  VolumeList.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  FS: TFileStream;
  i, j, idx: Integer;
  Block: array of Int32;
begin
  Memo1.Lines.Add(FormatDateTime('hh:mm:ss', Time));

  ProgressBar1.Position := 0;
  ProgressBar1.Min := 0;
  ProgressBar1.Max := 1000;
  ProgressBar1.Step := 1;

  FS := T{Buffered}FileStream.Create('test', fmCreate);
  try
    SetLength(Block, 3 * 1000);

    for i := 0 to WriteList.Count-1 do
    begin
      with WriteList[i] do
      begin
        idx := 0;
        for j := 0 to 999 do
        begin
          Block[idx+0] := CloseList[j];
          Block[idx+1] := OpenList[j];
          Block[idx+2] := VolumeList[j];
          Inc(idx, 3);
        end;    
      end;

      FS.WriteBuffer(Block[0], SizeOf(Int32) * Length(Block));
      ProgressBar1.StepIt;
    end;
    //FS.FlushBuffer;
  finally
    FS.Free;
  end;

  Memo1.Lines.Add(FormatDateTime('hh:mm:ss', Time));
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  FS: TFileStream;
  Symbol: tSymbol;
  i, j, idx: Integer;
  Block: array of Int32;
begin
  Memo1.Lines.Add(FormatDateTime('hh:mm:ss', Time));

  for I := 0 to ReadList.Count-1 do
    ReadList[I].Cleanup;
  ReadList.Clear;

  ProgressBar1.Position := 0;
  ProgressBar1.Min := 0;
  ProgressBar1.Max := 999;
  ProgressBar1.Step := 1;

  FS := T{Buffered}FileStream.Create('test', fmOpenRead or fmShareDenyWrite);
  try    
    SetLength(Block, 3 * 1000);
    ReadList.Capacity := 1000;

    for i := 0 to 999{(FS.Size div 12000) - 1} do
    begin
      FS.ReadBuffer(Block[0], SizeOf(Int32) * Length(Block));

      Symbol := tSymbol.Create(1000);
      try
        idx := 0;
        for j := 0 to 999 do
        begin
          Symbol.CloseList.Add(Block[idx+0]);
          Symbol.OpenList.Add(Block[idx+1]);
          Symbol.VolumeList.Add(Block[idx+2]);
          Inc(idx, 3);
        end;

        ReadList.Add(Symbol);
      except
        Symbol.Cleanup;
        raise;
      end;

      ProgressBar1.StepIt;
    end;
  finally
    FS.Free;
  end;

  Memo1.Lines.Add(FormatDateTime('hh:mm:ss', Time));
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  Symbol: tSymbol;
  i, j: Integer;
begin
  ReadList := TList<tSymbol>.Create;

  WriteList := TList<tSymbol>.Create;    
  WriteList.Capacity := 1000;

  for i := 0 to 999 do
  begin
    Symbol := tSymbol.Create(1000);
    try
      for j := 0 to 999 do
      begin
        Symbol.CloseList.Add(0);
        Symbol.OpenList.Add(0);
        Symbol.VolumeList.Add(0);
      end;

      WriteList.Add(Symbol);
    except
      Symbol.Cleanup;
      raise;
    end;
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
  i: Integer;
begin
  if ReadList <> nil then
  begin
    for i := 0 to ReadList.Count-1 do
      ReadList[i].Cleanup;
    ReadList.Free;
  end;

  if WriteList <> nil then
  begin
    for i := 0 to WriteList.Count-1 do
      WriteList[i].Cleanup;
    WriteList.Free;
  end;
end;

话虽这么说，你可以考虑将你的3个整数值合并到另一个record中，这样你就不会浪费时间和资源来分配这么多个别列表：

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.StdCtrls, System.Generics.Collections;

type
  tSymbolValues = record
    Close: Integer;
    Open: Integer;
    Volume: Integer;
  end;

  tSymbol = record
    Values: TList<tSymbolValues>;
    constructor Create(InitialCapacity: Integer);
    procedure Cleanup;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    ProgressBar1: TProgressBar;
    Memo1: TMemo;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    ReadList, WriteList: TList<tSymbol>;
  end;

constructor tSymbol.Create(InitialCapacity: Integer); 
begin
  Values := TList<tSymbolValues>.Create;
  Values.Capacity := InitialCapacity;
end;

procedure tSymbol.Cleanup;
begin
  Values.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  FS: TFileStream;
  i, j, idx: Integer;
  Block: array of Int32;
begin
  Memo1.Lines.Add(FormatDateTime('hh:mm:ss', Time));

  ProgressBar1.Position := 0;
  ProgressBar1.Min := 0;
  ProgressBar1.Max := 1000;
  ProgressBar1.Step := 1;

  FS := T{Buffered}FileStream.Create('test', fmCreate);
  try
    SetLength(Block, 3 * 1000);

    for i := 0 to WriteList.Count-1 do
    begin
      with WriteList[i] do
      begin
        idx := 0;
        for j := 0 to Values.Count-1 do
        begin
          with Values[j] do
          begin
            Block[idx+0] := Close;
            Block[idx+1] := Open;
            Block[idx+2] := Volume;
            Inc(idx, 3);
          end;
        end;    
      end;

      FS.WriteBuffer(Block[0], SizeOf(Int32) * Length(Block));
      ProgressBar1.StepIt;
    end;
    //FS.FlushBuffer;
  finally
    FS.Free;
  end;

  Memo1.Lines.Add(FormatDateTime('hh:mm:ss', Time));
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  FS: TFileStream;
  Symbol: tSymbol;
  Values: tSymbolValues;
  i, j, idx: Integer;
  Block: array of Int32;
begin
  Memo1.Lines.Add(FormatDateTime('hh:mm:ss', Time));

  for I := 0 to ReadList.Count-1 do
    ReadList[i].Cleanup;
  ReadList.Clear;

  ProgressBar1.Position := 0;
  ProgressBar1.Min := 0;
  ProgressBar1.Max := 999;
  ProgressBar1.Step := 1;

  FS := T{Buffered}FileStream.Create('test', fmOpenRead or fmShareDenyWrite);
  try    
    SetLength(Block, 3 * 1000);
    ReadList.Capacity := 1000;

    for i := 0 to 999{(FS.Size div 12000) - 1} do
    begin
      FS.ReadBuffer(Block[0], SizeOf(Int32) * Length(Block));

      Symbol := tSymbol.Create(1000);
      try
        idx := 0;
        for j := 0 to 999 do
        begin
          Values.Open := Block[idx+0];
          Values.Close := Block[idx+1];
          Values.Volume := Block[idx+2];
          Symbol.Values.Add(Values);
          Inc(idx, 3);
        end;

        ReadList.Add(Symbol);
      except
        Symbol.Cleanup;
        raise;
      end;

      ProgressBar1.StepIt;
    end;
  finally
    FS.Free;
  end;

  Memo1.Lines.Add(FormatDateTime('hh:mm:ss', Time));
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  Symbol: tSymbol;
  Values: tSymbolValues;
  i, j: Integer;
begin
  ReadList := TList<tSymbol>.Create;

  WriteList := TList<tSymbol>.Create;    
  WriteList.Capacity := 1000;

  for i := 0 to 999 do
  begin
    Symbol := tSymbol.Create(1000);
    try
      for j := 0 to 999 do
      begin
        Values.Open := 0;
        Values.Close := 0;
        Values.Volume := 0;
        Symbol.Values.Add(Values);
      end;

      WriteList.Add(Symbol);
    except
      Symbol.Cleanup;
      raise;
    end;
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
  i: Integer;
begin
  if ReadList <> nil then
  begin
    for I := 0 to ReadList.Count-1 do
      ReadList[i].Cleanup;
    ReadList.Free;
  end;

  if WriteList <> nil then
  begin
    for I := 0 to WriteList.Count-1 do
      WriteList[i].Cleanup;
    WriteList.Free;
  end;
end;