How to get a list of subdirectories and files in a folder (Views: 29)
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; |