डेल्फी: पढ़ने/लिखने (प्रदर्शन को बर्बाद किए बिना) पर TFileStream प्रगति

Question

मैं इसे प्रगति पट्टी पर असाइन करने के लिए पढ़ने/लिखने के संचालन के लिए 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. 

एक बुनियादी उपयोग

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; 

समस्या विधि में है घटना कॉल करते हैं, मैं चाहता हूँ घटना कहते हैं:

मैं एक clild वर्ग (TProgressFileStream) TFileStream का बना प्रत्येक 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; 

लेकिन घटना प्रत्येक चंकसाइज (61440 बाइट्स - 60 केबी) पर निकाल दी गई है ...

मैं इस नियंत्रण को जोड़ना चाहता हूं ताकि स्ट्रीम के प्रदर्शन को बहुत अधिक ईवेंट कॉल के साथ पढ़ने/लिखने के प्रदर्शन को बर्बाद न करें।

Answer 1

एफप्रोसेस्ड - एक कंटेंटप्रोसेड कभी भी चंक आकार वापस कर देगा। मुझे लगता है कि आपको पढ़ने के ब्लॉक FReadSize को स्टोर करने के लिए एक चर बनाना चाहिए, इसे 0 के साथ प्रारंभ करें। बाइट्स के साथ वैरिएबल बढ़ाना, यदि आकार पढ़ा गया है तो FBytesDiff से FNytesDiff घटाएं Feadyize से 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;