Копирование файлов(каталог-а) с ProgressBar

[KurtWagner]

Извиняюсь, зная что тама уже была и не раз, но там не то что мне надо! Темы были копирования а мне нужно след. хочу чтоб, небыло показухи копирования по умолчанию, нужно чтоб копировал показывая файлы и ProgressBar1 сделать мини-прогу и с кодом... чтоб при нажатии кнопки Button1 у меня копировался весь диск в определеную папку... как это сделать, а точнее дайте исходник Заранее спасибо!!! С уважением, Веталь

[mihali4]

Первый проход - считаем количество файлов, подлежащих копированию и заносим это количество в макс прогресс-бара.
Второй проход - собственно копирование с увеличением значения позишена прогресс-бара от нуля на единичку на каждый скопированный файл.
Какой исходник? Неужели самому не хочется хоть что-то сделать самостоятельно?

[KurtWagner]

mihali4 почему не охота, охота! тольк не получается,,, я подхода перехода не вижу ПЛИЗ ПОМОГИТЕ (((((((

[Kotofff]

Что именно нужно ?
Копировать директорию ? Копировать некую группу файлов ? И вообще создать файл-менеджер аля Total Commander ?

[KurtWagner]

Kotofff Скажем так... У меня ДВД-РОМ(е) диск я хочу чтоб весь диск без стандартного показа копирования с ProgressBar1 копировал все содержимое в папку скажем c:\temp как это реализовать если можно исходник или код на KurtWagner@mail.ru Заранее Спасибо!!!

[Kotofff]

Как вариант можно по вот этой процедуре :

procedure FindFiles(StartFolder, Mask: string; List: TStrings; ScanSubFolders: Boolean = True);
var
  SearchRec: TSearchRec;
  FindResult: Integer;
begin
  List.BeginUpdate;
  try
    StartFolder := IncludeTrailingBackslash(StartFolder);
    FindResult := FindFirst(StartFolder + '*.*', faAnyFile, SearchRec);
    try
      while FindResult = 0 do
        with SearchRec do
        begin
          if (Attr and faDirectory) <> 0 then
          begin
            if ScanSubFolders and (Name <> '.') and (Name <> '..') then
              FindFiles(StartFolder + Name, Mask, List, ScanSubFolders);
          end
          else
          begin
            if MatchesMask(Name, Mask) then List.Add(StartFolder + Name);
          end;
          FindResult := FindNext(SearchRec);
        end;
    finally
    end;
  finally
    List.EndUpdate;
  end;
end;

Найти всю кучу файлов. В потом используя содержимое List копировать их всех по очереди ... процедура работает очень быстро так что самого процесса поиска почти не видно. А при копировании уже исходя из списка найденных можно оформить ProgressBar, например:

...
myFiles:TStrings;
...
begin
...
myFiles := TStrings.Create;
FindFiles('E:\', '*.*', myFiles, true);
... 
ProgressBar.min := 1;
ProgressBar.max := myFiles.Count;
if myFiles.Count > 0 then 
  for i:=1 to myFiles.Count do 
     begin
     ...
     ... копируем очередной файл какой-нить процедурой ...
     ...
     ProgressBar.Position := i;
     Application.ProcessMessages;
     end;
...

[KurtWagner]

Kotofff у меня не получилось так комплировал! но не тянет! вот то что я написал из твоего кода поправив его, и вот то что мне надо! Заранее спасибо!

[Kotofff]

Выслал на почту ... посмотри ...

[vilphoenix]

Сообщение от Kotofff

Выслал на почту ... посмотри ...

залей это файл на форм плз

[KWN, lnc]

vilphoenix лови!

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, Gauges, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Animate1: TAnimate;
    StatusBar1: TStatusBar;
    Gauge1: TGauge;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
  end;

var
  Form1: TForm1;
  T:TDateTime;


implementation

{$R *.DFM}

 Procedure TForm1.Button1Click(Sender: TObject);
  Const BufSize=(1024*1000)*10;
  Var FSize  : Longint;
      RByte  : Longint; //Сколько читать байт
      N,X,Y  : Longint;
      FileHandle  : Integer;
      FileHandle1 : Integer;
      Buffer: Pointer;
      FileName_From:String;
      FileName_To  :String;

  Begin

   FileName_From:='FROM\Pixels.exe';
   FileName_To  :='TO\Pixels.exe';
   If Not FileExists(FileName_From) Then Begin MessageBox(Application.Handle, PChar('Файл не найден !'),'Ошибка', MB_Ok+MB_IconWarning); Exit; End;

   Button1.Enabled:=False;

   FileHandle:=FileOpen(FileName_From,0);
   FileHandle1:=FileCreate(FileName_To);

   FSize:=GetFileSize(FileHandle,NIL);
   StatusBar1.Panels[1].Text:='Размер файла '+IntToStr(FSize)+' Байт';
   GetMem(Buffer,BufSize);

   T:=Time;
   Gauge1.Progress:=0;
   Gauge1.MaxValue:=FSize;
   Animate1.Active:=True;

   While FSize<>0 Do
    Begin
     If FSize>=BufSize Then RByte:=BufSize
     Else RByte:=FSize;

     FSize:=FSize-RByte;
     FileRead(FileHandle,Buffer^,RByte);

     Gauge1.Progress:=Gauge1.MaxValue-FSize;
     StatusBar1.Panels[0].Text:='Прошло времени: '+TimeToStr(Time-T);
     Application.ProcessMessages;

     FileWrite(FileHandle1,Buffer^,RByte);
   End;

  FreeMem(Buffer);
  FileClose(FileHandle);
  FileClose(FileHandle1);

  Animate1.Active:=False;
  Button1.Enabled:=True;
 End;

 end.

From Stilet: А оформлять читабельно? В следующий раз удалю.