遍历目录及子目录

遍历目录及子目录

---

 

unit  Unit1 ;

interface

uses
   Windows ,  Messages ,  SysUtils ,  Variants ,  Classes ,  Graphics ,  Controls ,  Forms ,
   Dialogs ,  StdCtrls ;

type
   TForm1  =  class ( TForm )
     Memo1 :  TMemo ;
     Button1 :  TButton ;
     Button2 :  TButton ;
     procedure  Button1Click ( Sender :  TObject );
     procedure  Button2Click ( Sender :  TObject );
   private
     { Private declarations }
   public
     { Public declarations }
   end ;

var
   Form1 :  TForm1 ;

implementation
uses  Masks ;
{$R *.dfm}

//遍历目录及子目录
procedure  GetFileListEx ( FilePath ,  ExtMask :  string ;  FileList :  TStrings ;  SubDirectory :  Boolean  =  True );
   function  Match ( FileName :  string ;  MaskList :  TStrings ):  boolean ;
   var
     i :  Integer ;
   begin
     Result  :=  False ;
     for  i  :=  0  to  MaskList . Count  -  1  do
     begin
       if  MatchesMask ( FileName ,  MaskList [ i ])  then
       begin
         Result  :=  True ;
         break ;
       end ;
     end ;
   end ;
var
   FileRec :  TSearchrec ;
   MaskList :  TStringList ;
begin
   if  DirectoryExists ( FilePath )  then
   begin
     if  FilePath [ Length ( FilePath )]  <>  '\'  then  FilePath  :=  FilePath  +  '\' ;
     if  FindFirst ( FilePath  +  '*.*' ,  faAnyfile ,  FileRec )  =  0  then
     begin
       MaskList  :=  TStringList . Create ;
       try
         ExtractStrings ([ ';' ],  [],  PChar ( ExtMask ),  MaskList );
         FileList . BeginUpdate ;
         repeat
           if  (( FileRec . Attr  and  faDirectory )  <>  0 )  and  SubDirectory  then
           begin
             if  ( FileRec . Name  <>  '.' )  and  ( FileRec . Name  <>  '..' )  then
               GetFileListEx ( FilePath  +  FileRec . Name  +  '\' ,  ExtMask ,  FileList );
           end
           else
           begin
             if  Match ( FilePath  +  FileRec . Name ,  MaskList )  then
               FileList . Add ( {FilePath +}  FileRec . Name );
           end ;
         until  FindNext ( FileRec )  <>  0 ;
         FileList . EndUpdate ;
       finally
         MaskList . Free ;
       end ;
     end ;
     FindClose ( FileRec );
   end ;
end ;




procedure  TForm1 . Button1Click ( Sender :  TObject );
begin
  Memo1 . Lines . Clear ;
  GetFileListEx ( 'Z:\' ,  '*.*' ,  Memo1 . Lines ,  False );
  Caption := IntToStr ( Memo1 . Lines . count );
end ;

procedure  TForm1 . Button2Click ( Sender :  TObject );
begin

  Memo1 . Lines . Clear ;
  GetFileListEx ( 'Z:\' ,  '*.cs' ,   Memo1 . Lines ,  true );
//GetFileListEx('Z:\', '*.cs;*.txt',  Memo1.Lines, true);
  Caption := IntToStr ( Memo1 . Lines . count );
end ;

end .

来源： <">http://www.cnpack.org/>

 

来自为知笔记(Wiz)

附件列表