发信人: kingron(金龍)
整理人: kingron(2000-12-27 18:07:18), 站内信件
|
在程序设计中经常要查找某个目录下的某些文件，因此大家不得不写一些函数来查找，有没有可能写一个通用的查找文件的函数呢？答案是肯定的。下面就就是你要的：
这个函数支持回调
type
TFindCallBack=procedure (const filename:string;var bquit:boolean);
procedure findfile(var fileresult: Tstrings;var quit:boolean;const path: String;
const filename:string='*.*';const proc:TFindCallBack=nil;
const attr:integer=faanyfile;const bSub:boolean=true;
const bMsg:boolean=true);
var
fpath: String;
info: TsearchRec;
procedure ProcessAFile;
begin
if (info.Name<>'.') and (info.Name<>'..') and ((info.Attr and faDirectory)<>faDirectory) then
begin
fileresult.add(fpath+info.FindData.cFileName);
if assigned(proc) then
proc(fpath+info.FindData.cFileName,quit);
end;
end;
procedure ProcessADirectory;
begin
if (info.Name<>'.') and (info.Name<>'..') and ((info.attr and fadirectory)=fadirectory) then
findfile(fileresult,quit,fpath+info.Name,filename,proc,attr,bsub,bmsg);
end;
begin
if quit then exit;
if path[length(path)]<>'\' then
fpath:=path+'\'
else
fpath:=path;
if 0=findfirst(fpath+filename,attr and (not fadirectory),info) then
begin
ProcessAFile;
while findnext(info)=0 do
begin
if bmsg then application.ProcessMessages;
ProcessAFile;
if quit then
begin
findclose(info);
exit;
end;
end;
end;
findclose(info);
if bsub then
if findfirst(fpath+'*',fadirectory+fasysfile+fahidden,info)=0 then
begin
ProcessADirectory;
while findnext(info)=0 do
ProcessADirectory;
end;
findclose(info);
end;
调用例子：
procedure aaa(const filename:string;var quit:boolean);
begin
form1.listbox1.Items.Add(filename);
quit:=form1.qqq;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
aa,bb:tstrings;
// i:integer;
quit:boolean;
begin
listbox1.Clear;
qqq:=false;
button1.Enabled:=false;
aa:=tstringlist.Create;
bb:=tstringlist.Create;
quit:=false;
findfile(aa,quit,edit1.text,edit2.text,aaa,faanyfile,checkbox1.checked);
listbox1.Items:=aa;
showmessage(inttostr(listbox1.items.count));
button1.Enabled:=true;
aa.Free;
bb.Free;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
qqq:=true;
end;
----
██████
█┏━━┓█
█┃之金┃█ 访问Delphi版请点击这儿：Delphi版直达快车
█┃印龍┃█
█┗━━┛█
██████ |
|