遍历目录及子目录
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/>
附件列表
遍历目录及子目录