Как скопировать папку по рекурсии, не включая метку исходной папки внутри папки dest? - PullRequest
4 голосов
/ 03 мая 2019

Я использую код ниже, чтобы скопировать папку с помощью рекурсии. Работает нормально, но существует проблема, по крайней мере, для меня, потому что метка исходной папки также включена в папку dest после копирования, и я не хочу этого. В этот момент происходит следующее:

SRC Папка:

C:\MyTest
  -firstfolder
  -secondfolder
  -- secondfolderFile

Папка DEST (после копирования):

C:\NewTest
  -MyTest
  -firstfolder
  -secondfolder
  -- secondfolderFile

И тогда мне нужно, чтобы в папке dest оставалось только:

C:\NewTest
  -firstfolder
  -secondfolder
  -- secondfolderFile

Как сделать это, используя следующий код?

program testCopyRecursion;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  Windows,
  ShellAPI,
  SysUtils;

function CopyFolder(const SrcFolder, DestFolder: String; iFileOp: Integer;
  OverWrite: Boolean; ShowDialog: Boolean): Boolean;
var
  MyFOStruct: TSHFileOpStruct;
  Src, Dest: String;
  ResultVal: Integer;
begin
  Result := False;

  Src := SrcFolder;
  Dest := DestFolder;

  if not DirectoryExists(Dest) then
    ForceDirectories(Dest);

  if (Src = '') or ((iFileOp <> FO_DELETE) and (Dest = '')) or
    (CompareText(Src, Dest) = 0) then
    Exit;

  if Src[Length(Src)] = '\' then
    SetLength(Src, Length(Src) - 1);
  Src := Src + #0#0;

  if (Dest <> '') and (Dest[Length(Dest)] = '\') then
    SetLength(Dest, Length(Dest) - 1);
  Dest := Dest + #0#0;

  FillChar(MyFOStruct, SizeOf(MyFOStruct), 0);

  with MyFOStruct do
  begin
    Wnd := 0;

    wFunc := iFileOp;
    pFrom := @Src[1];
    pTo := @Dest[1];

    fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMMKDIR;

    if not OverWrite then
      fFlags := fFlags or FOF_RENAMEONCOLLISION;
    if not ShowDialog then
      fFlags := fFlags or FOF_SILENT;
  end;

  try
    MyFOStruct.fAnyOperationsAborted := False;
    MyFOStruct.hNameMappings := nil;
    ResultVal := ShFileOperation(MyFOStruct);
    Result := (ResultVal = 0);
  finally
  end;
end;

begin
  try
    CopyFolder('C:\MyTest', 'C:\NewTest', FO_COPY, True, False);
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  Readln;

end.

1 Ответ

5 голосов
/ 03 мая 2019

Вы копируете саму папку C:\MyTest в папку C:\NewTest, а не просто копируете то, что находится внутри C:\MyTest.Попробуйте вместо этого указать исходный путь 'C:\MyTest\*', чтобы скопировать только то, что находится внутри C:\MyTest.

И, к вашему сведению, вам не нужен вызов ForceDirectories(), так как SHFileOperation() создает папку назначения, если она еще не существует.Документация даже гласит:

Операции копирования и перемещения могут указывать целевые каталоги, которые не существуют.В этих случаях система пытается создать их и обычно отображает диалоговое окно, чтобы спросить пользователя, хотят ли они создать новый каталог.Чтобы отключить это диалоговое окно и создать каталоги в режиме без вывода сообщений, установите флаг FOF_NOCONFIRMMKDIR в fFlags.

Попробуйте что-то вроде этого:

program testCopyRecursion;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  Windows, ShellAPI, SysUtils;

function CopyFolder(const SrcFolder, DestFolder: String;
  OverWrite: Boolean; ShowDialog: Boolean): Boolean;
var
  MyFOStruct: TSHFileOpStruct;
  Src, Dest: String;
begin
  Result := False;

  if (SrcFolder = '') or (DestFolder = '') or
     (CompareText(SrcFolder, DestFolder) = 0) then
    Exit;

  Src := IncludeTrailingPathDelimiter(SrcFolder) + '*'#0;
  Dest := ExcludeTrailingPathDelimiter(DestFolder) + #0;

  FillChar(MyFOStruct, SizeOf(MyFOStruct), 0);

  with MyFOStruct do
  begin
    wFunc := FO_COPY;
    pFrom := PChar(Src);
    pTo := PChar(Dest);
    fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMMKDIR;
    if not OverWrite then
      fFlags := fFlags or FOF_RENAMEONCOLLISION;
    if not ShowDialog then
      fFlags := fFlags or FOF_SILENT;
  end;

  Result := (SHFileOperation(MyFOStruct) = 0);
end;

begin
  try
    CopyFolder('C:\MyTest', 'C:\NewTest', True, False);
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  Readln;
end.
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...