Как скопировать каталог вместе со всем содержимым?
Способ первый
procedure TForm1.CopyFiles(FromCopy, ToCopy: string);
procedure FCopy( Path: string );
var
sRec: TSearchRec;
isFound: boolean;
tempPath: string;
begin
if not DirectoryExists( ToCopy ) then CreateDir( ToCopy );
tempPath := ToCopy;
isFound := FindFirst( Path + '\*.*', faAnyFile, sRec ) = 0;
while isFound do
begin
if ( ( sRec.Name <> '.' ) and ( sRec.Name <> '..' ) ) and
( ( sRec.Attr and faDirectory ) = faDirectory ) then
begin
tempPath := Path + '\' + sRec.Name;
Delete( tempPath, 1, Length( FromCopy ) );
tempPath := ToCopy + tempPath;
if not DirectoryExists( tempPath ) then
CreateDir( tempPath );
FCopy( Path + '\' + sRec.Name );
Application.ProcessMessages;
end
else
begin
tempPath := Path + '\' + sRec.Name;
Delete( tempPath, 1, Length( FromCopy ) );
tempPath := ToCopy + tempPath;
CopyFile( PChar( Path + '\' + sRec.Name ),
PChar( tempPath ), false );
ProgressBar1.Position := ProgressBar1.Position + sRec.Size;
Application.ProcessMessages;
end;
isFound := FindNext( sRec ) = 0;
Application.ProcessMessages;
end;
FindClose( sRec );
end;
begin
FCopy( FromCopy );
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
CopyFiles( 'c:\откуда', 'd:\куда' ); end;
|
Способ второй
uses
..., ShellAPI;
function CopyDir( const fromDir, toDir: string ): boolean;
var
fos: TSHFileOpStruct;
begin
ZeroMemory( @fos, SizeOf( fos ) );
with fos do
begin
wFunc := FO_COPY;
fFlags := FOF_FILESONLY;
pFrom := PChar( fromDir + #0 );
pTo := PChar( toDir )
end;
Result := ( 0 = ShFileOperation( fos ) );
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i: integer;
List: TStringList;
begin
List := TStringList.Create;
List.Add( 'Путь к каталогу, который нужно скопировать' ); for i := 0 to List.Count-1 do
if CopyDir( List.Strings[i], 'C:\' ) then
ShowMessage( 'файлы скопированы' ); List.Free;
end; |