在我們編寫程序的時候,經常會用到在某個目錄和子目錄中搜索文件這一過程,但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中運行通過。 (廣州 葉海河)
|