Delphi World - Копирование директорий и удаление директорий в корзину
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Копирование директорий и удаление директорий в корзину

Автор: 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 World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования