В этой статье я постараюсь познакомить Вас с некоторыми стандартными
функциями для работы с директориями. И еще приведу несколько пользовательских
функций и примеры их использования. Также рассмотрен вопрос вызова диалога
выбора директории.
Для начала начнем с простой функции для создания новой папки. Общий вид
функции такой:
function CreateDir(const Dir: string): Boolean;
То есть если папка успешно создана функция возвращает true. Сразу же простой
пример ее использования:
procedure TForm1.Button1Click(Sender: TObject);
begin
if createdir('c:TestDir') = true then
showmessage('Директория успешно создана')
else
showmessage('При создании директории произошла ошибка');
end;
При нажатии на кнопку программа пытается создать папку с именем TestDir на
диске C: и если попытка увенчалась успехом, то выводится соответствующее
сообщение. Следует отметить, что если вы не указываете имя диска, на котором
хотите создавать папку, то функция будет создавать папку в той же директории,
где находится сама программа.
Объявления:
createdir(edit1.text);
и
createdir(extractfilepath(paramstr(0)) + edit1.text);
приведут к одному и тому же результату.
Теперь рассмотрим функцию для удаления папок. Ее объявление выглядит так:
function RemoveDir(const Dir: string): Boolean;
Сразу же хочу предупредить, что данная функция способна удалять только пустые
папки, и если там что-нибудь будет, то произойдет ошибка! Но выход есть!!! Здесь
нам на помощь придет пользовательская функция с простым названием MyRemoveDir.
Вот описание функции:
function MyRemoveDir(sDir: string): Boolean;
var
iIndex: Integer;
SearchRec: TSearchRec;
sFileName: string;
begin
Result := False;
sDir := sDir + '*.*';
iIndex := FindFirst(sDir, faAnyFile, SearchRec);
while iIndex = 0 do
begin
sFileName := ExtractFileDir(sDir)+''+SearchRec.name;
if SearchRec.Attr = faDirectory then
begin
if (SearchRec.name <> '' ) and
(SearchRec.name <> '.') and
(SearchRec.name <> '..') then
MyRemoveDir(sFileName);
end
else
begin
if SearchRec.Attr <> faArchive then
FileSetAttr(sFileName, faArchive);
if not DeleteFile(sFileName) then
ShowMessage('Could NOT delete ' + sFileName);
end;
iIndex := FindNext(SearchRec);
end;
FindClose(SearchRec);
RemoveDir(ExtractFileDir(sDir));
Result := True;
end;
Копируете это все в Вашу программу, а затем эту функцию можно вызвать
например так:
if not MyRemoveDir('C:TestDir') then
ShowMessage('Не могу удалить эту директорию');
Теперь маленько отстранимся от непосредственной работы с папками и рассмотрим
волнующий многих вопрос. Как вызвать диалог выбора папки (как при установке
программ)?? ПРОСТО!!!
Подключаем в uses модуль Filectrl.pas (то есть uses FileCtrl;). Теперь ставим
на форму еще кнопочку (чтобы не путаться :) и пишем такой код:
procedure TForm1.Button3Click(Sender: TObject);
const
SELDIRHELP = 1000;
var
Dir: string;
begin
Dir := 'C:windows';
if SelectDirectory(Dir, [sdAllowCreate, sdPerformCreate, sdPrompt],SELDIRHELP) then
Caption := Dir;
end;
При выборе директории в заголовке формы отобразиться ее название!
Теперь рассмотрим следующую процедуру. К примеру Вам надо создать папку Dir1
по адресу: C:MyDirTestDir1, но при этом папок MyDir и Test на Вашем
компьютере не существует. Функция CreateDir здесь не сработает, поэтому
воспользуемся процедурой ForceDirectories. Ее общий вид таков:
procedure ForceDirectories(Dir: string);
Пример ее использования (как всегда я поставил на форму новую кнопку, а там
написал)
procedure TForm1.Button4Click(Sender: TObject);
var
Dir: string;
begin
Dir := 'C:MyDirTestDir1';
ForceDirectories(Dir);
end;
Ну и напоследок приведу функцию для проверки: существует ли директория или
нет. Ее общий вид такой:
function DirectoryExists(name: string): Boolean;
Если директория указанная в параметре Name существует - то функция возвратит
true.
Надеюсь, что помог Вам описанием данных функций и процедур. Сразу хочется
дать совет: почаще заглядывайте в HELP, там много интересной и полезной
информации!
http://mihandelphi.narod.ru
|