Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: WinAPI и системное программирование > Копирование файлов...

Автор: WIN32API 17.5.2005, 19:33

Народ, не отсылай меня в ФАГ, т.к. ответа на мой вопрос там нет. Меня интересует копирование файлов (не одного файла, а нескольких), используя при этом msctls_progress32. И msctls_progress32 при этом должен отображать результат копирования всех файлов сразу, как это делает любая программа установки, а не каждого в отдельности.

Автор: WolfON 17.5.2005, 23:25

делаешь в дельфе copyfile для каждого файла по очереди и как очередь убывает - добавляешь в прогресс бар.

Автор: RA 18.5.2005, 01:37

Код


//Создаём прогресс 
 hwndProgress := CreateWindowEx(0, 'msctls_progress32', nil, WS_CHILD or
        WS_VISIBLE or PBS_SMOOTH, 8, 136, 329, 16, hWnd, 0, hInstance, nil);

       SendMessage(hwndProgress, PBM_SETRANGE, 0, Integer(100 shl 16));
//RANGE
       SendMessage(hwndProgress, PBM_SETSTEP, 1, 0);
//STEP


SendMessage(hwndProgress, PBM_SETPOS, 0, 0);
//Позиция прогресс бара

ЗЫ:
только не надо писать что ответ найден и давать ссылку на библиотеку ленина.

Автор: WIN32API 18.5.2005, 09:02

С кодом прогресса понятно, а как на практике реализовать :

Цитата

делаешь в дельфе copyfile для каждого файла по очереди и как очередь убывает - добавляешь в прогресс бар.

Автор: Quadr0 19.5.2005, 00:04

...

Автор: WIN32API 19.5.2005, 20:03

Народ, написал я процедурку копирования файлов вместе с подкаталогами и отображения процесса в прогрессбаре, но столкнулся с проблемой подсчета количества файлов (включая подкаталоги). Может, знаете способ? Поделитесь. И еще - можно как-нибудь остановить копирование? Если да то как? Примеры приветствуются!

Код


procedure sCopyDirectory(Origen, Desti : string);
var
 filecount: Integer;
 Files : integer;
 FOrigen, FDesti : string;
 Search : TSearchRec;
