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




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