Delphi: TFileStream progress on read/write (without wasting performance)

Question

i want implement a progress event on TFileStream for read/write operation for assign on it a progress bar.

I have create a clild class (TProgressFileStream) of TFileStream:

unit ProgressFileStream;

interface

uses
  System.SysUtils,
  System.Classes;

type
  TProgressFileStreamOnProgress = procedure(Sender: TObject; Processed: Int64; Size: Int64; ContentLength : Int64; TimeStart : cardinal) of object;
  TProgressFileStream = class(TFileStream)
  private
    FOnProgress:    TProgressFileStreamOnProgress;
    FProcessed:     Int64;
    FContentLength: Int64;
    FTimeStart:     cardinal;
    FBytesDiff:     cardinal;
    FSize:          Int64;

    procedure Init;
    procedure DoProgress(const AProcessed : Longint);
  protected
    procedure SetSize(NewSize: Longint); overload; override;
  public
    constructor Create(const AFileName: string; Mode: Word); overload;
    constructor Create(const AFileName: string; Mode: Word; Rights: Cardinal); overload;

    function  Read(var Buffer; Count: Longint): Longint; overload; override;
    function  Write(const Buffer; Count: Longint): Longint; overload; override;
    function  Read(Buffer: TBytes; Offset, Count: Longint): Longint; overload; override;
    function  Write(const Buffer: TBytes; Offset, Count: Longint): Longint; overload; override;
    function  Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; overload; override;

    property  OnProgress: TProgressFileStreamOnProgress read FOnProgress write FOnProgress;
    property  ContentLength: Int64 read FContentLength write FContentLength;
    property  TimeStart: cardinal read FTimeStart write FTimeStart;
    property  BytesDiff: cardinal read FBytesDiff write FBytesDiff;
  end;

implementation

uses
  Winapi.Windows;

{ TProgressFileStream }

constructor TProgressFileStream.Create(const AFileName: string; Mode: Word);
begin
   inherited Create(AFileName, Mode);

   Init;
end;

constructor TProgressFileStream.Create(const AFileName: string; Mode: Word; Rights: Cardinal);
begin
   inherited Create(AFileName, Mode, Rights);

   Init;
end;

function TProgressFileStream.Read(var Buffer; Count: Longint): Longint;
begin
  Result := inherited Read(Buffer, Count);

  DoProgress(Result);
end;

function TProgressFileStream.Write(const Buffer; Count: Longint): Longint;
begin
  Result := inherited Write(Buffer, Count);

  DoProgress(Result);
end;

function TProgressFileStream.Read(Buffer: TBytes; Offset, Count: Longint): Longint;
begin
  Result := inherited Read(Buffer, Offset, Count);

  DoProgress(Result);
end;

function TProgressFileStream.Write(const Buffer: TBytes; Offset, Count: Longint): Longint;
begin
  Result := inherited Write(Buffer, Offset, Count);

  DoProgress(Result);
end;

function TProgressFileStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
begin
  Result := inherited Seek(Offset, Origin);

  if Origin <> soCurrent then
    FProcessed := Result;
end;

procedure TProgressFileStream.SetSize(NewSize: Longint);
begin
  inherited SetSize(NewSize);

  FSize := NewSize;
end;

procedure TProgressFileStream.Init;
const
  BYTES_DIFF = 1024*100;
begin
  FOnProgress    := nil;
  FProcessed     := 0;
  FContentLength := 0;
  FTimeStart     := GetTickCount;
  FBytesDiff     := BYTES_DIFF;
  FSize          := Size;
end;

procedure TProgressFileStream.DoProgress(const AProcessed : Longint);
var
  aCurrentProcessed : Longint;
begin
  if not(Assigned(FOnProgress)) then Exit;

  aCurrentProcessed := FProcessed;

  Inc(FProcessed, AProcessed);

  if FContentLength = 0 then
    FContentLength := FSize;

  if (FProcessed = FSize) or (FBytesDiff = 0) or (aCurrentProcessed - FBytesDiff < FProcessed) then
    FOnProgress(Self, FProcessed, FSize, FContentLength, FTimeStart);
end;

end.

A basic usage is

procedure TWinMain.ProgressFileStreamOnProgressUpload(Sender: TObject; Processed: Int64; Size: Int64; ContentLength : Int64; TimeStart : cardinal);
begin
   if Processed > 0 then
      ProgressBar.Position := Ceil((Processed/ContentLength)*100);
end;

procedure TWinMain.BtnTestClick(Sender: TObject);
const
  ChunkSize = $F000;
var
  aBytes:     TBytes;
  aBytesRead : integer;
  aProgressFileStream : TProgressFileStream;
begin
  aProgressFileStream := TProgressFileStream.Create('MyFile.zip', fmOpenRead or fmShareDenyWrite);
  SetLength(aBytes, ChunkSize);
  try
    aProgressFileStream.OnProgress := ProgressFileStreamOnProgressUpload;

    aProgressFileStream.Seek(0, soFromBeginning);
    repeat
      aBytesRead := aProgressFileStream.Read(aBytes, ChunkSize);
    until (aBytesRead = 0);

  finally
    aProgressFileStream.Free;
  end;
end;

the problem is in the method do call the event, i want call the event each FBytesDiff (from default each 100 KBytes):

procedure TProgressFileStream.DoProgress(const AProcessed : Longint);
var
  aCurrentProcessed : Longint;
begin
  if not(Assigned(FOnProgress)) then Exit;

  aCurrentProcessed := FProcessed;

  Inc(FProcessed, AProcessed);

  if FContentLength = 0 then
    FContentLength := Size;

  if (FProcessed = Size) or (FBytesDiff = 0) or (FProcessed - aCurrentProcessed > FBytesDiff) then
    FOnProgress(Self, FProcessed, Size, FContentLength, FTimeStart);
end;

but the event seems fired on each ChunkSize (61440 bytes - 60 KB)...

I want add this control for don't waste the performance of stream read/write with too many events call.

Answer 1

FProcessed - aCurrentProcessed will ever return the Chunk Size. I think you should create a variable to store the read block FReadSize, initialize it with 0. Increment that variable with the bytes read, if the size read is larger than FBytesDiff subtract FBytesDiff from FReadSize.

procedure TProgressFileStream.DoProgress(const AProcessed : Longint);
var
  aCurrentProcessed : Longint;
begin
  if not(Assigned(FOnProgress)) then Exit;

  aCurrentProcessed := FProcessed;

  Inc(FProcessed, AProcessed);
  Inc(FReadSize, AProcessed);

  if FContentLength = 0 then
    FContentLength := Size;

  if (FProcessed = Size) or (FBytesDiff = 0) or (FReadSize >= FBytesDiff) then
  begin
    FOnProgress(Self, FProcessed, Size, FContentLength, FTimeStart);
    FReadSize := FReadSize - FBytesDiff; 
  end;
end;