Delphi编写Windows资源管理器
Delphi编写Windows资源管理器
发表:
不详 阅读: 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 <>'..' 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<>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.