1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
|
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
FileCtrl, ActiveX, ShlObj, ShellAPI,
Windows;
//
public
repertoireACopier,repertoireDeDestination:string;
//
function MyBrowseCallBackProc(Wnd: HWND; uMsg: DWORD; lParam, lpData:LPARAM ): integer; stdcall;
begin
end;
function SelectDirectory(const Caption, InitialDir: string; const Root: WideString; ShowStatus: Boolean; out Directory: string): Boolean;
var
BrowseInfo: TBrowseInfo;
Buffer: PChar;
RootItemIDList,
ItemIDList: PItemIDList;
ShellMalloc: IMalloc;
IDesktopFolder: IShellFolder;
Eaten, Flags: LongWord;
Windows: TList; //Pointer
Path: string;
begin
Result := False;
Directory := '';
Path := 'D:\Radio\HF\Sauvegardes\Contacts\bin32\Systeme';
if (Length(Path) > 0) and (Path[Length(Path)] = '\') then
Delete(Path, Length(Path), 1);
FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then
begin
Buffer := ShellMalloc.Alloc(MAX_PATH);
try
SHGetDesktopFolder(IDesktopFolder);
IDesktopFolder.ParseDisplayName(Application.Handle, nil, PWideChar(Root), Eaten, RootItemIDList, Flags);
with BrowseInfo do
begin
hwndOwner := Application.Handle;
pidlRoot := RootItemIDList;
pszDisplayName := Buffer;
lpszTitle := PChar(Caption);
ulFlags := BIF_RETURNONLYFSDIRS or BIF_NEWDIALOGSTYLE;
if ShowStatus then
ulFlags := ulFlags or BIF_STATUSTEXT;
lParam := Integer(PChar(Path));
lpfn := @MyBrowseCallBackProc;
end;
Windows := Screen.DisableForms(nil); //DisableTaskWindows(Application.Handle);
try
ItemIDList := ShBrowseForFolder(@BrowseInfo);
finally
Screen.EnableForms(Windows); //EnableTaskWindows(Windows);
end;
Result := ItemIDList <> nil;
if Result then
begin
ShGetPathFromIDList(ItemIDList, Buffer);
ShellMalloc.Free(ItemIDList);
Directory := Buffer;
end;
finally
ShellMalloc.Free(Buffer);
end;
end;
end;
function CopyFolder(FromFld, ToFld: string): boolean;
var fos: TSHFileopStruct;
begin
FromFld := ExcludeTrailingPathDelimiter(Trim(FromFld));
ToFld := ExcludeTrailingPathDelimiter(Trim(ToFld));
FillChar(fos, SizeOf(fos),0);
with fos do
begin
wFunc := FO_COPY;
pFrom := PChar(FromFld+#0);
pTo := PChar(ToFld+#0);
fFlags := FOF_SILENT or FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR;
end;
Result := ShFileOperation(fos)=0;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if(SelectDirectory('Sélectionner le dossier à copier','','',true,repertoireACopier))then
begin
if(SelectDirectory('Sélectionner le dossier de sortie','','',true,repertoireDeDestination))then
begin
if(CopyFolder(repertoireACopier,repertoireDeDestination))then
begin
ShowMessage('Copie effectuée avec succès');
end
else
begin
ShowMessage('La copie a échoué');
end;
end;
end;
end; |
