|
|
在我们编写程序的时候，经常会用到在某个目录和子目录中搜索文件这一过程，但Delphi并没有为我们提供这一功能函数，它只为我们提供了一些只能在当前目录查找文件的函数，不过现在在网上也能找到一些可以实现此功能的控件，例如FileSearch等等。那么我们要自己编写这个功能，又应该怎么样做呢？其实本功能最难实现的部分就是要编写能逐层访问目录的算法。经本人研究，终于得出一个实现它的方法，那就是利用递归调用算法来实现，现将其实现过程介绍如下：
1、窗体设计
新建一个工程，在Form1中添加DriveComboBox1、Edit1、Listbox1、Button1、DirectoryOutline1、Label1，把Edit1的Text属性改为*.*，Button1的Caption属性改为"查找"，各个控件布局如下图：
2、程序清单
unit main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics,
Controls, Forms, Dialogs,stdctrls,filectrl,grids,outline,diroutln;
type
TForm1 = class(TForm)
DriveComboBox1: TDriveComboBox;
Edit1: TEdit;
Listbox1: TListBox;
Button1: TButton;
Label1: TLabel;
DirectoryOutline1: TDirectoryOutline;
procedure Button1Click(Sender: TObject);
procedure DriveComboBox1Change(Sender: TObject);
private
{ Private declarations }
ffilename:string;
function getdirectoryname(dir:string):string;
procedure findfiles(apath:string);
public
{ Public declarations }
end;
var
Form1: TForm1;
t:integer;
implementation
{$R *.DFM}
function tForm1.getdirectoryname(dir:string):string;
{对文件名进行转换，使之以反斜杠结尾}
begin
if dir[length(dir)]<>'' then
result:=dir+''
else
result:=dir;
end;
procedure TForm1.findfiles(apath: string);
{通过递归调用，可以在当前目录和子目录下查找指定格式的文件}
var
fsearchrec,dsearchrec:tsearchrec;
findresult:integer;
function isdirnotation(adirname:string):boolean;
begin
result:=(adirname='.') or (adirname='..');
end;
begin
apath:=getdirectoryname(apath); //获取一个有效的目录名称
{查找一个匹配的文件}
findresult:=findfirst(apath+ffilename,faanyfile+fahidden+fasysfile+fareadonly,fsearchrec);
try
{继续查找匹配的文件}
while findresult=0 do
begin
Listbox1.Items.Add(lowercase(apath+fsearchrec.Name));
t:=t+1;
label1.Caption:=inttostr(t);
findresult:=findnext(fsearchrec);
end;
{在当前目录的子目录中进行查找}
findresult:=findfirst(apath+'*.*',fadirectory,dsearchrec);
while findresult=0 do
begin
if ((dsearchrec.Attr and fadirectory)=fadirectory) and not
isdirnotation(dsearchrec.Name) then
findfiles(apath+dsearchrec.Name);//在此处是递归调用
findresult:=findnext(dsearchrec);
end;
finally
findclose(fsearchrec);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
{调用FindFiles()函数，用来搜索子目录}
begin
t:=0;
screen.Cursor:=crhourglass;
try
Listbox1.Items.Clear;
ffilename:=Edit1.Text;
findfiles(DirectoryOutline1.Directory);
finally
screen.Cursor:=crdefault;
end;
end;
procedure TForm1.DriveComboBox1Change(Sender: TObject);
begin
DirectoryOutline1.Drive:=DriveComboBox1.Drive;
end;
end.
本程序在Win2000/Delphi6中运行通过。
(广州 叶海河)
|
|
