Developing.ru

Код: Выделить всё

function GetFileList(const Path, mask: string; incSubDirs, incDirs: boolean): TStringList;
var
  I: Integer;
  SearchRec: TSearchRec;
begin
  Result := TStringList.Create;
  try
    I := FindFirst(Path + '\'+mask, $FF, SearchRec);
    while (I = 0) and ((SearchRec.Name<>'.') or (SearchRec.Name<>'..')) do
    begin
      if (SearchRec.Name<>'.') and (SearchRec.Name<>'..') then
          if (SearchRec.Attr and faDirectory <> 0) and incSubDirs then
              Result.AddStrings(GetFileList(Path + '\' + SearchRec.Name, mask, incSubDirs, incDirs))
              else if incDirs then Result.Add(Path + '\' + SearchRec.Name)
                              else if (SearchRec.Attr and faDirectory = 0)
                              then Result.Add(Path + '\' + SearchRec.Name);
      I := FindNext(SearchRec);
    end;
  except
    Result.Free;
    raise;
  end;
end;

Код: Выделить всё

program Scan;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Classes;

procedure ScanDir(Root: String; List: TStrings);
var
  F: TSearchRec;
  h: THandle;
  i: Integer;
begin
  List.Clear;
  List.Add(Root);
  i := 0;
  while i < List.Count do begin
    Root := IncludeTrailingBackslash(List[i]);
    h := FindFirst(Root + '*.*', faAnyFile, F);
    while h = 0 do begin
      if (F.Attr and faDirectory) = faDirectory then begin
        if (F.Name <> '.') and (F.Name <> '..') then begin
          List.Add(Root + F.Name);
          WriteLn(Root + F.Name); // чтоб не скучно было ждать :)
        end;
      end;
      h := FindNext(F);
    end;
    FindClose(F);
    Inc(i);
  end;
end;

var
  List: TStringList;
  i: Integer;
begin
  List := TStringList.Create;
  ScanDir('C:\Program Files', List);
  for i := 0 to List.Count - 1 do
    WriteLn(List[i]);
  List.Free;
  ReadLn;
end.