Системное программирование в UNIX средствами Free Pascal


         

При невозможности выполнения 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

Содержание  Назад  Вперед