Копируем файл с индикатором процесса

{ 1. } 

{ 
 You need a TProgressBar on your form for this tip. 
 Fьr diesen Tip wird eine TProgressBar benцtigt. 
} 


procedure TForm1.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 TForm1.Button1Click(Sender: TObject); 
begin 
  CopyFileWithProgressBar1('c:\Windows\Welcome.exe', 'c:\temp\Welcome.exe'); 
end; 

{ 2. } 

{***************************************} 

// To show the estimated time to copy a file: 

procedure TForm1.CopyFileWithProgressBar1(Source, Destination: string); 
var 
  FromF, ToF: file of byte; 
  Buffer: array[0..4096] of char; 
  NumRead: integer; 
  FileLength: longint; 
  t1, t2: DWORD; 
  maxi: integer; 
begin 
  AssignFile(FromF, Source); 
  reset(FromF); 
  AssignFile(ToF, Destination); 
  rewrite(ToF); 
  FileLength := FileSize(FromF); 
  with Progressbar1 do 
  begin 
    Min  := 0; 
    Max  := FileLength; 
    t1   := TimeGetTime; 
    maxi := Max div 4096; 
    while FileLength > 0 do 
    begin 
      BlockRead(FromF, Buffer[0], SizeOf(Buffer), NumRead); 
      FileLength := FileLength - NumRead; 
      BlockWrite(ToF, Buffer[0], NumRead); 
      t2  := TimeGetTime; 
      Min := Min + 1; 
      // Show the time in Label1 
      label1.Caption := FormatFloat('0.00', ((t2 - t1) / min * maxi - t2 + t1) / 100); 
      Application.ProcessMessages; 
      Position := Position + NumRead; 
    end; 
    CloseFile(FromF); 
    CloseFile(ToF); 
  end; 
end; 

{ 3. } 
{***************************************} 
// To show the estimated time to copy a file, using a callback function: 

type 
  TCallBack = procedure(Position, Size: Longint); { export; } 

procedure FastFileCopy(const InFileName, OutFileName: string; 
  CallBack: TCallBack); 


implementation 

procedure FastFileCopyCallBack(Position, Size: Longint); 
begin 
  Form1.ProgressBar1.Max := Size; 
  Form1.ProgressBar1.Position := Position; 
end; 

procedure FastFileCopy(const InFileName, OutFileName: string; 
  CallBack: TCallBack); 
const 
  BufSize = 3 * 4 * 4096; { 48Kbytes gives me the best results } 
type 
  PBuffer = ^TBuffer; 
  TBuffer = array[1..BufSize] of Byte; 
var 
  Size: DWORD; 
  Buffer: PBuffer; 
  infile, outfile: file; 
  SizeDone, SizeFile: LongInt; 
begin 
  if (InFileName <> OutFileName) then 
  begin 
    buffer := nil; 
    Assign(infile, InFileName); 
    Reset(infile, 1); 
    try 
      SizeFile := FileSize(infile); 
      Assign(outfile, OutFileName); 
      Rewrite(outfile, 1); 
      try 
        SizeDone := 0; 
        New(Buffer); 
        repeat 
          BlockRead(infile, Buffer^, BufSize, Size); 
          Inc(SizeDone, Size); 
          CallBack(SizeDone, SizeFile); 
          BlockWrite(outfile, Buffer^, Size) 
        until Size < BufSize; 
        FileSetDate(TFileRec(outfile).Handle, 
        FileGetDate(TFileRec(infile).Handle)); 
      finally 
        if Buffer <> nil then 
          Dispose(Buffer); 
        CloseFile(outfile) 
      end; 
    finally 
      CloseFile(infile); 
    end; 
  end 
  else 
    raise EInOutError.Create('File cannot be copied onto itself') 
end; {FastFileCopy} 




procedure TForm1.Button1Click(Sender: TObject); 
begin 
  FastFileCopy('c:\daten.txt', 'c:\test\daten2.txt', @FastFileCopyCallBack); 
end; 

{ 4. } 
{***************************************} 


function CopyFileWithProgressBar2(TotalFileSize, 
  TotalBytesTransferred, 
  StreamSize, 
  StreamBytesTransferred: LARGE_INTEGER; 
  dwStreamNumber, 
  dwCallbackReason: DWORD; 
  hSourceFile, 
  hDestinationFile: THandle; 
  lpData: Pointer): DWORD; stdcall; 
begin 
  // just set size at the beginning 
  if dwCallbackReason = CALLBACK_STREAM_SWITCH then 
    TProgressBar(lpData).Max := TotalFileSize.QuadPart; 

  TProgressBar(lpData).Position := TotalBytesTransferred.QuadPart; 
  Application.ProcessMessages; 
  Result := PROGRESS_CONTINUE; 
end; 

function TForm1.CopyWithProgress(sSource, sDest: string): Boolean; 
begin 
  // set this FCancelled to true, if you want to cancel the copy operation 
  FCancelled := False; 
  Result     := CopyFileEx(PChar(sSource), PChar(sDest), @CopyFileWithProgressBar2, 
    ProgressBar1, @FCancelled, 0); 
end; 

end;