ITPub博客

首页 > 应用开发 > IT综合 > 轻轻松松找文件--支持回调函数的通用文件查找函数 (转)

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

原创 IT综合 作者:worldblog 时间:2007-12-03 11:07:06 0 删除 编辑
轻轻松松找文件--支持回调函数的通用文件查找函数 (转)[@more@]

  轻轻松松查找文件
  在平常的编程当中,经常会碰到查找某一个目录下某一类文件或者所有文件的问题,为了适应不同的需要,我们经常不得不编写大量的类似的代码,有没有可能写一个通用的查找文件的程序,找到一个文件后就进行处理的呢?这样我们只要编写处理文件的部分就可以了,不需要编写查找文件的部分!答案是肯定的。下面的这个程序就能实现这个功能!这个算法的效率有待于改进,主要是目录处理部分(特别指出的地方)。
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.NET">Kingron@163.net
type
  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;

begin
if 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);
begin
listbox1.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);
begin
qqq:=true;  file://终止查找
end;


来自 “ ITPUB博客 ” ,链接:http://blog.itpub.net/10752043/viewspace-987600/,如需转载,请注明出处,否则将追究法律责任。

请登录后发表评论 登录
全部评论
  • 博文量
    6241
  • 访问量
    2462309