Author: Jonas Bilinkevicius
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.
1
2 procedure TForm1.SHFileOperationCopy(sFrom, sTo, STitle: string);
3 var
4 lpFileOp: TSHFILEOPSTRUCT;
5 op, flag: Integer;
6 begin
7 case rgOP.ItemIndex of
8 0: op := FO_COPY;
9 1: op := FO_DELETE;
10 2: op := FO_MOVE;
11 3: op := FO_RENAME;
12 end;
13 flag := 0;
14 if AllowUndo.Checked then
15 flag := flag or FOF_ALLOWUNDO;
16 if ConfirmMouse.checked then
17 flag := flag or FOF_CONFIRMMOUSE;
18 if FilesOnly.checked then
19 flag := flag or FOF_FILESONLY;
20 if NoConfirm.Checked then
21 flag := flag or FOF_NOCONFIRMATION;
22 if NoConfirmMkdir.Checked then
23 flag := flag or FOF_NOCONFIRMMKDIR;
24 if RenameColl.Checked then
25 flag := flag or FOF_RENAMEONCOLLISION;
26 if Silent.Checked then
27 flag := flag or FOF_SILENT;
28 if SimpleProgress.Checked then
29 flag := flag or FOF_SIMPLEPROGRESS;
30 with lpFileOp do
31 begin
32 Wnd := Form1.Handle;
33 wFunc := op;
34 pFrom := pChar(sFrom);
35 pTo := pChar(sTo);
36 fFlags := Flag;
37 hNameMappings := nil;
38 lpszProgressTitle := pChar(sTitle);
39 end;
40 if (SHFileOperation(lpFileOp) <> 0) then
41 ShowMessage('Error processing request.');
42 if lpFileOp.fAnyOperationsAborted then
43 ShowMessage('Operation Aborted');
44 end;
Solve 2:
Here is desired function - with recursion:
45
46 function copyfilesindir(const source, dest, mask: string; subdirs: Boolean):
47 Boolean;
48 var
49 ts: TSearchRec;
50
51 function filewithpath(const dir, file: string): string;
52 begin
53 if (length(dir) > 0) and (copy(dir, length(dir), 1) <> '\') then
54 result := dir + '\' + file
55 else
56 result := dir + file;
57 end;
58
59 begin
60 result := directoryexists(dest);
61 if not result then
62 result := createdir(dest);
63 if not result then
64 exit;
65 if findfirst(filewithpath(source, mask), faanyfile, ts) = 0 then
66 repeat
67 if not ((ts.name = '.') or (ts.name = '..')) then
68 begin
69 if ts.Attr and fadirectory > 0 then
70 begin
71 if subdirs then
72 result := copyfilesindir(filewithpath(source, ts.name),
73 filewithpath(dest, ts.name), mask, subdirs);
74 end
75 else
76 result := copyfile(pchar(filewithpath(source, ts.name)),
77 pchar(filewithpath(dest, ts.name)), false);
78 if not result then
79 break;
80 end;
81 until
82 findnext(ts) <> 0;
83 findclose(ts);
84 end;
|