Рекурсия
|t_| Доброго времени суток!
|go| Готов с вниманием внимать,
все то, что ты, zz сказать.
(переменная zz пока не определена).
|t_| Давай присвоим zz := 'хотел'.
Напомню, сегодня, наша тема - рекурсия.
|go| Я посмотрел, что говорит на эту тему википедия - что-то уж очень закручено... но вообще-то мы такое проходили... Фотография: мужик смотрит на фотографию на ней он же смотрит на туже фотографию, на ней...
|t_| Уже легче. Давай использовать облегченное определение. Рекурсия, это когда внутри процедуры (функции) есть вызов ее самой:
procedure МояПроцедура(параметры);
begin
...
что-то там делается
...
if условие потребности в рекурсии
then МояПроцедура(параметры);
...
и еще что ни будь сделаем
...
end;
Условие потребности в рекурсии, рано или поздно должно стать false иначе она станет бесконечной и программа зависнет. Возможен и такой вариант:
function МояФункция(параметры):boolean;
begin
...
что-то там делается
...
if МояФункция(параметры)
then exit;
...
result := условие выхода из рекурсии
...
end;
Конечно же, возможны сотни других вариантов...
Надеюсь, что не очень напряг тебя теорией, теперь к практике.
|go| Да нет, все нормально. Поехали.
:(
Yes no,
all OK.
Let's go.
:)
|t_| Сегодня у тебя поэтическое настроение, это хорошо...
Рекурсия очень хорошо подходит для обхода дерева, например дерева файловой системы.
Задача.
Написать программку удаляющую все пустые папки в заданной папке ( устройстве ).
(готовый исходник можно извлечь из этой книги, и имя его del_empty_dir.zip1 )
Давай сделаем простенькую форму с одной только кнопочкой.
При нажатии должен появляться диалог выбора папки, и после этого просмотрим все входящие папки и удалим пустые. Да еще, посчитаем удаленные и сообщим результат.
|go| Ну, что делаем новый проект в новой папке?
|t_| Да, как всегда.
На форме одну кнопочку, и вот обработчик ее клика и все остальное.
Давай, попробуй выполнить программку, создай пустую папку и попробуй ее удалить.
А потом обсудим.
// начало кода
{ 0 } var
{ 1 } Form1: TForm1;
{ 2 } Path : AnsiString; // путь к папке с программой
{ 3 } count : integer; // счетчик удалений
{ 4 }
{ 5 } implementation
{ 6 }
{ 7 } {$R *.dfm}
{ 8 }
{ 9 } function DelEmtyDir(Target : AnsiString):boolean;
{ 10 } var
{ 11 } Found : integer; // результат поиска ( 0 - файл найден )
{ 12 } SR : TSearchRec; // запись с параметрами файла
{ 13 } begin
{ 14 } Found := FindFirst(Target + '*.*',$3F,SR);
{ 15 } result := true; // предположим что папка пуста.
{ 16 } WHILE Found = 0 DO
{ 17 } BEGIN
{ 18 } if (SR.Name <> '.')
{ 19 } and (SR.Name <> '..')
{ 20 } then
{ 21 } begin
{ 22 } // если это папка
{ 23 } if ((SR.Attr and $10) = $10 ) then
{ 24 } begin // рекурсивный вызов функции
{ 25 } if DelEmtyDir( Target+''+ SR.Name)
{ 26 } then
{ 27 } begin // удаление пустой папки
{ 28 } RmDir(Target+''+ SR.Name);
{ 29 } inc(count); // + 1 в счетчик
{ 30 } end;
{ 31 } end
{ 32 } else
{ 33 } begin // найден какой то файл
{ 34 } result := false; // значит папка не пуста.
{ 35 } FindClose(SR);
{ 36 } exit;
{ 37 } end;
{ 38 } end;
{ 39 } Found := FindNext(SR);
{ 40 } END;{DosError = 0}
{ 41 } FindClose(SR);
{ 42 } end;
{ 43 }
{ 44 } procedure TForm1.Button1Click(Sender: TObject);
{ 45 } var
{ 46 } Dir : AnsiString;
{ 47 } begin
{ 48 } Dir := Path; count := 0;
{ 49 } if SelectDirectory(Dir, [sdAllowCreate, sdPerformCreate, sdPrompt],0)
{ 50 } then
{ 51 } begin
{ 52 } if Dir[length(Dir)]=''
{ 53 } then delete(Dir, length(Dir),1);
{ 54 } DelEmtyDir(Dir);
{ 55 } ShowMessage('Deleted ' + IntToStr(count) +' folders.');
{ 56 } end;
{ 57 } end;
{ 58 }
{ 59 } procedure TForm1.FormCreate(Sender: TObject);
{ 60 } begin
{ 61 } Path := ExtractFileDir(ParamStr(0)) + '';
{ 62 } end;
// конец кода
|go| Не работает. Delphi не знает кто такое SelectDirectory.
|t_| Ничего, потихоньку научишься работать, поставь курсор на слово - ошибку и нажми F1.
|go| Получил help. Ну и что дальше.
|t_| В help найди к какому unit относился функция SelectDirectory и вставь это название в uses своей программы. Так поступай и в дальнейшем, больше старайся использовать help и умеренно, советы из интернета, к сожалению в этой "всемирной свалке" надо хорошо покопаться чтобы найти алмазы, а по пути можно и замазаться...
|go| Как сказал кот Матроскин - "Заработало!!!"
|t_| Хорошо, ну а теперь найди в программе ошибку. Подсказка, тоже цитата "Хотели как лучше, а получилось... "
|go| Нашел, каждый раз при нажатии кнопки выбор папки начинается из папки программы, а это неудобно.
|t_| Ну, ты даешь! Нашел не запланированную мною ошибку. Ты совершенно прав. Давай исправлять.
{ 46 } Dir : AnsiString; - определение переменной сделай глобальным
{ 0 } var
{ 1 } Form1: TForm1;
Dir : AnsiString;
{ 2 } Path : AnsiString; // путь к папке с программой
а строчку 46 удали
теперь:
{ 48 } Dir := Path; - это присваивание отсюда забери и вставь в:
{ 61 } Path := ExtractFileDir(ParamStr(0)) + '';
Dir := Path;
{ 62 } end;
Ну, а теперь, ищи дальше.
|go| Не понял смысла в строках
{ 52 } if Dir[length(Dir)]=''
{ 53 } then delete(Dir, length(Dir),1);
Dir и так возвращается без конечного слеша.
|t_| Не совсем так. Если ты будешь искать в корневом каталоге, то там будет слеш (например: с: ). Ищи дальше.
|go| Наверно это строки
{ 33 } begin // найден какой то файл
{ 34 } result := false; // значит папка не пуста.
{ 35 } FindClose(SR);
{ 36 } exit;
{ 37 } end;
не знаю в чем ошибка, хотя бы потому, что я не понимаю их смысла.
|t_| Да, это ошибка и есть. Подразумевалось такое рассуждение: если в папки найден какой то файл, значит папка не пуста, а значит и искать дальше нечего, и давай сэкономим время.
Это бы работало правильно, если бы вложенные папки были бы гарантированно просмотрены первыми... Удали строки 35, 36.
|go| Слушай, что то странное. Удаляю из одной папки, пишет "Удалено 8 папок", опять удаляю оттуда, опять пишет "Удалено 8 папок", третий раз удаляю, опять тоже самое.
|t_| Интересно. Поставь курсор на 28 строку и нажми F4. Посмотри содержимое Target и SR.Name в момент удаления папки.
|go| Не понял, как посмотреть?
|t_| Знаешь, мне не хочется отвлекаться на описание возможностей Delphi по отладке программ, информацию об этом найдешь в любом учебнике, поэтому пока простейшее, в режиме отладки, наведи курсор мыши на нужную переменную и через пару секунд всплывет ее значение в этот момент ( есть и более удобные способы - читай учебники ).
Возвращаемся к нашей программе. Посмотри содержимое указанных переменных и проверь, что есть в этих папках.
|go| В этих папках есть другие папки, т.е. они не пустые.
|t_| Минуточку, сам попробую.
Через 6 минут.
|t_| Все, разобрался. Достаточно грубая ошибка. У нас result := false - признак не пустой папки вырабатывался только при нахождении файла, а при нахождении папки функция все равно оставалась истинной. Функция RmDir пыталась удалить папку, но т.к. она не пуста ей это не удавалось, а результат удаления мы не анализируем. Вот и имеем, что имеем.
Давай переделаем этот фрагмент.
Кстати, надо учитывать, что папку функции RmDir может не удастся удалить т.к. у нее будет стоять атрибут Только чтение. Можно конечно снять этот атрибут программным путем, но давай сделаем проще и безопаснее, программа будет сообщать о невозможности удаления.
{ 21 } begin
{ 34 } result := false; // значит папка не пуста.
{ 22 } // если это папка
{ 23 } if ((SR.Attr and $10) = $10 ) then
{ 24 } begin // рекурсивный вызов функции
{ 25 } if DelEmtyDir( Target+''+ SR.Name)
{ 26 } then
{ 27 } begin // удаление пустой папки
{ 28 } RmDir(Target+''+ SR.Name);
if IOResult = 0
{ 29 } then inc(count) // + 1 в счетчик
else ShowMessage('Не могу удалить папку '+Target+''+ SR.Name);
{ 30 } end;
{ 31 } end;
{ 38 } end;
|go| Все. Теперь работает. Претензий нет.
|t_| Да? А мне вот, не нравится. Программа удаляет с компьютера, что-то не спросив разрешения, а может эта папка и пустая необходима.
Давай переделаем программу.
Вместо одной кнопки - две: Сканирование и Удаление.
И CheckListBox для хранения найденных пустых папок.
|go| Как опять все сначала?
|t_| Ну, не совсем сначала. Кстати вот один из критериев оценки качества программы - легкость ее модификации...
Вот, что у меня получилось:
// начало кода
{ 0 } unit Unit1;
{ 1 }
{ 2 } interface
{ 3 }
{ 4 } uses
{ 5 } Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
{ 6 } Dialogs, StdCtrls, FileCtrl, CheckLst, ExtCtrls;
{ 7 }
{ 8 } type
{ 9 } TForm1 = class(TForm)
{ 10 } Panel1: TPanel;
{ 11 } Button1: TButton;
{ 12 } Button2: TButton;
{ 13 } CheckListBox1: TCheckListBox;
{ 14 } Label1: TLabel;
{ 15 } procedure Button1Click(Sender: TObject);
{ 16 } procedure FormCreate(Sender: TObject);
{ 17 } procedure Button2Click(Sender: TObject);
{ 18 } private
{ 19 } { Private declarations }
{ 20 } public
{ 21 } { Public declarations }
