轻轻松松找文件--支持回调函数的通用文件查找函数

             轻轻松松查找文件  在平常的编程当中，经常会碰到查找某一个目录下某一类文件或者所有文件的问题，为了适应不同的需要，我们经常不得不编写大量的类似的代码，有没有可能写一个通用的查找文件的程序，找到一个文件后就进行处理的呢？这样我们只要编写处理文件的部分就可以了，不需要编写查找文件的部分！答案是肯定的。下面的这个程序就能实现这个功能！这个算法的效率有待于改进，主要是目录处理部分（特别指出的地方）。file://说明：file://TFindCallBack为回调函数，FindFile函数找到一个匹配的文件之后就会调用这个函数。file://TFindCallBack的第一个参数找到的文件名，你在回调函数中可以根据文件名进行操作。file://TFindCallBack的第二个参数为找到的文件的相关记录信息，是一个TSearchRec结构。file://TFindCallBack的第三、四个参数分别为决定是否终止文件的查找，临时决定是否查找某个子目录！file://FindFile的参数：file://第一个决定是否退出查找，应该初始化为false；file://第二个为要查找路径；file://第三个为文件名，可以包含Windows所支持的任何通配符的格式；默认所有的文件file://第四个为回调函数，默认为空file://第五个决定是否查找子目录，默认为查找子目录file://第六个决定是否在查找文件的时候处理其他的消息，默认为处理其他的消息，这个参数如果为false的话，可以加快处理速度，但是将不会响应程序的任何消息。file://若有意见和建议请E_Mail：Kingron@163.nettype  TFindCallBack=procedure (const filename:string;const info:TSearchRec;var bQuit,bSub:boolean);

procedure FindFile(var quit:boolean;const path: String;const filename:string='*.*';                   proc:TFindCallBack=nil;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  if assigned(proc) then    proc(fpath+info.FindData.cFileName,info,quit,bsub);  end; end;

 procedure ProcessADirectory; begin  if (info.Name<>'.') and (info.Name<>'..') and ((info.attr and fadirectory)=fadirectory) then    findfile(quit,fpath+info.Name,filename,proc,bsub,bmsg); end;

beginif path[length(path)]<>'/' then  fpath:=path+'/'else  fpath:=path;try  if 0=findfirst(fpath+filename,faanyfile and (not fadirectory),info) then  begin    ProcessAFile;    while 0=findnext(info) do      begin        ProcessAFile;        if bmsg then application.ProcessMessages;        if quit then          begin            findclose(info);            exit;          end;      end;  end;finally  findclose(info);end;try  if bsub and (0=findfirst(fpath+'*',faanyfile,info)) then  file://这儿有待于改进因为会查找                                                          // 所有的文件，并不只是目录    begin      ProcessADirectory;      while findnext(info)=0 do         ProcessADirectory;    end;finally  findclose(info);end;end;例子：//回调函数：procedure aaa(const filename:string;const info:tsearchrec;var quit,bsub:boolean);begin  form1.listbox1.Items.Add(filename);  quit:=form1.qqq;  bsub:=form1.checkbox1.Checked;end;

procedure TForm1.Button1Click(Sender: TObject);beginlistbox1.Clear;  file://初始化qqq:=false;    button1.Enabled:=false;findfile(qqq,edit1.text,edit2.text,aaa,checkbox1.checked,checkbox2.checked);showmessage(inttostr(listbox1.items.count));      button1.Enabled:=true;end;

procedure TForm1.Button2Click(Sender: TObject);beginqqq:=true;      file://终止查找end;