Delphi：TFileStream 的读/写进度（不浪费性能）

Question

我想在TFileStream 上实现一个进度事件以进行读/写操作，以便为其分配一个进度条。

我创建了TFileStream 的 clild 类 (TProgressFileStream)：

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.

基本用法是

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;

问题在于调用事件的方法，我想每个FBytesDiff 调用事件（默认为每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;

但该事件似乎在每个 ChunkSize（61440 字节 - 60 KB）上触发...

我想添加这个控件，不要因为太多的事件调用而浪费流读/写的性能。

Answer 1

FProcessed - aCurrentProcessed 将永远返回块大小。我认为您应该创建一个变量来存储读取块FReadSize，将其初始化为 0。如果读取的大小大于 FBytesDiff，则使用读取的字节递增该变量，从 FReadSize 中减去 FBytesDiff。

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;