2
\$\begingroup\$

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; TimeLast : cardinal; TimeStart : cardinal) of object;
  TProgressFileStream = class(TFileStream)
  private
    FOnProgress:    TProgressFileStreamOnProgress;
    FProcessed:     Int64;
    FContentLength: Int64;
    FTimeStart:     cardinal;
    FTimeLast:      cardinal;
    FTimeDiff:      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  TimeDiff: cardinal read FTimeDiff write FTimeDiff;
  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;
begin
  FOnProgress    := nil;
  FProcessed     := 0;
  FContentLength := 0;
  FTimeStart     := GetTickCount;
  FTimeLast      := FTimeStart;
  FTimeDiff      := 250; // ms
  FSize          := Size;
end;

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

  Inc(FProcessed, AProcessed);

  if FSize = 0 then
    FSize := Size;

  if FContentLength = 0 then
    FContentLength := FSize;

  aCurrTick := GetTickCount;
  if (aCurrTick - FTimeDiff > FTimeLast) or (FProcessed = FSize) or (FTimeDiff = 0) then
  begin
    FTimeLast := aCurrTick;

    FOnProgress(Self, FProcessed, FSize, FContentLength, FTimeLast, FTimeStart);
  end;
end;

end.

basic usage

uses ProgressFileStream;

procedure TWinMain.ProgressFileStreamOnProgressUpload(Sender: TObject; Processed: Int64; Size: Int64; ContentLength : Int64;  TimeLast : cardinal; 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;

Feature:

  1. The event is called on each TimeDiff (public property) milliseconds for don't waste the performance on read/wtrite
  2. The class has ContentLength property for set know size of stream, when the final size of the stream is unknow (eg. progressive download)

Point the attention on:

  1. Performance
  2. Stability/portability

Any other suggestion is appreciated.

\$\endgroup\$

0

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Browse other questions tagged or ask your own question.