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

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

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

.

Другое по теме:

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com