Копирование директории рекурсивно с файлами.
Адаптированный под Lazarus вариант
Дополнение от Падре Мортиуса Padre_Mortius http://freepascal.ru/forum/viewtopic.php?f=35&t=5013
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 DirectoryExistsUTF8(SourceDir) then
Exit;
if not ForceDirectoriesUTF8(TargetDir) then Exit;
I := FindFirstUTF8(SourceDir + '*', faAnyFile, SR);
try
while I = 0 do
begin
if (SR.Name <> '') and (SR.Name <> '.') and (SR.Name <> '..') then
begin
if SR.Attr and faDirectory = faDirectory then
Result := FullDirectoryCopy(SourceDir + SR.Name, TargetDir + SR.NAME, StopIfNotAllCopied, OverWriteFiles)
else
if not (not OverWriteFiles and FileExistsUTF8(TargetDir + SR.Name))
then
Result := CopyFile((SourceDir + SR.Name), (TargetDir + SR.Name), False)
else
Result := True;
if not Result and StopIfNotAllCopied then exit;
end;
I := FindNextUTF8(SR);
end;
finally
SysUtils.FindClose(SR);
end;
end;
Удаление содержимого директории
procedure RemoveAllFilesInDir(path, mask: string;OnlyInRoot:boolean);
var
sr: TSearchRec;
begin
if FindFirstUTF8(path + DirectorySeparator + mask, faAnyFile, sr) = 0 then
begin
repeat
if sr.Attr and faDirectory = 0 then
begin
DeleteFileUTF8(path + DirectorySeparator + sr.Name);
end
else
begin
if not OnlyInRoot then
if pos('.', sr.Name) <= 0 then RemoveAllFilesInDir(path + DirectorySeparator + sr.Name, mask,OnlyInRoot);
DeleteDirectory(path + DirectorySeparator + sr.Name,false);
end;
until FindNext(sr) <> 0;
end;
FindClose(sr);
end;
