Rambler's Top100
"Knowledge itself is power"
F.Bacon
Поиск | Карта сайта | Помощь | О проекте | ТТХ  
 Подземелье Магов
  
 

Фильтр по датам

 
 К н и г и
 
Книжная полка
 
 
Библиотека
 
  
  
 


Поиск
 
Поиск по КС
Поиск в статьях
Яndex© + Google©
Поиск книг

 
  
Тематический каталог
Все манускрипты

 
  
Карта VCL
ОШИБКИ
Сообщения системы

 
Форумы
 
Круглый стол
Новые вопросы

 
  
Базарная площадь
Городская площадь

 
   
С Л С

 
Летопись
 
Королевские Хроники
Рыцарский Зал
Глас народа!

 
  
ТТХ
Конкурсы
Королевская клюква

 
Разделы
 
Hello, World!
Лицей

Квинтана

 
  
Сокровищница
Подземелье Магов
Подводные камни
Свитки

 
  
Школа ОБЕРОНА

 
  
Арсенальная башня
Фолианты
Полигон

 
  
Книга Песка
Дальние земли

 
  
АРХИВЫ

 
 

Сейчас на сайте присутствуют:
 
  
 
Во Флориде и в Королевстве сейчас  06:55[Войти] | [Зарегистрироваться]

Обход дерева каталогов с прерыванием и возобновлением или "Куда мы идем завтра?"

Паша Звягинцев
дата публикации 17-12-2004 11:52

Обход дерева каталогов с прерыванием и возобновлением или "Куда мы идем завтра?"
Программист, просыпаясь утром с сильнейшего похмелья
начинает с тестирования памяти...


Недавно занимаясь интересной задачкой по написанию службы индексации, столкнулся с интересным вопросом: " А как бы нам поиск заморозить и продолжить после (через минуту, завтра, через месяц)?". Да конечно можно сказать - что у тебя за машина такая, вот у меня дерево каталогов обходит за 3 минуты... Согласен, это не вопрос. Но когда нужно не просто обходить, а еще и выполнять некоторые действия с файлами, да если их на диске 150 тыс. и больше, да еще не загружая процессор на 100%, то время может затянуться до нескольких суток, вот тогда - как быть?

Вот этой теме я и решил посвятить статью. Как оказалось, в Интернете информации по этой теме нет. Либо это слишком просто, либо никому не нужно. Как выяснилось - ни то ни другое.

Со стандартной процедурой обхода дерева сталкивались очень многие

procedure FileFind(path:string);
  var sr:Tsearchrec;// Описываем структуру, которую использует для поиска система
  found:integer; // найдено или нет
