Текущий архив: 2005.01.16;
Скачать: CL | DM;
Вниз
Рекурсивный проход дерева каталогов Найти похожие ветки
← →
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 вложенной процедурой). Тогда ошибка о нехватке памяти возникнет чуть позже
← →
Fay © (2004-12-27 16:19) [6]А сколько же должно быть файлов? На ~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
Страницы: 1 вся ветка
Текущий архив: 2005.01.16;
Скачать: CL | DM;
Память: 0.49 MB
Время: 0.044 c
