Системное программирование в UNIX средствами Free Pascal
Описание
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
