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

← →
MTsv DN (2004-12-27 15:42) [0]

Приветствую ВСЕХ...

Ниже приведен код, который можно найти в любом учебники по Дельфи и в сети... Это код рекурсивного прохода дерева каталогов... Думаю по коду никаких пояснений не требуется, НО..... При достижении определенного числа найденных файлов или каталогов (не знаю что точно) происходит ошибка EOutOfMemory...
Я уже встречал информацию о том, что этот код ограничен этой ошибкой, но решения проблемы или альтернативного кода ни где не встречал...

Отсюда вопрос...
Есть у кого-нибудь идеи обхода ошибки...
Или может у кого код имеется...был бы весьма признателен...

{$H+} unit TreeDir; interface type pDirAction = procedure (Dir, s : string); type pFileAction = procedure (Dir, s : string); procedure FindDirFile(Dir,Mask : string; DirAction: pDirAction; FileAction : pFileAction); implementation uses SysUtils; procedure FindDirFile(Dir, Mask : string; DirAction: pDirAction; FileAction : pFileAction); var T : tSearchRec; found : integer; begin found := FindFirst(Dir + Mask, faAnyFile or faDirectory, T); while found = 0 do begin if (t.Name <> ".") and (t.Name <> "..") then if ((t.Attr and faDirectory) <> 0) then begin DirAction(Dir, Dir + T.Name); FindDirFile(PChar(Dir + T.Name + "\"), "*.*", DirAction, FileAction); end else FileAction(Dir, Dir + T.Name); found := FindNext(T); end; FindClose(T); end; end.

С Уважением MTsv DN

← →
Fay © (2004-12-27 15:47) [1]

FindDirFile(PChar(Dir + T.Name + "\"), "*.*", DirAction, FileAction);

Не могло быть такого в учебнике

← →
Fay © (2004-12-27 15:49) [2]

FindDirFile(PChar(Dir + T.Name + "\"), "*.*", DirAction, FileAction);

Не могло быть такого в учебнике

← →
Fay © (2004-12-27 15:50) [3]

sorry

← →
begin...end © (2004-12-27 16:14) [4]

> MTsv DN (27.12.04 15:42)

А что происходит внутри процедур FileAction и DirAction?

← →
Sandman25 © (2004-12-27 16:18) [5]

Рекомендую поставить const передщ описанием параметров, а от последних двух параметров избавиться (например, сделав FindDirFile вложенной процедурой). Тогда ошибка о нехватке памяти возникнет чуть позже

А сколько же должно быть файлов? На ~10000 каталогов и ~100000 файлов не заругался (да и с чего бы ему?).

← →
MTsv DN (2004-12-27 18:28) [7]

А что происходит внутри процедур FileAction и DirAction?
Там динамический массив заполняется...Думаю этом дело...Надо статическим сделать...

Рекомендую поставить const перед описанием параметров, а от последних двух параметров избавиться (например, сделав FindDirFile вложенной процедурой). Тогда ошибка о нехватке памяти возникнет чуть позже...
Согласен...Попробую...

А сколько же должно быть файлов? На ~10000 каталогов и ~100000 файлов не заругался (да и с чего бы ему?).

MaxFiles = 600000;
MaxDirs = 20000;
Еще не проверял...Как проверю так напишу...

С Уважением MTsv DN

← →
MTsv DN (2004-12-27 18:39) [8]

Всем ОГРОМНОЕ СПАСИБО за Участие...

Вся ошибка из-за динамичности массива...Вернее от постоянного увеличения его размерности SetLength()...
Фиксация размерности решает проблему сразу...
Просканировал весь диск ...и надо сказать, получилось гораздо быстрее...

С Уважением MTsv DN

Рекурсивный проход дерева каталогов Найти похожие ветки