begin
  found:=FindFirst(path + '\*.*', FaAnyfile, sr);
    {по команде FindFirst программа создает
    структуру следующего типа
    TsearchRec = record
     Time: Integer; // время создания
     Size: Integer; // его размер
     Attr: Integer;// атрибуты
     Name:TFileName // = TString; собственно имя файла
     ExcludeAttr: Integer; найденные атрибуты
     FindHandle: THandle; // !!! указатель на структуру поиска, которую создает
     система, а не наша программа. Вот для чего обязательно в конце поиска
     указывать FindClose -   это высвобождает память
     FindData: TWin32FindData; // собственно эта структура
	end;}
  while (found = 0) do // если хоть что-то найдено
   begin
    if (sr.name <> '.') and (sr.name <> '..') then
    begin // если это не указатели на корневые каталоги, то чтото нашли
      if (sr.attr and FaDirectory) = FaDirectory then
        // ага вот поддиректория - вызываем себя рекурсивно, но с поиском уже
        // в этой директории
        FileFind(path+'\'+sr.name)
        else
        begin
          // вот тут выполняем чтото с найденным файлом
          ......
          mainform.memo1.lines.append(path+'\'+sr.name);
        end
      end;
   found:=findnext(sr); // есть ли еще файлы или каталоги
   end;
   FindClose(sr); // поиск закончен - нужно освободить память
end;

Казалось бы сохранить состояние процедуры поиска просто - достаточно сохранить структуру - sr:TsearchRec, а потом ее восстановить и поиск продолжится.

Первое
Однако при даже невнимательном рассмотрении процедуры видно, что она вызывает сама себя - налицо обычная рекурсия. Получается что надо сохранять не одну SearchRec, а несколько. Полдела - сохранить, но ведь нужно и восстановить эти рекурсивные вызовы. Т.е при продолжении поиска построить этакую матрешку из процедур поиска, а потом уже его продолжать.
Второе
— сама SearchRec. Казалось бы она находится в области данных нашей программы. Да это наполовину верно. Верхняя половина SearchRec действительно лежит в области данных нашей программы и делать мы с ней можем что душе угодно. Это переменные Time: Integer; Size: Integer; Attr: Integer; Name:TFileName; ExcludeAttr: Integer;. А вот вторая ее половина (FindHandle: THandle; FindData: TWin32FindData;) нам не принадлежит -ее генерирует система по нашему запросу FindFirst(.....) и уничтожает по команде FindClose(....).
Третий,
казалось бы, простой вопрос — SearchRec.Name имеет тип TFileName=TString. Какую длину он имеет? Одни скажут 255, другие 65535. Согласен, и то и другое верно, но не тут. Длина действительно 255. А вот с типом нас нагло обманули. Реально в памяти хранится не TString [255], а PChar {Имя файла}+PChar{его расширение}. Для нас с вами это преобразуется в обычную строку при обращении, и до столкновения с данной ситуацией я свято верил что там TString[255]. Кстати в чем разница между Богом и билом гейтсом? Бог не считает себя билом гейтсом ...

И так попробуем решить эти проблемы. Проше всего разбор начать в обратном порядке... (не подумайте превратно, я знаю через что рвут гланды в России...)

Третий вопрос - как сохранить , а потом восстановить SearchRec, если он состоит непонятно из чего. А давайте сделаем свой SearchRec, как нам нужно. А именно так

type // этот тип почти полностью переписывается со стандартного TSearchRec
 TMysearchRec = record
   Time: Integer;
   Size: Integer;
   Attr: Integer;
   Name: string[250];//вот тут обрабатывалось неверно при типе TString, как длина ?
   ExcludeAttr: Integer;
   FindHandle: THandle;  // в принципе не нужен, но не будем сильно пугать читателей
                         // сильными отличиями, да и бог с ними - с восемью байтами
   FindData: TWin32FindData;
 end;

но нам еще требуется сохранять несколько переменных самой программы, а именно Found - найдено чтото или нет и Path - с каким параметром нас вызывали, поэтому на основе этого типа делаем еще один

TMyRec_Sea = record
   Rec_Sea:TMySearchRec; // наша структура поиска
   path:String[250]; // откуда начинали
   found:integer; // при остановке нашли чтото или нет
end;

Второй вопрос после первого решается не очень красиво, но довольно легко. Да система генерит структуру: FindHandle: THandle; FindData: TWin32FindData. FindData - собственно сама структура и FindHandle - указатель на нее. Пусть система генерит что угодно, если с умом, то можно обойти и это. Многие ли помнят такое INT21h->INT 13H. Думаю вспомнили. При восстановлении поиска дадим команду FindFirst, а потом подменим FindData и остальные поля, не трогая FindHandle, иначе сразу после окончания поиска (!!! ???) получим обращение к недопустимому адресу и вылет программы.

......
    // создаем запись для поиска
    FindFirst(path+'\'+mask, FaAnyfile, sr);
    delfile:=false; found:=buffer.found;
    // загоняем в SEARCHREC все кроме FINDHANDLE (он создается системой)
    sr.Time:=buffer.rec_sea.Time;
    sr.Size:=buffer.rec_sea.Size;
    sr.Attr:=buffer.rec_sea.Attr;
    sr.Name:=buffer.rec_sea.Name;
    sr.ExcludeAttr:=buffer.rec_sea.ExcludeAttr;
    sr.FindData:=buffer.rec_sea.FindData;

Первый вопрос - как же сохранять состояние процедуры при рекурсии?. Давайте сохранять SearchRec в файл и используем принцип магазина (не продуктового, а от автомата калашникова) - последний вошел - первый вышел. Вот примерная структура процедуры при выполняющемся поиске ( при нескольких рекурсивных вызовах)

Findfile('c:\')
    Findfile('c:\Docs')
        FindFile(c:\Docs\Delphi')
           ......

При получении сигнала на остановку процедуры начинают писать в файл в обратном порядке, а именно - FindFile(c:\Docs\Delphi'),Findfile('c:\Docs'),Findfile('c:\'). Примерно так

Findfile('c:\')------------------------------------+
    Findfile('c:\Docs')---------------------+      !
        FindFile(c:\Docs\Delphi') ---+      !      !
                                     v      v      v
       [файл сохранений состояния] [rec1] [rec2] [rec3]  

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

Да, едва не забыл, как мы узнаем что надо приостановить поиск ? Давайте заведем глобальную переменную Process. Как она станет False - пора останавливаться

Ниже приведена часть модуля с использованием описанных алгоритмов

Unit unit1;
......
var
....
  process:boolean; // вот глобальная переменная она и управляет поиском
                   // true - можно
                   // false - стоп с запоминанием состояния
.....

procedure FileFind(path:string;resume:boolean);
{ сканирует диск (вернее дерево каталогов) при вызове PATH - начальный каталог
для обхода
RESUME - если TRUE - то продолжать сохраненный поиск
(тогда значение PATH игнорируется, кроме случая, когда не обнаружен файл
сохранения поиска)
при установке глобальной переменной PROCESS в false останавливается
с запоминанием предыдущего состояния,внимание - РЕКУРСИЯ !!! }
const
   save_ext='.rec'; // в каталоге приложения создает SAVE файл с именем
   //приложения и указанным расширением
   mask='*.*';
type
   TMysearchRec = record
   // пришлось написать свой тип SEARCHREC с NAME фиксированной длины
     Time: Integer; Size: Integer; Attr: Integer;
     Name: string[250];	//вот тут обрабатывалось неверно при типе TString,
                        // как длина ?
     ExcludeAttr: Integer;  FindHandle: THandle;  FindData: TWin32FindData;
   end;
   TMyRec_Sea = record
       Rec_Sea:TMySearchRec;
       path:String[250];  found:integer;  delfile:boolean;
   end;
var
  sr:TSearchRec;
  RecFile:TFileStream;
  buffer:tMyRec_Sea;
  sp,save_file_name:string; found:integer; delfile:Boolean;
  delfile:Boolean;
begin
  if resume then
  // возобновить поиск или начать новый
  begin
        save_file_name:=ChangeFileExt(ParamStr(0),save_ext);
        if FileExists(save_file_name) then
        begin
           RecFile:=TFileStream.Create(save_file_name,fmOpenReadWrite);
           // чистим буфер, не важно, необходимо для отладки
           fillchar(buffer,sizeof(buffer),#0);
           // читаем сохранение начиная с конца файла
           RecFile.Seek(-1*sizeof(buffer),soFromEnd);
           RecFile.Readbuffer(buffer,sizeof(buffer));
           path:=buffer.path; sp:=path;
           // создаем запись для поиска
           FindFirst(path+'\'+mask, FaAnyfile, sr);
           delfile:=false; found:=buffer.found;
           // загоняем в SEARCHREC все кроме FINDHANDLE (он создается системой)
           sr.Time:=buffer.rec_sea.Time;
           sr.Size:=buffer.rec_sea.Size;
           sr.Attr:=buffer.rec_sea.Attr;
           sr.Name:=buffer.rec_sea.Name;
           sr.ExcludeAttr:=buffer.rec_sea.ExcludeAttr;
           sr.FindData:=buffer.rec_sea.FindData;
           // режем кусок уже прочитали свои данные - другим они не понадобятся
           RecFile.Seek(-1*sizeof(buffer),soFromEnd);
           recfile.Size:=RecFile.Position;
           // дорезались - дозагружаться неоткуда
           if RecFile.Size=0 then delfile:=true;
           RecFile.Free;
           if delfile then sysutils.DeleteFile(save_file_name);
        end
        else
        // нет сохраненных поисков
        begin
           // начинаем новый
           sp:=path;  resume:=false;
           // тут исправляется разница между C:\ и C:\DOCS - убираем
           // последний слэш
           if sp[length(sp)]='\' then  sp:=copy(sp,1,length(sp)-1);
           found:=FindFirst(sp + '\'+mask, FaAnyfile, sr);
        end
  end
  else
  begin
     // новый поиск - пристрелить старые записи
     save_file_name:=ChangeFileExt(ParamStr(0),save_ext);
     if fileExists(save_file_name) then sysutils.DeleteFile(save_file_name) ;
     sp:=path;
     if sp[length(sp)]='\' then  sp:=copy(sp,1,length(sp)-1);
     found:=FindFirst(sp + '\'+mask, FaAnyfile, sr);
  end;
  // закончена подготовка - вперед поиск
  while (found = 0) and process do
  begin
    application.ProcessMessages;
    if (sr.name <> '.') and (sr.name <> '..') then
    begin
       if (sr.attr and FaDirectory) = FaDirectory
          then
          begin
             FileFind(sp+'\'+sr.name,resume);
          end
          else
          begin
            // ну тут разные действия с найденым файлом
            mainform.label1.caption:=('начат разбор  '+sp+'\'+sr.name) ;
             ................
            // закончили действия

            Application.ProcessMessages; // а вот без этого мы никогда не узнаем
                                         // что пора поиск закончить
          end;
    end;
    if process then found:=findnext(sr);
  end;
  if not process then
    // получили сигнал на остановку сканирования нужно запомнить состояние
    begin
        save_file_name:=ChangeFileExt(ParamStr(0),save_ext);
        if not FileExists(save_file_name) then
            RecFile:=TFileStream.Create(save_file_name,fmCreate)
          else RecFile:=TFileStream.Create(save_file_name,fmOpenReadWrite);
        RecFile.Seek(0,soFromEnd);
        // заполняем буфер текущим состоянием
        buffer.rec_sea.Time :=sr.Time;
        buffer.rec_sea.Size :=sr.Size ;
        buffer.rec_sea.Attr :=sr.Attr ;
        buffer.rec_sea.Name :=sr.Name ;
        buffer.rec_sea.ExcludeAttr :=sr.ExcludeAttr ;
        buffer.rec_sea.FindHandle :=sr.FindHandle ;
        buffer.rec_sea.FindData :=sr.FindData ;
        buffer.path:=sp; buffer.found:=found;
        RecFile.Writebuffer(buffer,sizeof(buffer));
        RecFile.Free;
    end;
  Application.ProcessMessages;
  sysutils.FindClose(sr);
end;

Данная статья не претендует на оригинальность и призвана помочь в разработке своих программ, если есть замечания, усовершенствования, пишите
Звягинцев Павел



Смотрите также материалы по темам:
[Древовидные структуры] [Файловая система] [Поиск файла]

 Обсуждение материала [ 10-07-2009 12:46 ] 9 сообщений
  
Время на сайте: GMT минус 5 часов

Если вы заметили орфографическую ошибку на этой странице, просто выделите ошибку мышью и нажмите Ctrl+Enter.
Функция может не работать в некоторых версиях броузеров.

Web hosting for this web site provided by DotNetPark (ASP.NET, SharePoint, MS SQL hosting)  
Software for IIS, Hyper-V, MS SQL. Tools for Windows server administrators. Server migration utilities  

 
© При использовании любых материалов «Королевства Delphi» необходимо указывать источник информации. Перепечатка авторских статей возможна только при согласии всех авторов и администрации сайта.
Все используемые на сайте торговые марки являются собственностью их производителей.

Яндекс цитирования