19 Temmuz 2014 Cumartesi

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.