德爾福：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千字節）：

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;