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
|
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ShellAPI,
StdCtrls;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
function CopyFolder(FromFld, ToFld: string): boolean;
var fos: TSHFileopStruct;
begin
// il faut supprimer les antislashs de fin sinon vous aurez droit à un message d'erreur
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;
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
begin
if CopyFolder('d:\Repertoire01', 'c:\Repertoire02')then
ShowMessage('Copie effectuée avec succès') else
ShowMessage('Copie non effectuée');
end;
initialization
{$I unit1.lrs}
end. |
Partager