| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Рекурсивный проход дерева каталогов [D5, D6, D7, Win95/98, WinME, WinXP]

MTsv DN ©   (2004-12-27 15:42:00) 

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

Ниже приведен код, который можно найти в любом учебники по Дельфи и в сети... Это код рекурсивного прохода дерева каталогов... Думаю по коду никаких пояснений не требуется, НО..... При достижении определенного числа найденных файлов или каталогов (не знаю что точно) происходит ошибка 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

---

MTsv DN   (2004-12-27 18:39:00) [1]

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

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

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

---

MTsv DN   (2004-12-27 18:28:00) [2]

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

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

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

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

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

---

Fay   (2004-12-27 16:19:00) [3]

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

---

Sandman25   (2004-12-27 16:18:00) [4]

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

---

begin...end   (2004-12-27 16:14:00) [5]

> MTsv DN   (27.12.04 15:42)

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

---

Fay   (2004-12-27 15:50:00) [6]

sorry

---

Fay   (2004-12-27 15:49:00) [7]

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

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

---

Fay   (2004-12-27 15:47:00) [8]

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

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

---

Наверх