Недавно добавленные исходники

•  DeLiKaTeS Tetris (Тетрис)  1 523

•  TDictionary Custom Sort  4 187

•  Fast Watermark Sources  3 878

•  3D Designer  5 973

•  Sik Screen Capture  4 144

•  Patch Maker  4 683

•  Айболит (remote control)  4 591

•  ListBox Drag & Drop  3 746

•  Доска для игры Реверси  89 638

•  Графические эффекты  4 926

•  Рисование по маске  3 944

•  Перетаскивание изображений  3 316

•  Canvas Drawing  3 621

•  Рисование Луны  3 417

•  Поворот изображения  2 918

•  Рисование стержней  2 589

•  Paint on Shape  1 983

•  Генератор кроссвордов  2 746

•  Головоломка Paletto  2 170

•  Теорема Монжа об окружностях  2 860

•  Пазл Numbrix  1 951

•  Заборы и коммивояжеры  2 525

•  Игра HIP  1 565

•  Игра Go (Го)  1 500

•  Симулятор лифта  1 775

•  Программа укладки плитки  1 525

•  Генератор лабиринта  1 888

•  Проверка числового ввода  1 639

•  HEX View  1 820

•  Физический маятник  1 659

 
скрыть


Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Delphi Sources

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




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





Похожие по теме исходники

Чтение PSD файлов

Шифратор файлов

Разбиение файла на части

Поиск файлов

 

FileMan (менеджер файлов)

Поиск открытых файлов

Текст внутри файла

Ожидание завершения процесса

 

Сообщения между процессами Windows

Защита процесса

Информация о процессах

Защита процесса

 



Copyright © 2004-2024 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте