如何通过递归复制文件夹而不在目标文件夹中包含源文件夹标签？

Question

我使用下面的代码通过递归复制文件夹。工作正常，但对我来说至少存在一个问题，因为复制后源文件夹标签也包含在目标文件夹中，我不想要它。在这一刻发生的事情是这样的：

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.

Answer 1

您正在将 C:\MyTest 文件夹本身复制到 C:\NewTest 文件夹中，而不仅仅是复制 C:\MyTest 中的内容。尝试将源路径设置为 'C:\MyTest\*' 而不是仅复制 C:\MyTest 中的内容。

仅供参考，您不需要调用 ForceDirectories()，因为 SHFileOperation() 会创建目标文件夹（如果它尚不存在）。 documentation 甚至这样说：

Copy and Move operations can specify destination directories that do not exist. In those cases, the system attempts to create them and normally displays a dialog box to ask the user if they want to create the new directory. To suppress this dialog box and have the directories created silently, set the FOF_NOCONFIRMMKDIR flag in 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.

如何通过递归复制文件夹而不在目标文件夹中包含源文件夹标签？

How copy a folder by recursion without include source folder label inside dest folder?

delphi

delphi-10-seattle