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); //获取一个有效的目录名称
{继续查找匹配的文件} 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中运行通过。