При невозможности выполнения fstat, сообщаем
uses linux,stdio,strings;
const
FTW_NS =100; (* При ошибке stat(2) *)
FTW_DNR=200; (* При ошибке opendir(3) *)
FTW_F =300; (* Обычный файл *)
FTW_D =400; (* Каталог *)
MAXNAMLEN=4000;
(* Удобное сокращение *)
function EQ(a,b:pchar):boolean;
begin
EQ:=(strcomp(a, b) = 0);
end;
type
func=function(name:pchar; var status:tstat; _type:integer):integer;
function ftw(directory:pchar; funcptr:func; depth:integer):integer;
var
dp:pdir;
p,fullpath:pchar;
i:integer;
e:pdirent;
sb:tstat;
seekpoint:longint;
begin
(* При невозможности выполнения fstat, сообщаем пользователю об этом *)
if not fstat(directory, Sb) then
begin
ftw:=funcptr(directory, Sb, FTW_NS);
exit;
end;
(* Если не каталог, вызываем пользовательскую функцию. *)
if ((Sb.mode and STAT_IFMT) <> STAT_IFDIR) then
(* Сообщение "FTW_F" может быть некорректным (вдруг это символическая ссылка? *)
begin
ftw:=funcptr(directory, Sb, FTW_F);
exit;
end;
(* Открываем каталог; при невозможности - сообщаем пользователю. *)
Dp := opendir(directory);
if dp = nil then
begin
ftw:=funcptr(directory, Sb, FTW_DNR);
exit;
end;
(* Определяем, желает ли пользователь продолжать. *)
i := funcptr(directory, Sb, FTW_D);
if i <> 0 then
begin
closedir(Dp);
ftw:=i;
exit;
end;
(* Готовим место для хранения поного пути. *)
i := strlen(directory);
fullpath := stralloc(i + 1 + MAXNAMLEN + 1);
if fullpath = nil then
begin
closedir(Dp);
ftw:=-1;
exit;
end;
strcopy(fullpath, directory);
p := @fullpath[i];
if (i<>0) and (p[-1] <> '/') then
begin
p^:='/';
inc(p);
end;
(* Читаем все элементы каталога. *)
E := readdir(Dp);
while E <> nil do
begin
if not EQ(E^.name, '.') and not EQ(E^.name, '..') then
function func (name:pchar; var status:tstat; _type:integer):integer;
begin
(* Тело функции *)
end;
Целочисленный аргумент _type может принимать одно из нескольких возможных значений, описывающих тип встретившегося объекта. Вот эти значения:
|
FTW_F |
Объект является файлом |
|
FTW_D |
Объект является каталогом |
|
FTW_DNR |
Объект является каталогом, который нельзя прочесть |
|
FTW_SL |
Объект является символьной ссылкой |
|
FTW_NS |
Объект не является символьной ссылкой, и для него нельзя успешно выполнить вызов fstat |
Если объект является каталогом, который нельзя прочесть (_type = FTW_DNR), то его потомки не будут обрабатываться. Если нельзя успешно выполнить функцию fstat (_type = FTW_NS), то передаваемая для объекта структура tstat будет иметь неопределенные значения.
Работа вызова будет продолжаться до тех пор, пока не будет завершен обход дерева или не возникнет ошибка внутри функции ftw. Обход также закончится, если определенная пользователем функция возвратит ненулевое значение. Тогда функция ftw прекратит работу и вернет значение, возвращенное функций пользователя. Ошибки внутри функции ftw приведут к возврату значения -1, тогда в переменной linuxerror будет выставлен соответствующий код ошибки.
Следующий пример использует функцию ftw для обхода поддерева каталогов, выводящего имена всех встретившихся файлов (каталогов) и права доступа к ним. Каталоги и символьные ссылки при выводе будут обозначаться дополнительной звездочкой.
Сначала рассмотрим функцию list, которая будет передаваться в качестве аргумента функции ftw.
function list(name:pchar; var status:tstat; _type:integer):integer;
begin
(* Если вызов stat завершился неудачей, просто вернуться *)
if (_type = FTW_NS) then
begin
list:=0;
exit;
end;
(*
* Иначе, вывести имя объекта,
* права доступа к нему и постфикс "*",
* если объект является каталогом или символьной ссылкой.
*)
if (_type = FTW_F) then
printf ('%-30s'#9'0%3o'#$a, [name, status.mode and octal(0777)])
uses linux;
Function FNMatch(const Pattern, Name:string):Boolean;
Function FSearch(Path:pathstr; DirList:string):Pathstr;
Function Glob(Const Path:Pathstr):PGlob;
Procedure GlobFree(Var P:Pglob);
FNMatch возвращает True, если имя файла в Name совпадает с шаблоном в Pattern. Шаблон может содержать знаки *
(совпадение с нулем или более символов) или ?
(совпадение с одиночными символом).
FSearch ищет в DirList, списке каталогов, разделенных двоеточием, файл, указанный в Path, возвращаю путь к найденному файлу или пустую строку.
Glob возвращает указатель на структуру tglob, содержащую имена всех файлов, отвечающих шаблону в Path. Возвращает nil при ошибке, устанавливая LinuxError.
GlobFree освобождает память, занятую структурой tglob.
Например:
Uses linux;
Var G1,G2 : PGlob;
begin
G1:=Glob ('*');
if LinuxError=0 then
begin
G2:=G1;
Writeln ('Files in this directory : ');
While g2<>Nil do
begin
Writeln (g2^.name);
g2:=g2^.next;
end;
GlobFree (g1);
end;
end.
