Delphi Dosya Kopyalama (Yüzdeli)

Merhabalar,

Dosya kopyalama yaparken nedenini hala anlayamadım ama birçok yöntemi çalıştıramadım.
Her zaman ki gibi gezinirken Muharrem hocamızın paylaştığı örneklerden bir tanesini daha ele geçirmiş bulunmaktayım :)

Uygulama görüntüsü:

Lafı fazla uzatmadan kodlara ve kullanımına geçmek istiyorum.

Uses DateUtils;

Var
  xboolDurdur : Boolean = False;

function DosyaKopyala( strKaynak, strHedef: String; boolUzerineYaz:Boolean; Gauge:TGauge; aLabel:TLabel): Boolean;
Var
  fsKaynak, fsHedef : TFileStream;
  Miktar : DWord;
  Buffer : Array [0..(1024*64)-1] of Byte; // 64 KByte'lık paketler halinde kopyalanacak...
  tBas   : TDateTime;
begin
  tBas   := Now;
  Result := False;
  // Kaynak Dosya Var mıdır ? Kontrolü...
  if NOT FileExists( strKaynak ) then
  begin
      MessageDlg( 'Kaynak dosya mevcut olmadığı için kopyalama işlemi yapılamadı...', mtError, [mbOk], 0);
      Exit;
  end;

  // Üzerine yazma izni yoksa Hedef Dosya Var mıdır ? Kontrolü...
  if NOT boolUzerineyaz then
  begin
    if FileExists( strHedef ) then
    begin
      MessageDlg( 'Hedef dosya mevcut ve üzerine yazma izni vermediğiniz için kopyalama işlemi yapılamadı...', mtError, [mbOk], 0);
      Exit;
    end;
  end;

  fsKaynak := TFileStream.Create( strKaynak, fmOpenRead or fmShareDenyNone );
  Try
    if Gauge <> Nil then
    begin
      Gauge.MinValue := 0;
      Gauge.MaxValue := fsKaynak.Size;
    end;

    Try
      fsHedef  := TFileStream.Create( strHedef, fmCreate  );
    Except
      MessageDlg( 'Hedef dosya oluşturulurken bir sorun olduğu için kopyalama işlemi yapılamadı...', mtError, [mbOk], 0);
      fsKaynak.Free;
      Exit;
    End;
    fsKaynak.Seek( 0, soFromBeginning );

    Miktar := SizeOf(Buffer);
    while (fsKaynak.Size - fsKaynak.Position > Miktar) AND (NOT xboolDurdur) do
    begin
      fsKaynak.Read( Buffer, Miktar );
      fsHedef.Write( Buffer, Miktar );
      if Gauge <> Nil then Gauge.Progress  := fsKaynak.Position;
      if aLabel <> Nil then aLabel.Caption := Format('Miktar: %d / %d Kb'
                                                    + #13'GeçenSüre: %d saniye'
                                                    + #13'Tahmini Sure: %d saniye'
                                                    + #13'Tahmini KalanSüre: %d saniye', [
               fsKaynak.Position div (1024)
            ,  fsKaynak.Size     div (1024)
            ,  SecondsBetween(Now, tBas)
            , (SecondsBetween(Now, tBas) * fsKaynak.Size) div (fsKaynak.Position)
            , (SecondsBetween(Now, tBas) * fsKaynak.Size) div (fsKaynak.Position) - SecondsBetween(Now, tBas) ]);
      Application.ProcessMessages;
    end;
    if NOT xboolDurdur then
    begin
      Miktar := fsKaynak.Size - fsKaynak.Position + 1;
      if Miktar > 0 then
      begin
        fsKaynak.Read( Buffer, Miktar );
        fsHedef.Write( Buffer, Miktar );
      end;
      if Gauge <> Nil then Gauge.Progress := fsKaynak.Position;
    end else
    begin
      MessageDlg( 'İsteğiniz üzerine kopyalama işlemi durdururldu...', mtWarning, [mbOk], 0);
    end;
    fsKaynak.Free;
    fsHedef.Free;
  Finally
    Result := True;
  End;
end;

Kullanımı

procedure TForm1.BitBtn1Click(Sender: TObject);
Var
  KaynakDosya,
  HedefDosya   : String;
begin
  if TBitBtn(Sender).Caption = 'Başlat' then
  begin
    xboolDurdur := False;
    TBitBtn(Sender).Caption := 'Durdur';
    KaynakDosya := 'd:\ARMAN-Genel\Movies\Avengers\Avengers,The.(Yenilmezler).TR.BRRip.XviD.avi';
    HedefDosya  := 'd:\test.avi';
    if DosyaKopyala( KaynakDosya, HedefDosya, True, Gauge1, Label1 ) AND ( NOT xboolDurdur )
      then MessageDlg('Kopyalama işlemi başarıyla tamamlandı...', mtInformation, [mbOk], 0)
      else if ( NOT xboolDurdur ) then MessageDlg('Kopyalama işlemi yapılamadı...', mtError, [mbOk], 0);
  end else
  begin
    xboolDurdur := True;
    TBitBtn(Sender).Caption := 'Başlat';
  end;
end;

EK Bilgi : - Kopyalamak için herhangi bir TGauge veya TLabel kullanmak istemezseniz

DosyaKopyala( KaynakDosya, HedefDosya, True, Nil, Nil )

şeklinde parametre olarak Nil yazarak kullanabilirsiniz.