Delphi - сбориник статей


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


Паша Звягинцев,

Программист,
просыпаясь утром с сильнейшего похмелья,
начинает с тестирования памяти...

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




Начало