2007. március 21., szerda
How to get a list of subdirectories and files in a folder
Problem/Question/Abstract:
I want to automatically search a directory and get a listing of all the subdirectories and files on that drive.
Answer:
Solve 1:
Here is one way:
function FindFiles(Directory: string; InclAttr, ExclAttr: Integer;
const SubDirs: Boolean; const Files: TStrings): Integer;
var
SearchRec: TSearchRec;
begin
Directory := IncludeTrailingPathDelimiter(Directory);
FillChar(SearchRec, SizeOf(SearchRec), 0);
if FindFirst(Directory + '*.*', faAnyFile, SearchRec) = 0 then
begin
try
repeat
if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
if ((SearchRec.Attr and InclAttr > 0) or ((SearchRec.Attr = 0) and (InclAttr
<> faDirectory))) and
(SearchRec.Attr and ExclAttr = 0) then
begin
Files.Add(Directory + SearchRec.Name);
if SubDirs then
if SearchRec.Attr and faDirectory <> 0 then
FindFiles(Directory + SearchRec.Name, InclAttr, ExclAttr, SubDirs,
Files);
end;
until
FindNext(SearchRec) <> 0;
finally
FindClose(SearchRec);
end;
end;
Result := Files.Count;
end;
Example of usage:
procedure TForm1.Button1Click(Sender: TObject);
var
sl: TStringList;
begin
Memo1.Clear;
sl := TStringList.Create;
try
FindFiles('c:\', faAnyFile, 0, True, sl);
Memo1.Lines.Add('Number of directories/files: ' + IntToStr(sl.Count));
Memo1.Lines.AddStrings(sl);
finally
sl.Free;
end;
end;
Solve 2:
procedure GetFiles(APath: string; AExt: string; AList: TStrings; ARecurse: boolean);
var
theExt: string;
searchRec: SysUtils.TSearchRec;
begin
if APath[Length(APath)] <> '\' then
APath := APath + '\';
AList.AddObject(APath, Pointer(-1));
if FindFirst(APath + '*.*', faAnyFile, searchRec) = 0 then
try
repeat
with searchRec do
begin
if (Name <> '.') and (Name <> '..') then
if (Attr and faDirectory <= 0) then
begin
theExt := '*' + UpperCase(ExtractFileExt(searchRec.Name));
if (AExt = '*.*') or (theExt = UpperCase(AExt)) then
AList.AddObject(searchRec.Name, Pointer(0))
end
else
begin
if ARecurse then
begin
GetFiles(APath + Name + '\', AExt, AList, ARecurse);
end;
end;
end;
Application.ProcessMessages;
until
FindNext(searchRec) <> 0;
finally
SysUtils.FindClose(searchRec);
end;
end;
Feliratkozás:
Megjegyzések küldése (Atom)
Nincsenek megjegyzések:
Megjegyzés küldése