mainfrm.pas

《Delphi开发人员指南》配书原码

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.