Kopyalama sırasında kalan süreyi Gauge de gösterme

[hido]

Selam,

Database yedekleme işlemi için alttaki kodu kullanıyorum kopyalama sırasında Gauge kullanarak kalan süreyi göstermek çalışıyorum ama işin içinden bir türlü çıkamadım
yardımcı olursanız sevinirim...

procedure TForm11.SpeedButton1Click(Sender: TObject);
begin
CopyFile(PChar('Database\MyDatabase.db'),
PChar('Database\' + FormatDateTime('dd.mm.yyyy - hh.nn.ss', Now) +
' MyDatabase.db'), true);
end;


procedure TForm11.Timer1Timer(Sender: TObject);
var
value: integer;
begin
value := strtoint('10000');
Gauge1.Progress := Gauge1.Progress + 10;
if Gauge1.Progress = value then
begin
Gauge1.Progress := 0;
end;
end;

[mrmarman]

Kalan süreyi göstermek mi yoksa ekranda öyle işlem yapılıyor edasıyla animasyon için mi kullanacaksınız.
(1) Kalan süreyi net görmek için FileStream ile kendiniz bu kopyalama işlemini yapmalasınız. Böylece aktarılan paket aralıklarında kalan süre hesabı yapabilirsiniz.
(2) Ekranda animasyon olarak görünsün %100 olsun olmasın önemli değil diyorsanız, o zaman sizin timer çözümü bunu yapıyor zaten.

[hido]

Kalan süreyi göstermek mi yoksa ekranda öyle işlem yapılıyor edasıyla animasyon için mi kullanacaksınız.
(1) Kalan süreyi net görmek için FileStream ile kendiniz bu kopyalama işlemini yapmalasınız. Böylece aktarılan paket aralıklarında kalan süre hesabı yapabilirsiniz.
(2) Ekranda animasyon olarak görünsün %100 olsun olmasın önemli değil diyorsanız, o zaman sizin timer çözümü bunu yapıyor zaten.

Ekranda animasyon olarak göstermek ve aynı zamanda kopyalama hızı ile animasyon hızı eş zamanlı olarak göstermek istiyorum...

[G.Arkas]

Torry
http://www.swissdelphicenter.ch/en/showcode.php?id=330

Forumda Muharrem abinin örneği var.

viewtopic.php?t=2902

[brs]

Torry
http://www.swissdelphicenter.ch/en/showcode.php?id=330

Forumda Muharrem abinin örneği var.

viewtopic.php?t=2902

Hocam "müsaadenizle araya bende kaynayayım" bu konuyu ben de zamanında çok araştırdım fakat işin içinden çıkamamıştım verdiğiniz linkleri de ayrıca baktım



hata aldım neden olabilir

Kod: Tümünü seç

procedure TForm6.CopyFileWithProgressBar1(Source, Destination: string);
var
  FromF, ToF: file of byte;
  Buffer: array[0..4096] of char;
  NumRead: integer;
  FileLength: longint;
begin
  AssignFile(FromF, Source);
  reset(FromF);
  AssignFile(ToF, Destination);
  rewrite(ToF);
  FileLength := FileSize(FromF);
  with Progressbar1 do
  begin
    Min := 0;
    Max := FileLength;
    while FileLength > 0 do
    begin
      BlockRead(FromF, Buffer[0], SizeOf(Buffer), NumRead);
      FileLength := FileLength - NumRead;
      BlockWrite(ToF, Buffer[0], NumRead);
      Position := Position + NumRead;
    end;
    CloseFile(FromF);
    CloseFile(ToF);
  end;
end;


procedure TForm6.Button1Click(Sender: TObject);
begin
  CopyFileWithProgressBar1('c:\Windows\Welcome.exe', 'c:\temp\Welcome.exe');
end;

[brs]

Ben Yaptım sanırım sizinde işinizi görecektir kolay gelsin...

Kod: Tümünü seç

var
  i: integer;
begin
  try
    begin
      Gauge1.Visible := True;
      for i := Gauge1.MinValue to Gauge1.MaxValue do
        Gauge1.Progress := i;
      for i := Gauge1.MinValue to Gauge1.MaxValue do
        Gauge1.Progress := i;
      CopyFile(PChar('Database\Mydatabase.db'),
        PChar('Database\' + FormatDateTime('dd.mm.yyyy - hh.nn.ss', Now) +
        ' Mydatabase.db'), True);
      Label1.Caption := 'Yedekleme İşlemi Başarıyla Tamamlandı!';
    end;
  except
    Application.Messagebox('Database Kopyalama İşlemi Sırasında Hata Oluştu!',
      'Uyarı!', mb_ok or MB_ICONQUESTION);
  end;
end;

[mrmarman]

Merhaba.

(1) Bu verdiğiniz örnek rasyonel bir çözüm değildir. Neden mi ? Kopyalama işleminden bağımsız olarak başlangıçta iki defa %0 - %100 dönecektir, ondan sonra kopyalamaya başlayacaktır. Denemek isterseniz elinizdeki bir filmi (700 mb - 4 gb arası ) bu kod ile kopyalayın, anlayacaksınız. Test ettiğiniz dosya küçük olmalı ki sizi yanıltmış olmalı.

(2) İncelik gösterip paylaşım yapıyorsunuz, kodları CODE tagına alırsanız daha okunur olacaktır.

- Nasıl alabilirim sorusunun cevabı; kodları buraya kopyala / yapıştır yaptıktan sonra mouse ile seçerek mesaj penceresinin üzerindeki Code yazan butona basın veya elle de yaparım diyorsanız başa köşeli parantez içinde code, sona da yine köşeli parantez içinde [/code] şeklinde elle yazın.

(3) Cevap olarak ben de bir örnek kod hazırladım, afiyet olsun...



Fonksiyon:

Kod: Tümünü seç

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ı :

Kod: Tümünü seç

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.



Başarılar

[brs]

Selam Hocam,

2. Soruya cevap vererek başlayayım farkında değilim bundan dediğiniz gibi yaparım
1. En az 6 gb videoda denedim belki dikkatimden kaçmış olabilir ama kopyalama sırasında sorun fark etmedim...
3. Paylaşım için teşekkür ederim...

[hido]

Hocam elinize sağlık...