treesviewedit.pas

一个综合管理的程序,包含ie属性调用,控制面版打开,解锁注册表

unit treesviewedit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ExtCtrls, Menus, ImgList,shellapi,StdCtrls, Buttons,
  Grids, DBGrids, jpeg;

type
  Tlistfile = class(TForm)
    dir: TTreeView;
    wfile: TListView;
    PopupMenu1: TPopupMenu;
    PopupMenu2: TPopupMenu;
    ImageList1: TImageList;
    ImageList2: TImageList;
    D1: TMenuItem;
    N3: TMenuItem;
    R2: TMenuItem;
    V1: TMenuItem;
    N4: TMenuItem;
    M2: TMenuItem;
    L1: TMenuItem;
    N7: TMenuItem;
    N1: TMenuItem;
    N2: TMenuItem;
    M1: TMenuItem;
    N12: TMenuItem;
    Splitter1: TSplitter;
    Image1: TImage;
    zt: TStatusBar;
    procedure FormCreate(Sender: TObject);
    procedure dirCollapsed(Sender: TObject; Node: TTreeNode);
    procedure dirExpanded(Sender: TObject; Node: TTreeNode);
    procedure wfileDblClick(Sender: TObject);
    procedure dirClick(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure dirEdited(Sender: TObject; Node: TTreeNode; var S: String);
    procedure wfileEdited(Sender: TObject; Item: TListItem; var S: String);
    procedure dirKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure D1Click(Sender: TObject);
    procedure R2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure M1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure L1Click(Sender: TObject);
    procedure M2Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
  private
    procedure filedir(dirname:string;node:ttreenode);//查找文件
    //procedure wmdropfiles(var msg:twmdropfiles);message wm_dropfiles;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  listfile: Tlistfile;
  fileinfo:shfileinfo;
  f:array [0..0,0..2] of string;
  ListItem: TListItem;
  filename,names:string;
  pathname:string;
  node1,node3:ttreenode;
implementation

{$R *.dfm}
function IsValidDir(SearchRec:TSearchRec):Boolean;
begin
  if ((SearchRec.Attr=16)or (searchrec.Attr =17)or
     (searchrec.Attr =18)or (searchrec.Attr =22)
     or (searchrec.Attr =49)or (searchrec.Attr =48))
      and (SearchRec.Name<>'.')     and (SearchRec.Name<>'..') then
      Result:=True
  else
     Result:=False;
  //showmessage(inttostr(searchrec.Attr ));
end;
////////以上是一个函数，功能是判断一个文件是不是文件夹。
function panel(node:ttreenode):string;
var
 str:string;
 node2:ttreenode;
begin
  try  node2:=node.Parent;
//返回父节点
  if node2<>nil then
  begin
  str:=node2.text+str;
  node1:=node2;
  filename:=str+'\'+filename;
  panel(node2);
  end
  else panel:=filename;
  except
    panel:=filename;
  end;
end;
///////一个递归函数，找到node的父节点。

//一个模块
{procedure tlistfile.wmdropfiles(var msg:twmdropfiles);
var
 numfiles:longint;
   i:longint;
   buffer:array[0..255] of char;
begin
  showmessage('asdfasdf');
end;
////////用兴趣的朋友可以在这处理鼠标拖放，本人没有处理，只是打到了。}

procedure tlistfile.filedir(dirname:string;node:ttreenode);
var
 searchrec:tsearchrec;
    filename:string;
    node1:ttreenode;
    i:integer;
begin
  try  for i:=node.Count -1 downto 0 do
    begin
      node.Item [i].Delete ;
    end;
  except
  end;
  filename:=dirname+'\*.*';
  wfile.Clear;
  listfile.ImageList2.Clear;
  listitem:=wfile.Items.Add;
  listitem.Caption:='..';
  if findfirst(filename,faAnyFile,searchrec)=0 then
    begin
      while findnext(searchrec)=0 do
        begin
         if IsValidDir(searchrec) then
           begin
             node1:=listfile.dir.Items.AddChild(node,searchrec.Name );
             node1.ImageIndex:=1;
             node1.SelectedIndex:=2;
             listfile.dir.Items.AddChild(node1,'' );
             shgetfileinfo(pchar(dirname+'\'+searchrec.Name ),0,fileinfo,sizeof(fileinfo),shgfi_icon);
             listfile.image1.Picture.Icon.Handle:=fileinfo.hIcon;//返回文件的图标
             listfile.ImageList2.AddIcon(listfile.image1.Picture.Icon);//添加图标
             f[0,0]:=searchrec.Name;//+'   '+inttostr(searchrec.Attr );
             f[0,1]:=inttostr(searchrec.Size);
             f[0,2]:=datetimetostr(filedatetodatetime(searchrec.Time ));
             listitem:=wfile.Items.Insert(1);
             listitem.Caption:=f[0,0];
             listitem.SubItems.Add('');
             listitem.SubItems.add(f[0,2]);
             wfile.Items[1].ImageIndex:=imagelist2.Count-1 ;
             wfile.Items[0].ImageIndex:=imagelist2.Count-1;
           end
         else
           begin
             if searchrec.Name <>'..' then
               begin
                 f[0,0]:=searchrec.Name;
                 f[0,1]:=inttostr(searchrec.Size);
                 f[0,2]:=datetimetostr(filedatetodatetime(searchrec.Time ));
                 listitem:=listfile.wfile.Items.Add;
                 listitem.Caption:=f[0,0];
                 listitem.SubItems.Add(f[0,1]);
                 listitem.SubItems.Add(f[0,2]);
                 shgetfileinfo(pchar(dirname+'\'+searchrec.Name ),0,fileinfo,sizeof(fileinfo),shgfi_icon);
                 listfile.image1.Picture.Icon.Handle:=fileinfo.hIcon;////返回文件图标
                 listfile.ImageList2.AddIcon(listfile.image1.Picture.Icon);
                 wfile.Items[wfile.Items.Count-1].ImageIndex:=imagelist2.Count -1;
               end;
           end;
        end;
    end;
  findclose(searchrec);
end;
//////////////以上是查找文件的过程
procedure SelectNode(const Tx: string; Tree: TTreeView);
var
 www:Boolean;
begin
  if Tx = '' then exit;
  node3:=tree.Items.GetFirstNode;
  www:=false;
  while node3<>nil do
  begin
    if pathname+'\'+node3.Text = tx then
      begin
        //node.Expanded:=true;
        //listfile.filedir(pathname+'\'+node1.Text,node1);
        node3.Expanded:=true;
        www:=true;
        break;
      end
    else
      begin
        try
        node3:=node3.GetNext;
        except
        showmessage(tx);
        shellexecute(listfile.handle,nil,pchar(tx),
          nil,nil,sw_shownormal)
        end;
      end;
  end;
  if www=false then
  shellexecute(listfile.handle,nil,pchar(tx ),
          nil,nil,sw_shownormal)
end;
//以上是一个过程，处理鼠标在listviewh 双击事件过程
//在树中查找


procedure Tlistfile.FormCreate(Sender: TObject);
var
    i:integer;
    drivepath:string;
    fname:string;
    node:ttreenode;
    rnode:ttreenode;

begin
  shgetfileinfo(pchar('c:\'),0,fileinfo,sizeof(fileinfo),shgfi_icon);
  listfile.image1.Picture.Icon.Handle:=fileinfo.hIcon;
  listfile.ImageList1.AddIcon(listfile.image1.Picture.Icon);
  listfile.ImageList2.AddIcon(listfile.image1.Picture.Icon);
  shgetfileinfo(pchar('c:\Program Files'),0,fileinfo,sizeof(fileinfo),shgfi_icon);
  listfile.image1.Picture.Icon.Handle:=fileinfo.hIcon;
  listfile.ImageList1.AddIcon(listfile.image1.Picture.Icon);
  shgetfileinfo(pchar('c:\Program Files'),0,fileinfo,sizeof(fileinfo),shgfi_icon);
  listfile.image1.Picture.Icon.Handle:=fileinfo.hIcon;
  listfile.ImageList1.AddIcon(listfile.image1.Picture.Icon);
//////////////////////////////////////////
/////////因为有两个imagelist控件一个是树的，一个是listfile的，imagelist的图标库是空的。
////以上是为两个imagelist控件添加图标。以上的代码可以不要，但为了界面的美观，可以手工的为
////两个imagelist控件添加图标.
////////////////////以上添加的图标一个是硬盘的图标，一个是文件夹的图标.
  dragacceptfiles(handle,true);
  application.Title:='资源管理器';
  for i:=0 to 25 do
    begin
     drivepath:=char(ord('A')+i)+':\';
     case getdrivetype(pchar(drivepath))of
      ////// drive_removable:
           //dir.Items.AddChild(nil,char(ord('A')+i)+':');

        drive_fixed:
         begin
           node:=dir.Items.AddChild(nil,char(ord('A')+i)+':');
           rnode:=dir.Items.AddChild(node,'');
           rnode.ImageIndex:=-1;
           fname:=char(ord('A')+i)+':';
           f[0,0]:=fname;
           listitem:=wfile.Items.Add;
           listitem.Caption:=f[0,0];
           listitem.SubItems.Add(f[0,1]);
         end;
       drive_remote:
         begin
           node:=dir.Items.AddChild(nil,char(ord('A')+i)+':');
           rnode:=dir.Items.AddChild(node,'');
           rnode.ImageIndex:=-1;
           fname:=char(ord('A')+i)+':';
           f[0,0]:=fname;
           listitem:=wfile.Items.Add;
           listitem.Caption:=f[0,0];
           listitem.SubItems.Add(f[0,1]);
         end;
       drive_cdrom:
         begin
           node:=dir.Items.AddChild(nil,char(ord('A')+i)+':');
           rnode:=dir.Items.AddChild(node,'');
           rnode.ImageIndex:=-1;
           fname:=char(ord('A')+i)+':';
           f[0,0]:=fname;
           listitem:=wfile.Items.Add;
           listitem.Caption:=f[0,0];
           listitem.SubItems.Add(f[0,1]);
         end;
       drive_ramdisk:
         begin
           node:=dir.Items.AddChild(nil,char(ord('A')+i)+':');
           rnode:=dir.Items.AddChild(node,'');
           rnode.ImageIndex:=-1;
           fname:=char(ord('A')+i)+':';
           f[0,0]:=fname;
           listitem:=wfile.Items.Add;
           listitem.Caption:=f[0,0];
           listitem.SubItems.Add(f[0,1]);
         end;
     end;
////////////以上的循环返回机器上的所有硬盘
    end;
end;
/////////////以上是窗体加载时的事件


procedure Tlistfile.dirCollapsed(Sender: TObject; Node: TTreeNode);
var I:integer;begin  for i:=node.Count -1 downto 1 do
    begin
      node.Item [i].Delete ;
    end;
end;
////////当treeview收缩时的事件
procedure Tlistfile.dirExpanded(Sender: TObject; Node: TTreeNode);
begin
   panel(node);
  names:=filename;
  if filename<>'' then
    begin
      filedir(filename+node.Text  ,node);
      pathname:=filename+node.Text;
    end
  else
    begin
      filedir(node.Text ,node);
      pathname:=node.Text;
    end;
   filename:='';
end;
///////treeview展开时的事件
/////以上的填充有两种，第一种就是我这种，第二种是在窗体加载时填充。
////第一种节省速度。
///////因为是网络传输，第一要考虑的就是速度，所以，我考虑第一种。
/////在节点展开是填充，收缩时删除节点，但只保留了一个。



procedure Tlistfile.wfileDblClick(Sender: TObject);

begin  try  if wfile.ItemIndex=0 then
    begin
    node3.Collapse(true);
    //node3.Expanded:=true;
    node3.Parent.Selected:=true;
    dir.onClick(node3.Parent );
    end
  else
  SelectNode(pathname+'\'+wfile.Selected.Caption,dir);
  except
  end;
 //   shellexecute(handle,nil,pchar(pathname+'\'+wfile.Selected.Caption ),
   //   nil,nil,sw_shownormal)
end;
/////////鼠标在listview上双击时

procedure Tlistfile.dirClick(Sender: TObject);
begin
  zt.Panels[0].Text:='';
  panel(dir.Selected);
  names:=filename;
  if filename<>'' then
    begin
      filedir(filename+dir.Selected.Text,dir.Selected);
      pathname:=filename+dir.Selected.Text;
    end
  else
    begin
      filedir(dir.Selected.Text ,dir.Selected);
      pathname:=dir.Selected.Text;
    end;
   filename:='';
end;
/////在treeview上单击时


procedure Tlistfile.N1Click(Sender: TObject);
begin
  begin
  if deletefile(pathname+'\'+wfile.Selected.Caption) then
    begin
      filedir(pathname,dir.Selected);
      zt.Panels[0].Text:='删除成功';
    end
  else
    begin
      zt.Panels[0].Text:='删除不成功';
    end;
end;
////处理在listview上删除一个对象是删除个文件
end;

procedure Tlistfile.dirEdited(Sender: TObject; Node: TTreeNode;
  var S: String);
   begin  if RenameFile(pathname, names+s) then
    zt.Panels[0].Text:='更名成功'
  else
    zt.Panels[0].Text:='更名不成功';
end;
//////在treeview上改名是更改对应的目录名

procedure Tlistfile.wfileEdited(Sender: TObject; Item: TListItem;
  var S: String);
 begin
 if  movefile(pchar(pathname+'\'+wfile.Selected.Caption),pchar(pathname+'\'+s)) then
   zt.Panels[0].Text:='更名成功'
 else
   zt.Panels[0].Text:='更名不成功';
end;
///////更改文件的文件名的事件


procedure Tlistfile.dirKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
Var
  T:TSHFileOpStruct;
  
begin
  if key=46 then
    begin
      With T do
        Begin
        Wnd:=0;
        wFunc:=FO_DELETE;
        pFrom:=Pchar(pathname);
        pTo:=nil;
        fFlags:=FOF_ALLOWUNDO+FOF_NOCONFIRMATION+FOF_NOERRORUI;
//标志表明允许恢复，无须确认并不显示出错信息
        hNameMappings:=nil;
        lpszProgressTitle:='正在删除文件夹...';
        fAnyOperationsAborted:=False;
        End;
        if SHFileOperation(T)=0 then
        begin
          zt.Panels[0].Text:='删除完毕';
          dir.Selected.Delete;
        end
        else
          zt.Panels[0].Text:='删除不成功';
    end;
end;
//////删除节点时同时删除对应的目录,用户按了键盘上的[Delete]键.

procedure Tlistfile.D1Click(Sender: TObject);
var
 key: word;
Shift: TShiftState;
begin
  key:=46;
  dir.onKeyUp(sender,key,shift);
end;
////点击tpopupmemu1的删除时。

procedure Tlistfile.R2Click(Sender: TObject);
begin
  dir.Selected.EditText;
end;
////////点击重命名时。

procedure Tlistfile.N3Click(Sender: TObject);
var
 node:ttreenode;
 s:string;
i:integer;
begin
  i:=pos(dir.Selected.Text,pathname);
  s:=pathname;
  delete(s,i,length(dir.Selected.Text ));
  //showmessage(s+'新建文件夹');
  mkdir(s+'新建文件夹');
  node:=dir.Items.AddChild(dir.Selected.Parent,'新建文件夹');
  node.ImageIndex:=1;
  node.SelectedIndex:=1;
  node.EditText;
end;
/////////点击新建文件夹时。

procedure Tlistfile.M1Click(Sender: TObject);
begin
  mkdir(pathname+'\'+'新建文件夹');
  listitem:=wfile.Items.Add;
  listitem.Caption:='新建文件夹';
  listitem.ImageIndex:=0;
end;
///////在wfile上新建文件夹时.

procedure Tlistfile.N2Click(Sender: TObject);
var
   f:textfile;
begin
  assignfile(f,pathname+'\'+'新建文件.Wxx');
  rewrite(f);  closefile(f);
  listitem:=wfile.Items.Add;
  listitem.Caption:='新建文件.Wxx';
  listitem.EditCaption;
end;
////新建文件时。

procedure Tlistfile.N4Click(Sender: TObject);
begin
  wfile.ViewStyle:=vsIcon;
end;
/////////大图标

procedure Tlistfile.L1Click(Sender: TObject);
begin
  wfile.ViewStyle:=vslist;
end;
////////////列表

procedure Tlistfile.M2Click(Sender: TObject);
begin
  wfile.ViewStyle:=vsSmallIcon;
end;
///////////小图标

procedure Tlistfile.N7Click(Sender: TObject);
begin
  wfile.ViewStyle:=vsReport;
end;
///////////详细资源。

end.