В этой статье я
постараюсь познакомить Вас с некоторыми стандартными функциями для
работы с директориями. И еще приведу несколько пользовательских функций
и примеры их использования. Также рассмотрен вопрос вызова диалога
выбора директории.
Для начала начнем с
простой функции для создания новой папки. Общий вид функции такой:
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:\MyDir\Test\Dir1,
но при этом папок MyDir и Test на Вашем компьютере не существует.
Функция CreateDir здесь не сработает, поэтому воспользуемся процедурой
ForceDirectories. Ее общий вид таков:
procedure ForceDirectories(Dir: string);
Пример ее использования
(как всегда я поставил на форму новую кнопку, а там написал)
procedure TForm1.Button4Click(Sender: TObject);
var
Dir: string;
begin
Dir := 'C:\MyDir\Test\Dir1';
ForceDirectories(Dir);
end;
Ну и напоследок приведу функцию для проверки: существует ли директория
или нет. Ее общий вид такой:
function
DirectoryExists(Name: string): Boolean;
Если директория
указанная в параметре Name существует - то функция возвратит true.
Надеюсь, что помог Вам
описанием данных функций и процедур. Сразу хочется дать совет: почаще
заглядывайте в HELP, там много интересной и полезной информации!
Михаил Христосенко