Delphi:TFileStream 读/写进度(不浪费性能)

标签 delphi stream

我想在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)上触发...

我想添加此控件,以免因过多的事件调用而浪费流读/写的性能。

最佳答案

FProcessed - aCurrentProcessed 将返回 block 大小。我认为你应该创建一个变量来存储读取 block 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;

关于Delphi:TFileStream 读/写进度(不浪费性能),我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/43638115/

相关文章:

java - 在内存、处理器、时间方面,Java 中 BufferInputReader、LineNumberReader 和 Stream 之间最好的文件读取器是什么

android - 如何在 Android 的 Mediaplayer 中显示编码的视频文件?

delphi - 使用显卡(DirectX、OpenGL)代替 GDI 或 GR32 函数

delphi - delphi 中的表单切换

delphi - 捕获击键以导航自定义控件内手动绘制的项目?

Java = 下载缓冲区未填满?冲洗/缓冲如何工作?

delphi - 在 Firemonkey 中使用 JPG

delphi - 窗口出现在屏幕边缘之外(Delphi)

flutter - 多个访问同一流

c - fprintf 返回成功但无法写入现有文件