Копирование директорий и удаление директорий в корзину

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.

Добавить комментарий