What is the reason of the huge difference of looping time between tFileStream read and write

Question

I try to read and write stock data to a file.

Same looping count makes a huge difference. The actual writing loop takes almost 30 minutes.

Is this just because of the physical limit of writing speed of the drive?

Is there any way to improve the writing process?

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>;
  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;

procedure TForm1.Button1Click(Sender: TObject); // it takes 45 seconds.
var
  _FileStream: TFileStream;
  i, j: Integer;
begin
  Memo1.Lines.Add(FormatDateTime('hh:mm:ss', Time));

  ProgressBar1.Min := 0;
  ProgressBar1.Max := 999;

  _FileStream := TFileStream.Create('test', fmCreate);

  for i := 0 to 999 do
  begin
    for j := 0 to 999 do
    begin
      _FileStream.Write(WriteList.List[i].CloseList.List[j], 4);
      _FileStream.Write(WriteList.List[i].OpenList.List[j], 4);
      _FileStream.Write(WriteList.List[i].VolumeList.List[j], 4);
    end;

    ProgressBar1.Position := i;
  end;

  _FileStream.Free;

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

procedure TForm1.Button2Click(Sender: TObject); // it takes 6 seconds.
var
  _FileStream: TFileStream;
  _Close, _Open, _Volume: Integer;
  _Symbol: tSymbol;
  i, j: Integer;
begin
  Memo1.Lines.Add(FormatDateTime('hh:mm:ss', Time));

  ProgressBar1.Min := 0;
  ProgressBar1.Max := 999;

  _FileStream := TFileStream.Create('test', fmOpenRead);

  for i := 0 to 999 do
  begin
    _Symbol.CloseList := TList<Integer>.Create;
    _Symbol.OpenList := TList<Integer>.Create;
    _Symbol.VolumeList := TList<Integer>.Create;

    for j := 0 to 999 do
    begin
      _FileStream.Read(_Close, 4);

      _Symbol.CloseList.Add(_Close);

      _FileStream.Read(_Open, 4);

      _Symbol.OpenList.Add(_Open);

      _FileStream.Read(_Volume, 4);

      _Symbol.VolumeList.Add(_Volume);
    end;

    ReadList.Add(_Symbol);

    ProgressBar1.Position := i;
  end;

  _FileStream.Free;

  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;

  _Symbol.CloseList := TList<Integer>.Create;
  _Symbol.OpenList := TList<Integer>.Create;
  _Symbol.VolumeList := TList<Integer>.Create;

  for i := 0 to 999 do
  begin
    for j := 0 to 999 do
    begin
      _Symbol.CloseList.Add(0);
      _Symbol.OpenList.Add(0);
      _Symbol.VolumeList.Add(0);
    end;

    WriteList.Add(_Symbol);
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ReadList.Free;
  WriteList.Free;
end;

Remy Lebeau · Accepted Answer · 2017-06-20T20:02:49.860

Use buffered file I/O. Read/write the file in larger chunks, managing individual values within each chunk as needed. Delphi even has a TBufferedFileStream class in 10.1 Berlin and later.

Also, when filling a list, pre-allocate the list's capacity ahead of time to avoid the overhead of having to re-allocate the list's internal array while adding new items to the list.

Try something more like this:

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;

That being said, you might consider merging your 3 integer values together into another record, that way you are not wasting time and resources having to allocate so many individual lists:

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;

The Delphi TBufferedFileStream is only well suited for reading and writing forwards in a stream. You get even worse performance than unbuffered when reading backwards. For random access, it won't make much of a difference. — dummzeuch, Jun 21 '17 at 07:19
@dummzeuch: perhaps so, but none of that applies in this particular example. Reading and writing is linear and forwards. — Remy Lebeau, Jun 21 '17 at 16:09

What is the reason of the huge difference of looping time between tFileStream read and write

1 Answers1