Dateien und Unterordner von einem Ordner in anderen Ordner K

[renekr]

Hallo,

Ich habe folgendes vor:

Ich will die Unterordner und Files und alles darunter liegende von einem Ordner in einen anderen Ordner kopieren.

Leider habe ich es nur geschafft einen Root Folder in einen anderen Ordner zu Kopieren,allerdings habe ich dann den Root Folder noch unter dem Ordner,das will ich aber so nicht.


Die funktion nehme ich dazu:

Delphi-Quellcode:

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;

Hat jemand etwas besseres auf Lager?

Vielen Dank.

[alleinherrscher]

Hi!

Ist jetzt mal ins unreine geschrieben, sollte aber mit evtl. kleinen Änderungen funktionieren. Der Trick besteht daran, dass man die CopyDirectory procedure rekursiv aufruft, wenn FindFirst einen Ordner findet.

Delphi-Quellcode:

procedure CopyDirectory(aDirectory,aDestinationDirectory:String);
var
LStrList: TStringlist;
LSearchRec: TSearchRec;
begin

if FindFirst(aDirectory + '*.*', faAnyFile, LSearchRec) = 0 then
  begin
   
  repeat

    //Ordner auflisten

    if LSearchRec.Attr and faDirectory = faDirectory then
      if (LSearchRec.Name <> '.') and (LSearchRec.Name <> '..') then
           begin
              CopyDirectory(aDirectory+LSearchRec.Name+'\',aDestinationDirectory+LSearchRec.Name+'\');
           end;

    //Dateien auflisten

    if LSearchRec.Attr and faDirectory = 0 then
     begin
       Copyfile(PChar(aDirectory+LSearchRec.Name),PChar(aDestinationDirectory+LSearchRec.Name),true);
     end;

   until FindNext(LSearchRec) <> 0;
   
   FindClose(LSearchRec);
  end;
end;

[peschai]

Hallo,
Kleiner Hinweis: Bitte bei den Verzeichnis-verkettungen fehlt der '\' dazwischen ... z.B.
...aDirectory+LSearchRec.Name+'\'... ...aDirectory+'\'+LSearchRec.Name+'\'...

[Progman]

versuch das mal:

Delphi-Quellcode:

var
  shellinfo: TSHFILEOPSTRUCT;

procedure CopyVerzeichnis(Source, Dest);
var  files : string;
     Abbruch: Boolean;
begin
  files :=Source + #0;
  files := files + #0;
  with shellinfo do begin
     wnd     := Application.handle;
     wfunc   := FO_COPY;
     pFrom   := PChar(files);
     pTo     := PChar(Dest);
  end;
  if SHFileOperation(shellinfo)=S_Ok then
   ShowMessage('Alle Dateien wurden kopiert!')
  else
   ShowMessage('Die Dateien wurden nicht oder nicht vollständig kopiert!');
end;

Anstelle von Application.Handle solltest du besser das Handle deines Forms nehmen, so hatte ich das jedenfalls gemacht.

[Hansa]

Warum nicht einfach mit ShellExecute und xcopy ? Oder soll ein bereits vorhandener Windows-Befehl mit Delphi nachprogrammiert werden ?

[Hawkeye219]

Hallo Rene,

versuche es einmal so:

Delphi-Quellcode:

function CopyFiles (const fromDir, toDir: string): Boolean;
var
  fos: TSHFileOpStruct;
begin
  ZeroMemory(@fos, SizeOf(fos));
  with fos do
  begin
    wFunc  := FO_COPY;
//    fFlags := FOF_FILESONLY;
    fFlags := 0;
    pFrom  := PChar(fromDir + #0);
    pTo    := PChar(toDir)
  end;
  Result := (0 = ShFileOperation(fos));
end;

procedure TForm1.Button1Click (Sender: TObject);
begin
  CopyFiles ('C:\Source\*.*', 'C:\Target');
end;

Beachte die Wildcards bei der Angabe der Quelldaten.

Gruß Hawkeye

[renekr]

Hi @,
WOW so viel Resonanz.
Vielen 'Dank.

Ich habe derzeit ein bisschen experimentiert und folgendes programmeirt.

Delphi-Quellcode:

function CopyDir_without_Root(const fromDir, toDir: string): Boolean;
var
fo: TSHFileOpStruct;
buffer  : array[0..4096] of char;
p       : pchar;
begin
FillChar(Buffer, sizeof(Buffer), #0);
p := @buffer;
StrECopy(p,Pchar( fromDir+'\*.*')); //this is folder that you want to copy
FillChar(Fo, sizeof(Fo), #0);
Fo.Wnd    := form1.Handle;
Fo.wFunc  := FO_COPY;
Fo.pFrom  := @Buffer;
Fo.pTo    := PChar(toDir); //this is where the folder will go  Fo.fFlags := 0;

Result := (0 = ShFileOperation(fo));
end;

Das ist fast ähnlich wie das letzte Posting.

Vielen Lieben Dank.