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

Bro*_*wJr 4 delphi delphi-10-seattle

我使用下面的代码通过递归复制文件夹。工作正常,但至少对我来说还是存在问题,因为复制后源文件夹标签也包含在dest文件夹中,我不想要它。在这一刻发生了什么:

SRC文件夹:

C:\MyTest
  -firstfolder
  -secondfolder
  -- secondfolderFile
Run Code Online (Sandbox Code Playgroud)

DEST文件夹(复制后):

C:\NewTest
  -MyTest
  -firstfolder
  -secondfolder
  -- secondfolderFile
Run Code Online (Sandbox Code Playgroud)

然后我需要在dest文件夹中仅保留:

C:\NewTest
  -firstfolder
  -secondfolder
  -- secondfolderFile
Run Code Online (Sandbox Code Playgroud)

如何使用以下代码做到这一点?

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.
Run Code Online (Sandbox Code Playgroud)

Rem*_*eau 5

您正在将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.
Run Code Online (Sandbox Code Playgroud)