精华区 [关闭][返回]

当前位置:网易精华区>>讨论区精华>>编程开发>>● Delphi>>文件>>[文章]查找文件不再是难题!

主题:[文章]查找文件不再是难题!
发信人: 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版直达快车
█┃印龍┃█
█┗━━┛█
██████

[关闭][返回]