Pfadinhalte eine Ebene aufwärts kopieren

[Rolf Frei]

Mein Code würde genau das machen, was der TE will, nur geht das nicht, weil die Windows API funktion MoveFile (gekapselt durch TDirectory.Move) als Ziel ein "nicht existierendes" Verzeichnis erwartet (siehe MSDN MoveFile Doku). Besteht das Zielverzeichnis bereits kommt der Fehler "Das angegebene Verzeichnis ist bereits vorhanden".

Das Ganze lässt sich also mit einem simplen Move Befehl nicht lösen. Da muss man alle Files einzeln kopieren und danach löschen.

Code:

procedure RFCopyDirectory(SourceDir, DestDir: string;
  OverWrite: Boolean = True;
  const FileMask: string = '*.*';
  Recursive: Boolean = True);
var
  SR: TSearchRec;
begin
  if (SourceDir <> '') and (DestDir <> '') then
  begin
    SourceDir := IncludeTrailingPathDelimiter(SourceDir);
    DestDir := IncludeTrailingPathDelimiter(DestDir);
    if not DirectoryExists(DestDir) then
      ForceDirectories(ExcludeTrailingPathDelimiter(DestDir));
    if FindFirst(SourceDir + FileMask, faAnyFile, SR) = 0 then
    try
      repeat
        if (SR.Name <> '.') and (SR.Name <> '..') then
        begin
          if (SR.Attr and faDirectory) <> 0 then
          begin
            if Recursive then
              RFCopyDirectory(SourceDir + SR.Name, DestDir + SR.Name)
          end
          else
          begin
            if not CopyFile(PChar(SourceDir + SR.Name),
              PChar(DestDir + SR.Name), not OverWrite) then
            begin
              if GetLastError <> ERROR_FILE_EXISTS then
                RaiseLastOSError;
            end;
          end;
        end;
      until FindNext(SR) <> 0;
    finally
      FindClose(SR);
    end;
  end;
end;

function RFDelTree(Directory: string; const DelParent: Boolean = True;
  const FileMask: string = '*.*';
  const OlderThan: TDateTime = 0.0): Boolean;
var
  SR: TSearchRec;
begin
  Result := True;
  if Directory <> '' then
  begin
    if not DirectoryExists(Directory) then
      Exit;

    Directory := IncludeTrailingPathDelimiter(Directory);
    if FindFirst(Directory + FileMask, faAnyFile, SR) = 0 then
    try
      repeat
        if (SR.Name <> '.') and (SR.Name <> '..') then
        begin
          if (OlderThan = 0.0) or
            ({$IF RTLVersion >= 22}SR.TimeStamp{$ELSE}FileDateToDateTime(SR.Time){$IFEND} < OlderThan) then
          begin
            if (SR.Attr and faDirectory) <> 0 then
              RFDelTree(Directory + SR.Name)
            else if not DeleteFile(Directory + SR.Name) and
              (Win32Platform = VER_PLATFORM_WIN32_NT) then
              MoveFileEx(PChar(Directory + SR.Name), nil, MOVEFILE_DELAY_UNTIL_REBOOT);
          end;
        end;
      until FindNext(SR) <> 0;
    finally
      FindClose(SR);
    end;

    if DelParent then
    begin
      Result := RemoveDir(Directory);
      if not Result and (Win32Platform = VER_PLATFORM_WIN32_NT) then
        Result := MoveFileEx(PChar(Directory), nil, MOVEFILE_DELAY_UNTIL_REBOOT);
    end
    else
      Result := True;
  end;
end;


procedure TForm1.FormCreate(Sender: TObject);
var
  fDir, fDirDst: String;
begin
  fDir := 'C:\temp\alt';
  fDirDst := fDir + '\..';

  { Kopieren aller Dateien und Unterverzeichnisse aus dem Ordner fDir ins Zielverzeichnis fDirDst } 
  RFCopyDirectory(fDir, fDirDst);  

  { Löschen des Quellverzeichnisses inklusive aller Unterverzeichnisse }
  RFDelTree(fDir);  
end;