Рекурсивный обход папки

[Nikoshka]

Хотел рекурсивно обойти папку на Delphi, сделал код примерно как в PHP, там он прекрасно работает. Вс сводится к тому, что:

if(это папка){
Вывод папки;
Вызов функции снова;
}else{
Вывод файла;
}





На Delphi:

procedure catalog_tree(path: String; main_path: String);
var
length: integer;

Begin

if FindFirst(path+'*', faAnyFile, F) = 0 then
Begin

while FindNext(F) = 0 do
Begin

if (F.Name <> '..') and (F.Name <> '.') then
Begin

if DirectoryExists(path+F.Name) = false then
Begin
Form1.Memo1.Lines.Add(F.Name);
end

else

Begin
Form1.Memo1.Lines.Add(F.Name);
catalog_tree(path+F.Name+'/', main_path);
end;

end;

end;

end;

end;



Так нет, не хочет работать... Как найдет папку, так начинает в ней рыться, а про старые забывает. Я пытался найти статьи и нашел на http://www.delphiworld.narod.ru/base/re ... class.html, пока еще не разобрался.

Но мне непонятно, почему такая разница в работе рекурсвной функции? PHP как я понял где-то хранит те старые данные про каталог и потом возвращается к ним, а Delphi нет... Можно как-то в моем примере это дело довести до ума? Объясните плз, в чем тут отличие?

[Nikoshka]

Придумал, однако решение. Оказывается можно перед каждым запуском ф-и просто вызывать еще одну функцию, которая переберет текущую папку и сохранит все файлы в ней. Незнаю можно ли будет таким образом сохранить их с учетом вложенности и потом дерево построить... хотя если смотреть по папке, то дума можно

Правда что таке php делает и что Delphi не делает не пойму...

[Blood_Magic]

Набери в Delphi "FindFirst" и нажми Ctrl+F1, там пример есть

[somewhere]

Nikoshka, вот тебе мой готовый код. Сам когда-то парился с такой проблемой, посмотри, тут вроде все понятно.

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

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;

[LAngel]

Nikoshka, вот тебе мой готовый код. Сам когда-то парился с такой проблемой, посмотри, тут вроде все понятно.

Еех.. а кто за собой чистить будет?
интересно, что будет с памятью после рекурсивного обхода всего винта через эту функцию...

[syntax="delphi"]procedure GetFileList(const Path, mask: string; incSubDirs, incDirs: boolean; AList: TStrings);
var
I: Integer;
SearchRec: TSearchRec;
begin
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
GetFileList(Path + '\' + SearchRec.Name, mask, incSubDirs, incDirs, AList)
else if incDirs then AList.Add(Path + '\' + SearchRec.Name)
else if (SearchRec.Attr and faDirectory = 0)
then AList.Add(Path + '\' + SearchRec.Name);
I := FindNext(SearchRec);
end;
end;[/syntax]

[Nikoshka]

LAngel, somewhere,
Спасибо за помощь, только что такое:

faDirectory

?

[SergeyS]

Когда-то давно, когда я ещё заморачивался такими вещами как сканирование всех папок на машине (сейчас такие задачи почему-то не появляются ) я тоже пытался осуществить рекурсивный перебор директорий, но столкнулся с проблемой:

функция FindFirst выделяет память по TSearchRec. Так вот, она корректно выделяет память под FindFirst только несколько раз, а потом выдаёт всякую чушь. С помощью рекурсивной процедуры подобной той что предоставили LAngel и somewhere я смог обойти несколько директорий и их поддиректорий но потом программа просто не видела остальных папок (память я за собой подчищал и перепробовал все что можно).

Исправить данную проблему можно только уйдя от рекурсии и перейдя на итерацию. Например мой способ заключался в том, что я создавал строковый список и сканировал текущую директорию на предмет всех папок и каждую папку я добавлял в этот список, затем сканировал список в цикле while пока нет конца, и сканировал текущую директорию в списке и опять найденные директории добавлял в конец списка. Так я смог спокойно обойти весь диск и выделение памяти TSearchRect сводилось к минимуму.

Вот примерная реализация

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

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.

[Nikoshka]

SergeyS,
Кстати их ф-и работают На папке в 5к файлов он немного запнулся, похоже на зависание, но потом опять начинает работать.

Можно как-то избавится от этого? Т.е. сделать так, чтобы окно не глючило. Глючит графика, на окне отпечатываются другие окна, если их попытаться перенести и т.п. Как обычно себя Win ведет, если тормозит. Можно как-то от этого избавится? лучшее что мне пришло в голову - это делать окно на время не активным...

[SergeyS]

Nikoshka, есть два варианта:
1. Время от времени (лучше всего в цикле поиска файлов) вызывай Application.ProcessMessages, это немного удлинит время сканирования директорий но избавит тебя от неприятного "зависания".
2. Осуществи сканирование в отдельном потоке (как это делается уже обсуждалось в другой ветке)

А рекурсия действительно работает
Вообще-то когда я столкнулся с описанной мною проблемой то это был Delphi3, может это был баг который уже исправили в последующих версиях?

Но раз уж рекурсия работает, то используй её, но не забудь добавить в конец цепочки FindFirst, FindNext - FindClose, которая освобождает ресурсы связанные с переменной типа TSearchRec