Обход дерева папок с построением списка файлов

[trengtor]

Subj. Нет ли где готовых вариантов?
(Windows-платформа, если это критично)

[alexs]

А в чём проблема?
FindFirst+FindNext и рекурсия вам в руки...

Добавлено спустя 1 минуту 10 секунд:
Если интересно - в RX есть даже компонент, который строит в указанном пункте меню программы иерархическое дерево по содержимому каталога...

[rxt]

А в чём проблема?
FindFirst+FindNext и рекурсия вам в руки...

Будьте же цивилизованы,
Пространство имён (Shell namespace) оболочки Windows является древовидной структурой ....
IShellFolder.EnumObjects создает объект для перечисления идентификаторов, с помощью интерфейса которого можно перечислять содержимое папки.
Более подробную информацию спрашивать у ОРАКУЛА.

Пример:

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

program PrintFolders;
{$APPTYPE CONSOLE}
{$mode Delphi}{$H+}

{ Консольное приложение выводит дерево папок
c помощью пространства имён оболочки Windows.}


uses
  Windows, SysUtils,ActiveX, ShlObj, ComObj;

const
  SHCONTF_FOLDERS = $20;
  SHCONTF_NONFOLDERS = $40;
  SHCONTF_INCLUDEHIDDEN = $80;
  SHGDN_NORMAL  = $0;
  SHGDN_INFOLDER  = $1;
  SHGDN_INCLUDE_NONFILESYS = $2000;

//------------------------------------------------------------------------------
{ вывод в консоль}
procedure AppendLog(const Text: string);
var
  s:string;
begin
  SetLength(s, Length(text));
  if not CharToOemA(PChar(text), PChar(s)) then s := text;
  WriteLn(s);
end;


//------------------------------------------------------------------------------
{ сдвигаем вывод для отображения иерархии }
procedure WriteLevel(Count: Integer);
var
  s: string;
begin
  s := StringOfChar(' ', Count);
  Write( s );
end;


var
  Malloc: IMalloc;
  desktop, InitShellDir: IShellFolder;
  pidlItself: PItemIDList;
  Level, CountFolder: Integer;
  CharsDone, dwAttributes, StartTime:DWORD;
  InitPath:WideString;

//------------------------------------------------------------------------------
{ получаем имя }
function GetDisplayName( pidl: PItemIDList; const STRT: STRRET ): string;
var
  P:PChar;
begin
  with STRT do
  case uType of
    STRRET_CSTR   : SetString(Result, STRT.cStr,   Length(STRT.cStr));
    STRRET_OFFSET : begin
                       P  := @PiDL.mkid.abID[STRT.uOffset - SizeOf(PiDL.mkid.cb)];
                       SetString(Result, P, PIDL.mkid.cb - STRT.uOffset);
                    end;
    STRRET_WSTR   : begin
                       Result     :=  STRT.pOleStr;
                       Malloc.Free(STRT.pOleStr);
                    end;
    end;
end;



//------------------------------------------------------------------------------
{ основная процедура обхода дерева вызывается рекурсивно }
procedure ShowFolder(folder: IShellFolder);
var
  pidlChild: PItemIDList;
  STRT: STRRET;
  Iterator: IEnumIDList;
  celtFetched: ULONG;
  child: IShellFolder;
begin
  OleCheck(folder.EnumObjects( 0 , SHCONTF_FOLDERS or SHCONTF_INCLUDEHIDDEN, Iterator ));
  try
    Inc(Level);
    While Iterator.Next( 1, pidlChild, celtFetched ) = NOERROR do
      try
        Olecheck(folder.GetDisplayNameOf( pidlChild, SHGDN_INFOLDER or SHGDN_INCLUDE_NONFILESYS, STRT ));
        WriteLevel(Level );
        Inc(CountFolder);
        AppendLog( GetDisplayName( pidlChild, STRT ) );
        OleCheck(folder.BindToObject( pidlChild, nil, IID_IShellFolder, Pointer(child) ));
        try
        ShowFolder( child );
        except
          // обработак ошибок
          on E:EOleException do
            AppendLog('***** EOleException:  [$'+IntToHex(E.ErrorCode, 8)+'] '+E.Message);
          on E:Exception do
            AppendLog('***** Exception: [$'+IntToHex(GetLastError, 8)+'] '+E.Message);
        end;
        child := nil;
      finally
        Malloc.Free( pidlChild );
      end;
  finally
    Dec(Level);
  end;
