Delphi World - Копируем файл с индикатором процесса
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Копируем файл с индикатором процесса


{ 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;

Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования