unit1.pas

在Windows的资源管理器中选择文件时是不是觉得有一些麻烦

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, FileCtrl, StdCtrls, Menus,shellapi;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    DriveComboBox1: TDriveComboBox;
    DirectoryListBox1: TDirectoryListBox;
    FileListBox1: TFileListBox;
    N13: TMenuItem;
    N14: TMenuItem;
    PopupMenu1: TPopupMenu;
    N15: TMenuItem;
    N16: TMenuItem;
    N17: TMenuItem;
    N18: TMenuItem;
    N19: TMenuItem;
    N20: TMenuItem;
    N21: TMenuItem;
    N22: TMenuItem;
    N23: TMenuItem;
    N24: TMenuItem;
    N25: TMenuItem;
    procedure N7Click(Sender: TObject);
    procedure N9Click(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure N12Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N14Click(Sender: TObject);
    procedure N13Click(Sender: TObject);
    procedure DirectoryListBox1Change(Sender: TObject);
    procedure DriveComboBox1Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  src_dir:string;
  dst_dir:string;
  copy_filename:string;
  copy_or_cut:boolean;


implementation

{$R *.dfm}
uses
  unit2;
procedure TForm1.DriveComboBox1Change(Sender: TObject);
begin
  DirectoryListBox1.Drive:=DriveComboBox1.Drive;
end;

procedure TForm1.DirectoryListBox1Change(Sender: TObject);
begin
  FileListBox1.Directory:=DirectoryListBox1.Directory;
  Form1.Caption:=DirectoryListBox1.Directory;
end;

procedure TForm1.N13Click(Sender: TObject);
var
  filename:string;
begin
  filename:=inputbox('新建文件','请输入文件名','');
  if filename<>'' then
    filename:=DirectoryListBox1.Directory+'\'+filename;
  filecreate(filename);
  if IOResult<>0 then
    messagedlg('不能创建'+filename+'这个文件',mtwarning,[mbok],0);
  DirectoryListBox1.Update;
end;

procedure TForm1.N14Click(Sender: TObject);
var
  filedir:string;
begin
  filedir:=inputbox('新建文件夹','请输入文件夹名称','');
  if filedir<>'' then
    filedir:=DirectoryListBox1.Directory+'\'+filedir;
  mkdir(filedir);
  if IOResult<>0 then
    messagedlg('不能创建'+filedir+'这个文件夹',mtwarning,[mbok],0);
  FileListBox1.Update;
end;

procedure TForm1.N3Click(Sender: TObject);
var
  att:word;
  Form2: TForm2;
begin
  Form2:=TForm2.Create(nil);
  with Form2 do
  begin
    lbfilename.Caption:=FileListBox1.Items[FileListBox1.Itemindex];
    lbdiretory.Caption:=FileListBox1.Directory;
    lbdate.Caption:=datetimetostr(filedatetodatetime(fileage(FileListBox1.FileName)));
    att:=filegetattr(FileListBox1.FileName);
    if (att and fareadonly)=fareadonly then
      cbreadonly.Checked:=true;
    if (att and fahidden)=fahidden then
      cbhidden.Checked;
    showmodal;
    free;
  end;
end;

procedure TForm1.N5Click(Sender: TObject);
begin
  Form1.Close;
end;

procedure TForm1.N12Click(Sender: TObject);
var
  newname:string;
begin
  if DirectoryListBox1.Focused then
  begin
    newname:=Dialogs.InputBox('重命名文件夹','请输入新的文件夹名称','');
    if newname<>'' then
      RenameFile(DirectoryListBox1.Items[DirectoryListBox1.ItemIndex],newname);
    DirectoryListBox1.Update;
  end;
  if FileListBox1.Focused then
  begin
    newname:=Dialogs.InputBox('重命名文件','请输入新的文件名','');
    if newname<>'' then
      RenameFile(FileListBox1.Items[FileListBox1.ItemIndex],newname);
    FileListBox1.Update;
  end;
end;

procedure TForm1.N10Click(Sender: TObject);
var
  t:tshfileopstruct;
begin
  if FileListBox1.Focused then
  begin
    if FileListBox1.FileName<>'' then
    begin
      if messagedlg('确定要删除'+FileListBox1.Items[FileListBox1.ItemIndex]+'吗?',
      mtinformation,[mbyes,mbno],0)=mryes then
        DeleteFile(FileListBox1.Directory+FileListBox1.FileName);
      FileListBox1.Update;
    end;
  end;
  if DirectoryListBox1.Focused then
  begin
    if DirectoryListBox1.Directory<>'' then
    begin
      if messagedlg('确定要删除'+DirectoryListBox1.Items[DirectoryListBox1.ItemIndex]+'夹吗?',
      mtinformation,[mbyes,mbno],0)=mryes then
        //Removedir(DirectoryListBox1.Directory+DirectoryListBox1.Items[DirectoryListBox1.ItemIndex]);
     with t do
      begin
        wnd:=0;
        wfunc:=fo_delete;
        pfrom:=pchar(DirectoryListBox1.Directory);
        pto:=nil;
        fflags:=fof_allowundo+fof_noerrorui;
        hnamemappings:=nil;
        lpszprogresstitle:='正在删除文件夹';
        fanyoperationsaborted:=false;
      end;
      shfileoperation(t);
      DirectoryListBox1.Update;
    end;
  end;
end;

procedure TForm1.N8Click(Sender: TObject);
begin
  if FileListBox1.FileName='' then
  begin
    showmessage('请选择文件');
    exit;
  end;
  src_dir:=FileListBox1.Directory;
  copy_filename:=ExtractFileName(FileListBox1.FileName);
  copy_or_cut:=false;
  N9.Enabled:=true;
end;

procedure TForm1.N9Click(Sender: TObject);
var
  len:integer;
  tmp:string;
begin
  dst_dir:=DirectoryListBox1.Directory;
  len:=length(src_dir);
  tmp:=copy(src_dir,len,1);
  if tmp='\' then
    src_dir:=copy(src_dir,0,len-1);

  len:=length(dst_dir);
  tmp:=copy(dst_dir,len,1);
  if tmp='\' then
    src_dir:=copy(dst_dir,0,len-1);

  if dst_dir=src_dir then
    CopyFile(pchar(src_dir+'\'+copy_filename),pchar(dst_dir+'\复件'+copy_filename),true)
  else
    CopyFile(pchar(src_dir+'\'+copy_filename),pchar(dst_dir+'\'+copy_filename),true);
  if copy_or_cut=true then
    deletefile(src_dir+'\'+copy_filename);
  FileListBox1.Update;
end;

procedure TForm1.N7Click(Sender: TObject);
begin
  if FileListBox1.FileName='' then
  begin
    showmessage('请选择文件');
    exit;
  end;
  src_dir:=FileListBox1.Directory;
  copy_filename:=ExtractFileName(FileListBox1.FileName);
  copy_or_cut:=true;
  N9.Enabled:=true;
end;

end.