Delphi: TFileStream progress on read / write (no performance loss)

Question

I want to implement a progress event on TFileStream for a read / write operation in order to assign a progress bar to it.

I created the clild ( TProgressFileStream ) 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. 

Main use

 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 that the method raises an event, I want to raise an event every FBytesDiff (by default every 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 to fire for every ChunkSize (61440 bytes - 60KB) ...

I want to add this control so as not to waste time reading / writing a stream with too many calls.

Answer 1

FProcessed - aCurrentProcessed will ever return the Chunk size. I think you should create a variable to hold the FReadSize reading FReadSize , initialize it with 0. Grow this variable with bytes read, if the read size 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;