mainform.pas

Delphi高级程序开发配书源代码,可以循序渐进的学习Delphi.

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    edt1: TEdit;
    edt2: TEdit;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    edt3: TEdit;
    SpeedButton3: TSpeedButton;
    btnClose: TButton;
    Label1: TLabel;
    Label2: TLabel;
    btnCopy: TButton;
    Label3: TLabel;
    btnDelete: TButton;
    procedure btnCloseClick(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure btnCopyClick(Sender: TObject);
    procedure btnDeleteClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

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 TForm1.btnCloseClick(Sender: TObject);
begin
    Form1.Close;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
    edt1.Text := GetDirectory;
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
    edt2.Text := GetDirectory;
end;

procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
    edt3.Text := GetDirectory;
end;

procedure TForm1.btnCopyClick(Sender: TObject);
begin
    CopyDirectoryTree(Handle, edt1.Text, edt2.Text);
end;

procedure TForm1.btnDeleteClick(Sender: TObject);
begin
    ToRecycle(0, edt3.Text);
end;

end.