unit MainFrm;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 StdCtrls, Buttons;

type
 TMainForm = class(TForm)
 GroupBox1: TGroupBox;
 spbtnGetFromDir: TSpeedButton;
 spbtnGetToDir: TSpeedButton;
 edtFromDir: TEdit;
 edtToDir: TEdit;
 Button1: TButton;
 GroupBox2: TGroupBox;
 edtRecycleDir: TEdit;
 spbtnRecycleBin: TSpeedButton;
 btnRecycleDir: TButton;
 btnClose: TButton;
 procedure spbtnGetFromDirClick(Sender: TObject);
 procedure spbtnGetToDirClick(Sender: TObject);
 procedure btnCopyDirectoryClick(Sender: TObject);
 procedure spbtnRecycleBinClick(Sender: TObject);
 procedure btnRecycleDirClick(Sender: TObject);
 procedure btnCloseClick(Sender: TObject);
 private
 { Private declarations }
 public
 { Public declarations }
 end;

var
 MainForm: TMainForm;

implementation
uses ShellAPI, FileCtrl;
{$R *.DFM}

function GetDirectory: string;
begin
 if not SelectDirectory(Result, [sdAllowCreate, sdPerformCreate, sdPrompt], 0)
 then
 Result := EmptyStr;
end;

procedure CopyDirectoryTree(AHandle: THandle; const AFromDirectory,
 AToDirectory: string);
var
 SHFileOpStruct: TSHFileOpStruct;
 FromDir: PChar;
 ToDir: PChar;
begin

 GetMem(FromDir, Length(AFromDirectory) + 2);
 try
 GetMem(ToDir, Length(AToDirectory) + 2);
 try

 FillChar(FromDir^, Length(AFromDirectory) + 2, 0);
 FillChar(ToDir^, Length(AToDirectory) + 2, 0);

 StrCopy(FromDir, PChar(AFromDirectory));
 StrCopy(ToDir, PChar(AToDirectory));

 with SHFileOpStruct do
 begin
 Wnd := AHandle; // Assign the window handle
 wFunc := FO_COPY; // Specify a file copy
 pFrom := FromDir;
 pTo := ToDir;
 fFlags := FOF_NOCONFIRMATION or FOF_RENAMEONCOLLISION;
 fAnyOperationsAborted := False;
 hNameMappings := nil;
 lpszProgressTitle := nil;
 if SHFileOperation(SHFileOpStruct) <> 0 then
 RaiseLastWin32Error;
 end;
 finally
 FreeMem(ToDir, Length(AToDirectory) + 2);
 end;
 finally
 FreeMem(FromDir, Length(AFromDirectory) + 2);
 end;
end;

procedure ToRecycle(AHandle: THandle; const ADirName: string);
var
 SHFileOpStruct: TSHFileOpStruct;
 DirName: PChar;
 BufferSize: Cardinal;
begin
 BufferSize := Length(ADirName) + 1 + 1;
 GetMem(DirName, BufferSize);
 try
 FillChar(DirName^, BufferSize, 0);
 StrCopy(DirName, PChar(ADirName));

 with SHFileOpStruct do
 begin
 Wnd := AHandle;
 wFunc := FO_DELETE;
 pFrom := DirName;
 pTo := nil;
 fFlags := FOF_ALLOWUNDO;

 fAnyOperationsAborted := False;
 hNameMappings := nil;
 lpszProgressTitle := nil;
 end;

 if SHFileOperation(SHFileOpStruct) <> 0 then
 RaiseLastWin32Error;
 finally
 FreeMem(DirName, BufferSize);
 end;
end;

procedure TMainForm.spbtnGetFromDirClick(Sender: TObject);
begin
 edtFromDir.Text := GetDirectory;
end;

procedure TMainForm.spbtnGetToDirClick(Sender: TObject);
begin
 edtToDir.Text := GetDirectory;
end;

procedure TMainForm.btnCopyDirectoryClick(Sender: TObject);
begin
 CopyDirectoryTree(Handle, edtFromDir.Text, edtToDir.Text);
end;

procedure TMainForm.spbtnRecycleBinClick(Sender: TObject);
begin
 edtRecycleDir.Text := GetDirectory;
end;

procedure TMainForm.btnRecycleDirClick(Sender: TObject);
begin
 ToRecycle(0, edtRecycleDir.Text);
end;

procedure TMainForm.btnCloseClick(Sender: TObject);
begin
 Close;
end;

end.