VPF::Копирование директорий в потоке

neweraser

Дата 5.4.2012, 10:58 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 598
Регистрация: 17.2.2008

Репутация: нет
Всего: 6

Здравствуйте! Тема довольно заезжена, но решения своей проблемы я так и не нашел. Вот этот код работает

Код


function FullDirectoryCopy(SourceDir, TargetDir: string; StopIfNotAllCopied,
  OverWriteFiles: Boolean): Boolean;
var
  SR: TSearchRec;
  I: Integer;
begin
  Result := False;
  SourceDir := IncludeTrailingBackslash(SourceDir);
  TargetDir := IncludeTrailingBackslash(TargetDir);
  if not DirectoryExists(SourceDir) then
    Exit;
  if not ForceDirectories(TargetDir) then
    Exit;

  I := FindFirst(SourceDir + '*', faAnyFile, SR);
  try
    while I = 0 do
    begin
      if (SR.Name <> '') and (SR.Name <> '.') and (SR.Name <> '..') then
      begin
        if SR.Attr = faDirectory then
          Result := FullDirectoryCopy(SourceDir + SR.Name, TargetDir + SR.NAME,
            StopIfNotAllCopied, OverWriteFiles)
        else if not (not OverWriteFiles and FileExists(TargetDir + SR.Name))
          then
          Result := CopyFile(Pchar(SourceDir + SR.Name), Pchar(TargetDir +
            SR.Name), False)
        else
          Result := True;
        if not Result and StopIfNotAllCopied then
          exit;
      end;
      I := FindNext(SR);
    end;
  finally
    SysUtils.FindClose(SR);
  end;
end;

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

--------------------

Кто ищет, тот всегда найдет.

RelictOs

Дата 5.4.2012, 11:11 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 45
Регистрация: 14.2.2012

Репутация: нет
Всего: 1

Код


Application.ProcessMessages

Только нужно найти правильное место для вставки.
А именно в процедуру считывания файла в момент записи и проверки наличия

neweraser

Дата 5.4.2012, 11:18 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 598
Регистрация: 17.2.2008

Репутация: нет
Всего: 6

Цитата(RelictOs @ 5.4.2012, 11:11)

Код


Application.ProcessMessages

Если только после

Код


Result := CopyFile(Pchar(SourceDir + SR.Name), Pchar(TargetDir +
            SR.Name), False)

Но все равно будет висеть... пробовал smile

И интересует именно используя TThread

--------------------

Кто ищет, тот всегда найдет.

RelictOs

Дата 6.4.2012, 19:54 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 45
Регистрация: 14.2.2012

Репутация: нет
Всего: 1

http://www.cyberguru.ru/programming/delphi/threads.html
возможно, эта статья вам поможет?

neweraser

Дата 11.4.2012, 09:08 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 598
Регистрация: 17.2.2008

Репутация: нет
Всего: 6

Спасибо, нашел таки решение через winapi, мне нужно было перемещение, поэтому сделал так, может кому пригодится. Если с функцией без потока - программа виснет на время перемещения, а так нет:

Код


procedure TMainForm.MoveBtnClick(Sender: TObject);
var TId, id: longword;
begin
  if fList.Count <> 0 then
    if MessageDlg('Подтвердите перемещение:' + #10 + StringReplace(fList.Text, #10, #10, [rfReplaceAll]) + 'В ' + ShellTreeView2.Path ,mtinformation,[mbYes,mbNo],0) = mrYes then
      Tid:=beginthread(nil,0,Addr(MoveThread),nil,0,id) //запускаем функцию в потоке
    else
    ShowMessage('Не выбраны директории/файлы');
end

..........


procedure MoveThread;
begin
  for TekDir:= 0 to fList.Count - 1 do
  if MoveDir(fList[TekDir], MainForm.ShellTreeView2.Path) then
  begin
    SuspendThread(0);
    ShowMessage(fList[TekDir] + ' перемещен');
    ResumeThread(0)
  end;
  MainForm.ShellTreeView1.Refresh(MainForm.ShellTreeView1.TopItem);
  MainForm.ShellTreeView2.Refresh(MainForm.ShellTreeView2.TopItem);
  endthread(0); // Выходим из потока.
end;

function MoveDir(const fromDir, toDir: string): Boolean;
var
  fos: TSHFileOpStruct;
begin
  ZeroMemory(@fos, SizeOf(fos));
  with fos do
  begin
    wFunc  := FO_MOVE;
    fFlags := FOF_FILESONLY;
    pFrom  := PChar(fromDir + #0);
    pTo    := PChar(toDir);
  end;
  Result := (0 = ShFileOperation(fos));
end;

--------------------

Кто ищет, тот всегда найдет.

Illusion Dolphin

Дата 11.4.2012, 11:44 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Участник Клуба
Сообщений: 1198
Регистрация: 3.5.2003

Репутация: 36
Всего: 63

Если будут глюки в программе - пересмотри строчки 23 и 24. Ещё можешь нажать на кнопку перемещения, нажать "да" и сразу закрыть окно программы - посмотри что будет smile

--------------------

В мире всего две бесконечности: вселенная и человеческая глупость... На счёт вселенной я не уверен.
Шифрование и организация фотографий - Photo Database 4.5

neweraser

Дата 11.4.2012, 13:51 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 598
Регистрация: 17.2.2008

Репутация: нет
Всего: 6

Да, бывает глючит иногда, причем как раз во время обновления деревьев, но, я думаю, это глюки системы и/или недоработанный shelltreeview (где-то на форуме видел топик про это), хотя вроде как по логике все правильно.

Цитата(Illusion Dolphin @ 11.4.2012, 11:44

)

Ещё можешь нажать на кнопку перемещения, нажать "да" и сразу закрыть окно программы - посмотри что будет smile

Я догадываюсь, что будет, но сейчас посмотрю, интересно же)) Потом добавлю в onclosequerry (сюда вроде, непомню точно) выход из потока, если он активен, или убрать крестик, сделать кнопку выход и присваивать ей enabled в false при перемещении smile

зы. Не ничего там не было)) Что успел перенести - перенес, остальное осталось, все равно, что нажать отмена)

Это сообщение отредактировал(а) neweraser - 11.4.2012, 13:58

--------------------

Кто ищет, тот всегда найдет.

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »