Copy directory structures (Views: 27)
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; |