輕輕鬆鬆找檔案--支援回撥函式的通用檔案查詢函式 (轉)

輕輕鬆鬆找檔案--支援回撥函式的通用檔案查詢函式 (轉)[@more@]

  輕輕鬆鬆查詢
  在平常的當中，經常會碰到查詢某一個目錄下某一類檔案或者所有檔案的問題，為了適應不同的需要，我們經常不得不編寫大量的類似的程式碼，有沒有可能寫一個通用的查詢檔案的，找到一個檔案後就進行處理的呢？這樣我們只要編寫處理檔案的部分就可以了，不需要編寫查詢檔案的部分！答案是肯定的。下面的這個程式就能實現這個功能！這個演算法的有待於改進，主要是目錄處理部分（特別指出的地方）。
明：
為回撥，FindFile函式找到一個匹配的檔案之後就會這個函式。
的第一個引數找到的檔名，你在回撥函式中可以根據檔名進行操作。
的第二個引數為找到的檔案的相關記錄資訊，是一個TSearchRec結構。
的第三、四個引數分別為決定是否終止檔案的查詢，臨時決定是否查詢某個子目錄！
的引數：
一個決定是否退出查詢，應該初始化為false；
二個為要查詢路徑；
三個為檔名，可以包含所支援的任何萬用字元的格式；預設所有的檔案
四個為回撥函式，預設為空
五個決定是否查詢子目錄，預設為查詢子目錄
六個決定是否在查詢檔案的時候處理其他的訊息，預設為處理其他的訊息，這個引數如果為false的話，可以加快處理速度，但是將不會響應程式的任何訊息。
有意見和建議請E_：">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  兒有待於改進因為會查詢
 // 所有的檔案，並不只是目錄
  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: T);
begin
listbox1.Clear;  始化
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;  止查詢
end;