Копирование директорий и удаление директорий в корзинуDelphi , Файловая система , КорзинаКопирование директорий и удаление директорий в корзинуАвтор: Xavier Pacheco 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. Статья Копирование директорий и удаление директорий в корзину раздела Файловая система Корзина может быть полезна для разработчиков на Delphi и FreePascal. Комментарии и вопросыМатериалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.
|
||||
©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007 |