|
Вопрос # 2 223/ вопрос открыт / |
|
Здравствуйте!
Появилась необходимость скопировать папку с файлами и подпапками.
Нашел в сети нужный код http://programmersforum.ru/showthread.php?s=333af0a5e685c26e7dde7a18266dc952&t=27831
но он по неизвестной причине не копирует подпапки, только файлы.
Помогите пожалуйста разобраться как подправить этот код чтобы он был полностью работоспособен (копировал не только файлы). Или может у кого-нибудь есть ссылочка на рабочий код.
Приложение: Переключить в обычный режим-
- Delphi 2009
-
-
-
- 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;
 |
Вопрос задал: Сергей П. (статус: Посетитель)
Вопрос отправлен: 22 декабря 2008, 11:30
Состояние вопроса: открыт, ответов: 0.
|
Мини-форум вопроса
Всего сообщений: 9; последнее сообщение — 22 декабря 2008, 13:02; участников в обсуждении: 3.
|
Вадим К (статус: Академик), 22 декабря 2008, 11:52 [#1]:
Странно, код больно похож на рабочий. Он вообще не копирует вложенные папки или как то избранно?
Галочка "подтверждения прочтения" - вселенское зло.
|
|
|
Сергей П. (статус: Посетитель), 22 декабря 2008, 12:16 [#2]:
Вообще папки не копирует, только файлы
|
|
|
Сергей П. (статус: Посетитель), 22 декабря 2008, 12:16 [#3]:
Ну в смысле вложенные папки не копирут
|
|
Мережников Андрей (статус: Абитуриент), 22 декабря 2008, 12:43 [#4]:
Попробуйте заменить IncludeTrailingBackslash
на IncludeTrailingPathDelimiter
|
|
|
Вадим К (статус: Академик), 22 декабря 2008, 12:44 [#5]:
Судя с строк
if SR.Attr = faDirectory then
Result := FullDirectoryCopy(SourceDir + SR.Name, TargetDir + SR.NAME,
StopIfNotAllCopied, OverWriteFiles)
должен. Функцию не переименовывали?
Хотя там есть ещё одно подозрительное место
if not Result and StopIfNotAllCopied then
exit; .
Попробуйте поэксперементировать на тестовом "наборе каталогов" с нейтральными именами (типа 1 2 3..). Если тоже не будет работать, будем копать глубже
Галочка "подтверждения прочтения" - вселенское зло.
|
|
|
Мережников Андрей (статус: Абитуриент), 22 декабря 2008, 12:48 [#6]:
Вообще-то код рабочий - проверил. Копирует все и папки и файлы.
Запускал FullDirectoryCopy(edit1.Text,edit2.Text,false,true);
|
|
|
Сергей П. (статус: Посетитель), 22 декабря 2008, 12:52 [#7]:
Все разобрался, видать аттрибуты файла по другому как-то закодированы (может из-за Висты).
Вобщем в строке if SR.Attr = faDirectory then
заменил на if SR.Attr = 8208 then
и все заработало.
|
|
|
Вадим К (статус: Академик), 22 декабря 2008, 12:59 [#8]:
я тут малось подумал...
код сравнения SR.Attr = faDirectory - это не совсем верно. Это будет правильно только если каталог не скрытый, не имеет никаких других атрибутов. более корректное сравнение такое
if faDirectory in SR.Attr then
или
if (SR.Attr and faDirectory) = faDirectory then
Я не помню точно по памяти, а делфи на работе нет. Но вроде второй вариант более правдоподобный.
Галочка "подтверждения прочтения" - вселенское зло.
|
|
|
Сергей П. (статус: Посетитель), 22 декабря 2008, 13:02 [#9]:
Так и оказалось.
if (SR.Attr and faDirectory) = faDirectory then -работает !
спасибо еще раз.
|
Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
|