end;



//==============================================================================
{  НАЧАЛО }
begin
  if Paramcount > 0 then
    InitPath := ParamStr(1) else
    InitPath := ExtractFilePath(ParamStr(0));

  try
  (*
      Установка CoInitFlags имеет смысл в файлах проекта (*.dpr, *.lpr)
      и только перед инициализацией ComObj,
      в создаваемых потоках следует вызывать CoInitializeEx();
  *)
  CoInitFlags := COINIT_MULTITHREADED; 
  StartTime := GetTickCount;
  OleCheck(SHGetMalloc( Malloc ));
  try
    OleCheck(SHGetDesktopFolder( desktop ));
      try
        OleCheck(desktop.ParseDisplayName( 0, nil, PWideChar(InitPath), CharsDone,  pidlItself, dwAttributes ));
        try
          OleCheck(desktop.BindToObject(pidlItself, nil, IID_IShellFolder, InitShellDir));
          AppendLog(InitPath);
          ShowFolder( InitShellDir );
        finally
            InitShellDir := nil;         //< перед выходом лучше явно освободить
        end;
      finally
        Malloc.Free(pidlItself);
        desktop := nil;
      end;
    finally
      Malloc := nil;
    end;

  except
          on E:EOleException do
            AppendLog('***** EOleException:  [$'+IntToHex(E.ErrorCode, 8)+'] '+E.Message);
          on E:Exception do
            AppendLog('***** Exception: [$'+IntToHex(GetLastError, 8)+'] '+E.Message);
  end;
  Writeln;
  AppendLog(Utf8ToAnsi('* ГОТОВО * ')); // ух уж этот UTF8 ...
  AppendLog(Format(Utf8ToAnsi('Найдено папок %d  за %f сек. '), [CountFolder, (GetTickCount - StartTime) / 1000]));
  Writeln;
  AppendLog(Utf8ToAnsi('Для завершения нажмите ВВОД ...'));
  readln;
end.



[Ism]

Это привязка к Винде, нехорошо.

Вот как работать правильно с обходом файлов viewtopic.php?t=9259

[rxt]

Это привязка к Винде, нехорошо.

Вот как работать правильно с обходом файлов http://freepascal.ru/forum/viewtopic.php?t=9259

1. Вам следует внимательно перечитать пост ТС, а для holy war о кросплатформенности завести отдельный топик.
2. Вам следует научиться передавать параметры в процедурах и функциях прежде, чем выкладывать код и судить: где правильно, а где не правильно.

[Ism]

Это привязка к Винде, нехорошо.

Вот как работать правильно с обходом файлов viewtopic.php?t=9259

1. Вам следует внимательно перечитать пост ТС, а для holy war о кросплатформенности завести отдельный топик.
2. Вам следует научиться передавать параметры в процедурах и функциях прежде, чем выкладывать код и судить: где правильно, а где не правильно.

О, тролль , чтото их много стало. Наверное тролль хочет чтоб все пали на колени, он же большой.

Читаем верхний пост

(Windows-платформа, если это критично)

Кроссплатформенность всегда в приоритете в FPC, иначе будет никому не нужный код.

Надо купить какой нибудь пестицид , Атитролль подойдет. Давно хотел проверить

[rxt]

Ism,
Вместо того, чтобы доказывать истинность своих положений и опровергать аргументацию оппонента, критикуете его личность. Вы жалок. Купите лучше пестицид от говнокода.

[Padre_Mortius]

rxt, к коду от Ism есть небольшие уточнения, но хотелось бы от вас получить более подробные претензии.

P.S. В вашем коде тоже есть прикольный жучок.

[alexs]

rxt
Не надо учить людей плохому. Вместо использования 1-2 стандартных вызовов стандартной библиотеки паскаля вы предлагаете написать подводную лодку и запустить её в космос. Зачем - ActiveX, ShlObj, ComObj?

[Ism]

к коду от Ism есть небольшие уточнения, но хотелось бы от вас получить более подробные претензии.

Если поправите, заброшу в свой пост. Я сделал для себя и отправил рабочий вариант

[Padre_Mortius]

Ism, натравите свой алгоритм на папку с hardlink/symlink. Решение этого вопроса лежит тут