Delphi编写Windows资源管理器

最新推荐文章于 2023-05-03 15:17:00 发布

pgnet

最新推荐文章于 2023-05-03 15:17:00 发布

阅读量3.1k

点赞数 1

文章标签： delphi windows imagelist listview string 服务器

本文链接：https://blog.csdn.net/pgnet/article/details/3267826

版权

Delphi编写Windows资源管理器

发表: 不详阅读: <script language=JavaScript src="../hits.asp?id=1440"></script> 2072次关键字：不详字体:[ 大中小]

编写资源管理器，Delphi 有最简单的方法，就是在form上加上一个TShellComboBox1控件，一个TShellTreeView1控件和一个TShellListView1控件。然后分别指定他们的属性值为对应的属性就可以了。
但是这不是一个程序员所要的。因为你不能对上述的这些内容进行操作，所以，我
在这里要说的是第二种，也就是最为激动人心的有自己写的代码来实现以上的功能。
用程序实现的好处是控制随心所欲。这把这种方法用到了我写的木马当中。
在服务器端有我的一个服务程序，在我的机子上有我的另一个客户端程序。
当我要用我的客户端连接服务器端的时候，比如202.206.242.119，服务器端就把
本机(202.206.242.119)上的所有磁盘信息发送给我。（比如有c:,d:,e:,f:....)
当我在本地（我的机子）上点击"c:"时候，服务器端就把202.206.242.119上的
c:盘上的所有文件和目录发送给我，我一目了然。我还可以在他的机子上新建、删除
运行等各种文件。好不好玩啊？~_~当然，他首先得运行我的木马程序。
国内赫赫有名的"冰河"我想大家都用过吧，不错吧。就像是管理自己机子的资料管理器,好了，不再废话了，让我们开始这激动人心的一刻吧！

首先要明白程序的流程，不然我不是在这瞎说一通吗？

第一步就是找到机子上的所有的硬盘，第二就是找到机子上对应硬盘下的所有文件。
找硬盘的方法很多，我用的是Winapi函数：getdrivetype,因为它比较简单。
打文件就是findfirst和findnext就可以了。
剩下的就是怎样向ttreeview中填充了。
好了，开始吧！

新建一个工程，然后窗体的caption为"资源管理器"。
在窗体上添加一个TTreeview控件命名为dir,一个tlistview控件命名为wfile，两个tpopupmenu控件。
两个timagelist控件.dir 对应第一个tpopupmemu,wfile对应第二个tpopupmemu。
第一个tpopupmemu的Items分别为：删除，新建文件夹，重命名。
第二个tpopupmemu的Items分别为：查看，删除，新建文件，新建文件夹，重命名。其中，查看的子项为：
大图标，小图标，列表和详细资料。



unit Unit1;

interface

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

type
  Tlistfile = class(TForm)
    dir: TTreeView;
    Wfile: TListView;
    Splitter1: TSplitter;
    ImageList1: TImageList;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    Image1: TImage;
    ImageList2: TImageList;
    N2: TMenuItem;
    R1: TMenuItem;
    PopupMenu2: TPopupMenu;
    D1: TMenuItem;
    N3: TMenuItem;
    R2: TMenuItem;
    M1: TMenuItem;
    zt: TStatusBar;
    V1: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    M2: TMenuItem;
    L1: TMenuItem;
    N7: TMenuItem;
    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;//返回父节点
  str:=node2.Text+str;
  node1:=node2;
  filename:=str+'/'+filename;
  panel(node2);
  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 &lt;&gt;'..' 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;
  while node3&lt;&gt;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);
var i:integer;
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
  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上删除一个对象是删除个文件

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;
  P:String;
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.