Copy directory structures

Problem/Question/Abstract:

How to copy directory structures

Answer:

Solve 1:

The most appropriate way would be with the SHFileOperation API call. This is a snippet of a demo I have written for this. You should be able to see the functionality.

procedure TForm1.SHFileOperationCopy(sFrom, sTo, STitle: string);
var
  lpFileOp: TSHFILEOPSTRUCT;
  op, flag: Integer;
begin
  case rgOP.ItemIndex of
    0: op := FO_COPY;
    1: op := FO_DELETE;
    2: op := FO_MOVE;
    3: op := FO_RENAME;
  end;
  flag := 0;
  if AllowUndo.Checked then
    flag := flag or FOF_ALLOWUNDO;
  if ConfirmMouse.checked then
    flag := flag or FOF_CONFIRMMOUSE;
  if FilesOnly.checked then
    flag := flag or FOF_FILESONLY;
  if NoConfirm.Checked then
    flag := flag or FOF_NOCONFIRMATION;
  if NoConfirmMkdir.Checked then
    flag := flag or FOF_NOCONFIRMMKDIR;
  if RenameColl.Checked then
    flag := flag or FOF_RENAMEONCOLLISION;
  if Silent.Checked then
    flag := flag or FOF_SILENT;
  if SimpleProgress.Checked then
    flag := flag or FOF_SIMPLEPROGRESS;
  with lpFileOp do
  begin
    Wnd := Form1.Handle;
    wFunc := op;
    pFrom := pChar(sFrom);
    pTo := pChar(sTo);
    fFlags := Flag;
    hNameMappings := nil;
    lpszProgressTitle := pChar(sTitle);
  end;
  if (SHFileOperation(lpFileOp) <> 0) then
    ShowMessage('Error processing request.');
  if lpFileOp.fAnyOperationsAborted then
    ShowMessage('Operation Aborted');
end;


Solve 2:

Here is desired function - with recursion:

function copyfilesindir(const source, dest, mask: string; subdirs: Boolean): Boolean;
var
  ts: TSearchRec;

  function filewithpath(const dir, file: string): string;
  begin
    if (length(dir) > 0) and (copy(dir, length(dir), 1) <> '\') then
      result := dir + '\' + file
    else
      result := dir + file;
  end;

begin
  result := directoryexists(dest);
  if not result then
    result := createdir(dest);
  if not result then
    exit;
  if findfirst(filewithpath(source, mask), faanyfile, ts) = 0 then
    repeat
      if not ((ts.name = '.') or (ts.name = '..')) then
      begin
        if ts.Attr and fadirectory > 0 then
        begin
          if subdirs then
            result := copyfilesindir(filewithpath(source, ts.name),
              filewithpath(dest, ts.name), mask, subdirs);
        end
        else
          result := copyfile(pchar(filewithpath(source, ts.name)),
            pchar(filewithpath(dest, ts.name)), false);
        if not result then
          break;
      end;
    until
      findnext(ts) <> 0;
  findclose(ts);
end;