begin
 filecount := ОПРЕДЕЛЯЕМ КОЛИЧЕСТВО ФАЙЛОВ И В ПОДКАТАТАЛОГАХ ТАКЖЕ;
 SendMessage(GetDlgItem(hWin, 2), PBM_SETRANGE32, 0, filecount); //Минимальная и максимальная позиция пргресса
 SendMessage(GetDlgItem(hWin, 2), PBM_SETSTEP, 1, 0); //Шаг прогресса
 //Ищем файлы
 Files := FindFirst(Origen + '\*.*', faAnyFile, Search);
  while Files = 0 do begin
   if Search.Attr <> faDirectory then begin
    FOrigen := Origen + '\' + Search.Name;
    FDesti := Desti + '\' + Search.Name;
    //Копируем
    CopyFile(PChar(FOrigen),PChar(FDesti),false);
    //Передвигаем позицию прогресса
    SendMessage(GetDlgItem(hWin, 2), PBM_SETPOS, Progress_GetPos(GetDlgItem(hWin, 2)) + 1, 0);
    //Показываем какой файл копируется в данный момент
    SendMessage(GetDlgItem(hWin, 3), WM_SETTEXT, 0, Integer(PChar('Copyng: ' + Search.name)));
   end else begin
    if (Search.Name <> '.') and (Search.Name <> '..') then begin
     //Создаем каталоги
     if CreateDir(Desti + '\' + Search.Name) then
      sCopyDirectory(Origen+'\'+Search.Name,Desti+'\'+Search.Name);
    end;
   end;
  Files := FindNext(Search);
 end;
  FindClose(Search);
end;

Автор: _hunter 19.5.2005, 20:29

можно. для этого перед началом копирования нужно выполнить обход все каталогов и посчитать сколько файлов в них содержится.

для копирования файлов с возможностью остановки используй CopyFileEx()

Автор: WIN32API 20.5.2005, 11:17

CopyFileEx() не работает в 98 винде. Меня это не устраивает.

Автор: _hunter 20.5.2005, 13:32

тогда пиши свою функцию

Автор: WIN32API 20.5.2005, 13:33

Ну так а я чем занимаюсь?

Автор: _hunter 20.5.2005, 13:42

а я откуда знаю? ты задал вопрос -- я ответил. если ты имел в виду не то что спросил -- спроси то, что имел в виду...

Автор: WIN32API 21.5.2005, 11:56

Заканчиваем флеймить!
Итак, повторяю вопрос. Вот моя процедурка:

Код


procedure sCopyDirectory(Origen, Desti : string);
var
 filecount: Integer;
 Files : integer;
 FOrigen, FDesti : string;
 Search : TSearchRec;
begin
 filecount := ОПРЕДЕЛЯЕМ КОЛИЧЕСТВО ФАЙЛОВ И В ПОДКАТАТАЛОГАХ ТАКЖЕ;
 SendMessage(GetDlgItem(hWin, 2), PBM_SETRANGE32, 0, filecount); //Минимальная и максимальная позиция пргресса
 SendMessage(GetDlgItem(hWin, 2), PBM_SETSTEP, 1, 0); //Шаг прогресса
 //Ищем файлы
 Files := FindFirst(Origen + '\*.*', faAnyFile, Search);
  while Files = 0 do begin
   if Search.Attr <> faDirectory then begin
    FOrigen := Origen + '\' + Search.Name;
    FDesti := Desti + '\' + Search.Name;
    //Копируем
    CopyFile(PChar(FOrigen),PChar(FDesti),false);
    //Передвигаем позицию прогресса
    SendMessage(GetDlgItem(hWin, 2), PBM_SETPOS, Progress_GetPos(GetDlgItem(hWin, 2)) + 1, 0);
    //Показываем какой файл копируется в данный момент
    SendMessage(GetDlgItem(hWin, 3), WM_SETTEXT, 0, Integer(PChar('Copyng: ' + Search.name)));
   end else begin
    if (Search.Name <> '.') and (Search.Name <> '..') then begin
     //Создаем каталоги
     if CreateDir(Desti + '\' + Search.Name) then
      sCopyDirectory(Origen+'\'+Search.Name,Desti+'\'+Search.Name);
    end;
   end;
  Files := FindNext(Search);
 end;
  FindClose(Search);
end;

Автор: Quadr0 21.5.2005, 17:21

...

Автор: WIN32API 22.5.2005, 18:08

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

Автор: Quadr0 22.5.2005, 23:30

...

Автор: WIN32API 23.5.2005, 11:19

Я хочу останавливать (прерывать) копирование. Как это делают все инсталлеры...

Автор: _hunter 23.5.2005, 11:52

объясняю еще раз. медленно.
остановить CopyFile() нельзя. если хочеш ее остановить пиши свою CopyFile()
то, что ты привел -- не функция копирования ( и говорил я не о ней )

Автор: WIN32API 23.5.2005, 13:09

А зачем останавливать CopyFile? Реальнее остановить FindFirst. Вот тока как это сделать? Может, ввести тупую проверку внутри кода типа

Код


var
fCopy: Boolean;
...
if fCopy = false then exit;

Если вы предложите что-то более корректное - буду признателен.

Автор: _hunter 23.5.2005, 13:12

потому что при копировании 700-гигового файла долго в монитор глядеть придется...

а других способов и нет.

Автор: WIN32API 23.5.2005, 13:40

А ты видел файлы такого размера? (Сорри за флейм)

Автор: Quadr0 23.5.2005, 14:27

...

Автор: _hunter 23.5.2005, 15:12

такого -- нет smile

( это я для понятности )
но файлы на пару гигов тоже не секунды копируются...

Автор: RA 24.5.2005, 09:42

Надеюсь общая идея ясна, а
переделать не составит друда.

Код


var con:boolean;
..
type
  TCallBack = procedure(Position, Size: Longint);
................
procedure myFileCopyCallBack(Position, Size: Longint);
begin
  Form1.ProgressBar1.Max := Size;
  Form1.ProgressBar1.Position := Position;
end;

procedure myFileCopy(const InFileName, OutFileName: string;
  CallBack: TCallBack);
const
  BufSize = 3 * 4 * 4096;
type
  PBuffer = ^TBuffer;
  TBuffer = array[1..BufSize] of Byte;
var
 // LAbel  GTFup;
  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
          Application.ProcessMessages;
          BlockRead(infile, Buffer^, BufSize, Size);
          Inc(SizeDone, Size);
          //-----------
          CallBack(SizeDone, SizeFile);
          if not con then break;
          Application.ProcessMessages;
          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')
end;

............
//Initiate
con:=true;
myFileCopy('c:\downloads\cs16full_v13(2).exe', 'd:\1.exe', @myFileCopyCallBack);

//Stop
con:=false