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;

Nincsenek megjegyzések:

Megjegyzés küldése