Ñèñòåìíîå ïðîãðàììèðîâàíèå â UNIX ñðåäñòâàìè Free Pascal

       

Êàòàëîãè


Óïðàæíåíèå 13.28. Íàïèøèòå àíàëîã êîìàíäû ls -l.

uses linux,strings,sysutils; (*äëÿ ñèñòåìíûõ âûçîâîâ Linux è ðàáîòû ñî ñòðîêàìè PChar*)

function ctime(var time_t:longint):pchar;cdecl;external 'c';

function gettype(t:word):char;forward; (*òèï îáúåêòà ô.ñ. â ôîðìàòå êîìàíäû ls*)

(*òèï îáúåêòà ô.ñ. â ôîðìàòå êîìàíäû ls*)

function gettype(t:word):char;

begin

  if S_ISDIR(t) then            (*ïðîâåðêà íà êàòàëîã*)

    gettype:='d'

  else

    if S_ISREG(t) then          (*ïðîâåðêà íà îáû÷íûé ôàéë*)

      gettype:='-'

    else



      if S_ISBLK(t) then        (*ïðîâåðêà íà áëî÷íîå óñòðîéñòâî*)

        gettype:='b'

      else

        if S_ISCHR(t) then      (*ïðîâåðêà íà ñèìâîëüíîå óñòðîéñòâî*)

          gettype:='c'

        else

          if S_ISFIFO(t) then (*ïðîâåðêà íà èìåíîâàííûé ïðîãðàììíûé êàíàë*)

            gettype:='p'

          else

            if S_ISLNK(t) then  (*ïðîâåðêà íà ñèâîëè÷åñêóþ ññûëêó*)

              gettype:='l'

         else

           gettype:='?';

end;

function getrights(r:word):string;

var

  u,           (*ïðàâà äëÿ âëàäåëüöà*)

  g,           (*ïðàâà äëÿ ãðóïïû*)

  o,           (*ïðàâà äëÿ âñåõ îñòàëüíûõ*)

  s,           (*ñïåöèàëüíûå ïðàâà*)

  i:integer;

  res:string;  (*ïðàâà â ñèìâîëüíîé ôîðìå*)

const

  o7777=(1 shl 12)-1; (*âîñüìåðè÷íàÿ êîíñòàíòà = âñå 12 áèò ïðàâ çàäàíû *)

  o10  =8;            (*010  *)

  o100 =64;           (*0100 *)

  o1000=512;          (*01000*)

  symrights:array [0..7] of string=( (*áàçîâûå êîìáèíàöèè ïðàâ â ñèìâîëüíîé ôîðìå*)

       '---', (*0 = 000*)

       '--x', (*1 = 001*)

       '-w-', (*2 = 010*)

       '-wx', (*3 = 011*)

       'r--', (*4 = 100*)

       'r-x', (*5 = 101*)

       'rw-', (*6 = 110*)

       'rwx'  (*7 = 111*)

     );

  spec='tss';          (*ìàññèâ ñïåöèàëüíûõ ïðàâ äîñòóïà*)

begin

  (*îáðåçàåì ñòàðøèå áèòû, íå îòíîñÿùèåñÿ ê ïðàâàì äîñòóïà (òèï ôàéëà è ò.ï.)*)

  r:=r and o7777;(*âîñüìåðè÷íàÿ êîíñòàíòà 10000-1==1*8^4-1==1*(2^3)^4-1==2^12-1 *)




  (* âûäåëÿåì ÷èñëîâûå ïðàâà äëÿ âëàäåëüöà, ãðóïïû, îñòàëüíûõ + ñïåöèàëüíûå*)

  o:=r mod o10; 

  s:=r div o1000;

  u:=(r div o100) mod o10;

  g:=(r mod o100) div o10;

  res:=symrights[u]+symrights[g]+symrights[o];(*ôîðìèðóåì ñèìâîëüûíå ïðàâà èç áàçîâûõ òðîåê*)

 

  for i:=1 to 3 do   (*öèêë ïðîâåðêè íàëè÷èÿ ÷ïåöèàëüíûõ ïðàâ*)

    if s and (1 shl (i-1)) <> 0 then (*åñëè ïðàâî óñòàíîâëåíî*)

      if res[12-3*i]='x' then  (*åñëè åñòü îáû÷íîå ïðàâî íà âûïîëíåíèå*)

        res[12-3*i]:=spec[i]   (*çàíîñèì ìàëåíüêóþ áóêâó*)

      else

        res[12-3*i]:=upcase(spec[i]); (*èíà÷å - áîëüøóþ*)

     

  getrights:=res; (*âîçâðàùàåì ðåçóëüòàò - 9-ñèìâîëüíîå ïðåäñòàâëåíèå 12-áèòíûõ ïðàâ*)

end;

var

  d:^TDir;              (*óêàçàòåëü íà çàïèñü äëÿ ðàáîòû ñ êàòàëîãîì*)

  elem:^Dirent;  (*óêàçàòåëü íà çàïèñü, õðàíÿùóþ îäèí ýëåêìåíò êàòàëîãà*)

  tekkat,                         (*ñòðîêà äëÿ õðàíåíèÿ èìåíè êàòàëîãà*)

  fullpath                        (*ïîëíûé ïóòü ê ýëåìåíòó êàòàëîãà*)

          :array [0..1000] of char;

  st:stat;          (*äëÿ õðàíåíèÿ èíôîðìàöèè î ôàéëå èëè êàòàëîãå*)

begin

  if paramcount=0 then      (*åñëè â êîìàíäíîé ñòðîêå íå óêàçàí êàòàëîã*)

    strcopy(tekkat,'.')     (*òî â êà÷åñòâå êàòàëîãà èñïîëüçóåì òåêóùèé*)

  else

    tekkat:=paramstr(1); (*èíà÷å èñïîëüçóåì êàòàëîã èç êîìàíäíîé ñòðîêè*)

  if not access(pchar(tekkat),F_OK or R_OK) then  (*F_OK - ïðîâåðêà ñóùåñòîâàíèÿ îáúåêòà ô.ñ.*)

  begin

    writeln('Êàòàëîã ', tekkat, ' íå ñóùåñòâóåò èëè íåäîñòóïåí äëÿ ÷òåíèÿ');  (*äèàãíîñòèêà*)

    halt(1);                     (*âîçâðàò â ïðåäûäóùóþ ïðîãðàììó*)

  end;

  if not fstat(pchar(tekkat),st) then    (*ïîïûòêà ïîëó÷åíèÿ èíôîðìàöèè î ôàéëå èëè êàòàëîãå*)

  begin

    writeln('Îøèáêà ïîëó÷åíèÿ èíôîðìàöèè î êàòàëîãå ', tekkat);  (*äèàãíîñòèêà*)

    halt(1);                     (*âîçâðàò â ïðåäûäóùóþ ïðîãðàììó*)

  end;

  if not S_ISDIR(st.mode) then    (*ïðîâåðêà íà êàòàëîã*)



  begin

    writeln(tekkat, ' - íå êàòàëîã');  (*äèàãíîñòèêà*)

    halt(1);                       (*âîçâðàò â ïðåäûäóùóþ ïðîãðàììó*)

  end;

  d:=opendir(tekkat);           (*ïîïûòêà îòêðûòèÿ êàòàëîãà äëÿ ÷òåíèÿ*)

 

  if d=nil then                   (*åñëè ïîïûòêà íå óäàëàñü*)

  begin

    writeln(' Îøèáêà âûçîâà opendir äëÿ êàòàëîãà ', tekkat);  (*äèàãíîñòèêà*)

    halt(1);                       (*âîçâðàò â ïðåäûäóùóþ ïðîãðàììó*)

  end;

 

  elem:=readdir(d);               (*ïîïûòêà ÷òåíèÿ ýëåìåíòà êàòàëîãà*)

  while elem<>nil do

  begin

    (*ôîðìèðîâàíèå ïîëíîãî èìåíè ýëåìåíòà êàòàëîãà*)

    strcopy(fullpath,tekkat);     (*êîïèðóåì èìÿ òåêóùåãî êàòàëîãà â íà÷àëî ïîëíîãî èìåíè*) 

    if strcomp(tekkat,'/')<>0 then(*åñëè òåêóùèé êàòàëîã - íå êîðíåâîé*)

    begin

      if fullpath[strlen(fullpath)-1]='/' then (*åñëè â êîíöå èìåíè êàòàëîãà ñëýø*)

        fullpath[strlen(fullpath)-1]:=#0;      (*çàìåíÿåì åãî ïðèçíàêîì êîíöà ñòðîêè*)

      strcat(fullpath,'/');       (*äîáàâëÿåì ïîñëå èìåíè êàòàëîãà ñëýø-ðàçäåëèòåëü*)

    end;

    strcat(fullpath,elem^.name);  (*è èìÿ ýëåìåíòà êàòàëîãà*)

   

    if not fstat(pchar(fullpath),st) then    (*ïîïûòêà ïîëó÷åíèÿ èíôîðìàöèè î ôàéëå èëè êàòàëîãå*)

    begin

      writeln('Îøèáêà ïîëó÷åíèÿ èíôîðìàöèè î ', fullpath);  (*äèàãíîñòèêà*)

      continue;                 (*âîçâðàò â ïðåäûäóùóþ ïðîãðàììó*)

    end;

    {gmtime_r(st.mtime,mytm);}

    writeln(gettype(st.mode),getrights(st.mode),st.nlink:5,

     '  ',st.size:10,' ',ctime(st.mtime), elem^.name);  (*âûâîä èìåíè ýëåìåíòà êàòàëîãà*)

    elem:=readdir(d);               (*ïîïûòêà ÷òåíèÿ ýëåìåíòà êàòàëîãà*)

  end;

 

  closedir(d);                    (*çàêðûòèå îòêðûòîãî opendir êàòàëîãà*)

end.

Óïðàæíåíèå 13.29. Ñîñòàâüòå àíàëîã êîìàíäû vdir.

uses linux,strings,sysutils;

function getname(uid:integer):string;

const w='/etc/passwd';

var ts,nam1,namb1:string;

    tx:text;

begin

  assign(tx,w);

  reset(tx);



  while not EOF (tx) do

  begin

       readln(tx,ts);

       uid:=pos(':',ts);

       nam1:=copy(ts,1,uid-1);

       delete(ts,1,uid);

       uid:=pos(':',ts);

       delete(ts,1,uid);

       namb1:=copy(ts,1,uid-1);

       if namb1='500' then

       write(nam1) 

  end;

  close(tx);     

  getname:=nam1;

end;

function getgroup(gid:integer):string;

const q='/etc/group';

var ts,nam,namb:string;

    t:text;

begin

  assign(t,q);

  reset(t);

  while not EOF (t) do

  begin

       readln(t,ts);

       gid:=pos(':',ts);

       nam:=copy(ts,1,gid-1);

       delete(ts,1,gid);

       gid:=pos(':',ts);

       delete(ts,1,gid);

       namb:=copy(ts,1,gid-1);

       if namb='500' then

       write(nam);

  end;

  close(t);     

  getgroup:=nam;

end;

function gettype(mode:integer):char;

begin

  if S_ISREG(mode) then

    gettype:='-'

  else

    if S_ISDIR(mode) then

      gettype:='d'

    else

      if S_ISCHR(mode) then

        gettype:='c'

      else

        if S_ISBLK(mode) then

          gettype:='b'

        else

          if S_ISFIFO(mode) then

            gettype:='p'

          else

            gettype:='l';

end;

function getrights(mode:integer):string;

const

  sympr:array [0..7] of string=(

                                 '---', {0}

                                 '--x', {1}

                                 '-w-', {2}

                                 '-wx', {3}

                                 'r--', {4}

                                 'r-x', {5}

                                 'rw-', {6}

                                 'rwx'  {7}

                               );

  specsympr:array [0..7] of string=(

                                 '---', {0}

                                 '--t', {1}

                                 '-s-', {2}

                                 '-st', {3}

                                 's--', {4}

                                 's-t', {5}

                                 'ss-', {6}



                                 'sst'  {7}

                               );

var

  s,u,g,o,i:integer;

  res:string;

begin

  mode:=mode and octal(7777);

  u:=(mode div octal(100)) mod octal(10);

  g:=(mode mod octal(100)) div octal(10);

  o:=mode mod octal(10);

  s:=mode div octal(1000);

  res:=sympr[u]+sympr[g]+sympr[o];

  for i:=1 to 3 do

    if specsympr[s][i]<>'-' then

    begin

      if res[3*i]='-' then

        res[3*i]:=upcase(specsympr[s][i])

      else

        res[3*i]:=specsympr[s][i];

    end;

  getrights:=res;

end;

var

  d:PDIR;

  el:pdirent;

  st:stat;

  res:integer;

  dt:tdatetime;

  polniypath,name:array [0..2000] of char;

begin

  if paramcount = 0 then

    name:='.'

  else

    name:=paramstr(1);

  d:=opendir(name);

  if d=nil then

  begin

    writeln('Îøèáêà îòêðûòèÿ òåêóùåãî êàòàëîãà');

    halt(0);

  end;

  el:=readdir(d);

  while el<>nil do

  begin

    polniypath:=name;

    if strcomp(name,'/')=0 then

      strcat(polniypath,el^.name)

    else

    begin

      if name[strlen(name)-1]<>'/' then

     strcat(polniypath,'/');

      strcat(polniypath,el^.name);

    end;

    if not fstat(pchar(polniypath),st) then

      writeln('Îøèáêà âûçîâà stat äëÿ ',polniypath)

    else

    begin

      {writeln(polniypath,' ',s.size);}

      dt:=filedatetodatetime(st.mtime);

      write(gettype(st.mode),getrights(st.mode),st.nlink:5,

            getname(st.uid),'  ',getgroup(st.gid),st.size:10,'  ',datetimetostr(dt),'  ' );

      writeln(el^.name);

    end;

    el:=readdir(d);

  end;

  closedir(d);

end.

 

Óïðàæíåíèå 13.30. Íàïèøèòå óïðîùåííûé àíàëîã êîìàíäû ls, ðàñïå÷àòûâàþùèé ñîäåðæèìîå òåêóùåãî êàòàëîãà (ôàéëà ñ èìåíåì ".") áåç ñîðòèðîâêè èìåí ïî àëôàâèòó. Ïðåäóñìîòðèòå ÷òåíèå êàòàëîãà, ÷üå èìÿ çàäàåòñÿ êàê àðãóìåíò ïðîãðàììû. Èìåíà "." è ".." íå âûäàâàòü.

uses linux,strings,sysutils,crt;

{$linklib c}



type

  plong=^longint;

function ctime(r:plong):pchar;cdecl;external;

function strchr(s:string;c:char):boolean;

var

  i:integer;

begin

  for i:=1 to length(s) do

    if s[i]=c then

    begin

      strchr:=true;

      exit;

    end;

  strchr:=false;

end;

function getall(w:string;uid:integer):string;

{const w='/etc/passwd';}

var ts,nam1,namb1:string;

    tx:text;

    d:integer;

begin

  assign(tx,w);

  reset(tx);

  while not EOF (tx) do

  begin

       readln(tx,ts);

       d:=pos(':',ts);

       nam1:=copy(ts,1,d-1);

       delete(ts,1,d+2);

       d:=pos(':',ts);

       {delete(ts,1,d);}

       namb1:=copy(ts,1,d-1);

       val(namb1,d);

       {writeln('èìÿ = ',nam1,', íîìåð=',namb1);}

       if d=uid then

         break;

  end;

  close(tx);     

  getall:=nam1;

end;

function getname(uid:integer):string;

begin

  getname:=getall('/etc/passwd',uid);

end;

function getgroup(gid:integer):string;

begin

  getgroup:=getall('/etc/group',gid);

end;

function gettype(mode:integer):char;

begin

  if S_ISREG(mode) then

    gettype:='-'

  else

    if S_ISDIR(mode) then

      gettype:='d'

    else

      if S_ISCHR(mode) then

        gettype:='c'

      else

        if S_ISBLK(mode) then

          gettype:='b'

        else

          if S_ISFIFO(mode) then

            gettype:='p'

          else

            gettype:='l';

end;

function getrights(mode:integer):string;

const

  sympr:array [0..7] of string=(

                                 '---', {0}

                                 '--x', {1}

                                 '-w-', {2}

                                 '-wx', {3}

                                 'r--', {4}

                                 'r-x', {5}

                                 'rw-', {6}

                                 'rwx'  {7}

                               );

  specsympr:array [0..7] of string=(



                                 '---', {0}

                                 '--t', {1}

                                 '-s-', {2}

                                 '-st', {3}

                                 's--', {4}

                                 's-t', {5}

                                 'ss-', {6}

                                 'sst'  {7}

                               );

var

  s,u,g,o,i:integer;

  res:string;

begin

  mode:=mode and octal(7777);

  u:=(mode div octal(100)) mod octal(10);

  g:=(mode mod octal(100)) div octal(10);

  o:=mode mod octal(10);

  s:=mode div octal(1000);

  res:=sympr[u]+sympr[g]+sympr[o];

  for i:=1 to 3 do

    if specsympr[s][i]<>'-' then

    begin

      if res[3*i]='-' then

        res[3*i]:=upcase(specsympr[s][i])

      else

        res[3*i]:=specsympr[s][i];

    end;

  getrights:=res;

end;

procedure obhod(name:pchar);

var

  d:PDIR;

  el:pdirent;

  st:stat;

  res:integer;

  dt:tdatetime;

  polniypath,datetime:array [0..2000] of char;

  i,k:integer;

begin

  d:=opendir(name);

  if d=nil then

  begin

    writeln('Îøèáêà îòêðûòèÿ êàòàëîãà ',name);

    exit;

  end;

  i:=0;

  el:=readdir(d);

  while el<>nil do

  begin

    polniypath:=name;

    if strcomp(name,'/')=0 then

      strcat(polniypath,el^.name)

    else

    begin

      if name[strlen(name)-1]<>'/' then

     strcat(polniypath,'/');

      strcat(polniypath,el^.name);

    end;

    if not fstat(pchar(polniypath),st) then

      writeln(' Îøèáêà âûçîâà stat äëÿ ',polniypath)

    else

    begin

      (*

      strcopy(datetime,ctime(@st.mtime)+4);

      datetime[12]:=#0;

      write(gettype(st.mode),getrights(st.mode),st.nlink:5,' ',

            getname(st.uid):10,' ',getgroup(st.gid):10,' ',st.size:10,'  ',datetime,'  ' );

      *)

      if(gettype(st.mode)='d') then

        textcolor(9);

      if(gettype(st.mode)='-') and strchr(getrights(st.mode),'x') then

        textcolor(lightgreen);



      if(gettype(st.mode)='p') then

        textcolor(brown);

      if(gettype(st.mode)='l') then

        textcolor(lightblue);

      if (gettype(st.mode)='c') or (gettype(st.mode)='b') then

        textcolor(yellow);

      write(el^.name);

      for k:=strlen(el^.name) to 15  do

        write(' ');

      textcolor(7);

    end;

    el:=readdir(d);

    inc(i);

    if(i mod 5=0)then writeln;

  end;

 

  closedir(d);

  if(i mod 5<>0)then writeln;

end;

var

  name:array [0..2000] of char;

begin

  if paramcount = 0 then

    name:='.'

  else

    name:=paramstr(1);

   

  obhod(name);

end.

 

Óïðàæíåíèå 13.31. Íàïèøèòå ïðîãðàììó óäàëåíèÿ ôàéëîâ è êàòàëîãîâ, çàäàííûõ â êîìàíäíîé ñòðîêå. Ïðîãðàììà äîëæíà óäàëÿòü êàòàëîãè ðåêóðñèâíî è îòêàçûâàòüñÿ óäàëÿòü ôàéëû óñòðîéñòâ.

uses linux,strings,sysutils,crt;

{$linklib c}

type

  plong=^longint;

function gettype(mode:integer):char;

begin

  if S_ISREG(mode) then

    gettype:='-'

  else

    if S_ISDIR(mode) then

      gettype:='d'

    else

      if S_ISCHR(mode) then

        gettype:='c'

      else

        if S_ISBLK(mode) then

          gettype:='b'

        else

          if S_ISFIFO(mode) then

            gettype:='p'

          else

            gettype:='l';

end;

function obhod(name:pchar):boolean;

var

  flag:boolean;

  d:PDIR;

  el:pdirent;

  st:stat;

  res:integer;

  polniypath:array [0..2000] of char;

begin

  flag:=true;

  d:=opendir(name);

  if d=nil then

  begin

    writeln('Îøèáêà îòêðûòèÿ êàòàëîãà ',name);

    exit;

  end;

  el:=readdir(d);

  while el<>nil do

  begin

    polniypath:=name;

    if strcomp(name,'/')=0 then

      strcat(polniypath,el^.name)

    else

    begin

      if name[strlen(name)-1]<>'/' then

        strcat(polniypath,'/');

      strcat(polniypath,el^.name);

    end;

    if not fstat(pchar(polniypath),st) then

      writeln('Îøèáêà âûçîâà stat äëÿ ',polniypath)



    else

    begin

      if not (gettype(st.mode) in ['b','c','d']) then

      begin

        writeln('Ñòèðàþ ôàéë ',polniypath);     

        //unlink(polniypath);

        if not unlink(polniypath) then

        begin

          writeln('íåâîçìîæíî ñòåðåòü ôàéë ',polniypath);

          flag:=false;(*îøèáêà óäàëåíèÿ ôàéëà - íåëüçÿ áóäåò ñòåðåòü êàòàëîã*)

        end;

      end;

    end;

    el:=readdir(d);

  end;

  closedir(d);

 

  d:=opendir(name);

  el:=readdir(d);

  while el<>nil do

  begin

    polniypath:=name;

    if strcomp(name,'/')=0 then

      strcat(polniypath,el^.name)

    else

    begin

      if name[strlen(name)-1]<>'/' then

        strcat(polniypath,'/');

      strcat(polniypath,el^.name);

    end;

    if not fstat(pchar(polniypath),st) then

      writeln('Îøèáêà âûçîâà stat äëÿ ',polniypath)

    else

    begin

      if (gettype(st.mode)='d') and

         (strcomp(el^.name,'.')<>0) and

         (strcomp(el^.name,'..')<>0) then

      begin

        writeln('Ïåðåõîä â êàòàëîã ',polniypath);     

        if not obhod(polniypath) then

          flag:=false;

      end;

    end;

    el:=readdir(d);

  end;

  closedir(d);

  if not flag then

    writeln('Êàòàëîã ',name,

    ' íå áóäåò ñòåðò, ò.ê. â íåì íå óäàëîñü ñòåðåòü ÷àñòü ôàéëîâ èëè êàòàëîãîâ')

  else

  begin

    {$i-}

    rmdir(name);

    if ioresult <> 0 then

    begin

      writeln('Îøèáêà óäàëåíèÿ êàòàëîãà ',name);

      flag:=false;

    end;

  end;

  writeln('Äëÿ êàòàëîãà ',name, ' ïîëó÷åí ',flag);

  obhod:=flag;

end;

var

  name:array [0..2000] of char;

begin

  if paramcount<>0 then

  begin

    name:=paramstr(1);

    obhod(name);

  end

  else

    writeln('Ñ îñîáîé îñòîðîæíîñòüþ èñïîëüçóéòå: ',paramstr(0),' óäàëÿåìûé êàòàëîã');

end.

 

Óïðàæíåíèå 13.32. Íàïèøèòå ôóíêöèþ ðåêóðñèâíîãî îáõîäà äåðåâà ïîäêàòàëîãîâ è ïå÷àòè èìåí âñåõ ôàéëîâ â íåì ñ âûäà÷åé àòðèáóòîâ â ôîðìå êîìàíäû ls -l.



uses linux,strings,sysutils;

{$linklib c}

type

  plong=^longint;

function ctime(r:plong):pchar;cdecl;external;

function getall(w:string;uid:integer):string;

{const w='/etc/passwd';}

var ts,nam1,namb1:string;

    tx:text;

    d:integer;

begin

  assign(tx,w);

  reset(tx);

  while not EOF (tx) do

  begin

       readln(tx,ts);

       d:=pos(':',ts);

       nam1:=copy(ts,1,d-1);

       delete(ts,1,d+2);

       d:=pos(':',ts);

       {delete(ts,1,d);}

       namb1:=copy(ts,1,d-1);

       val(namb1,d);

       {writeln('èìÿ = ',nam1,', íîìåð=',namb1);}

       if d=uid then

         break;

  end;

  close(tx);     

  getall:=nam1;

end;

function getname(uid:integer):string;

begin

  getname:=getall('/etc/passwd',uid);

end;

function getgroup(gid:integer):string;

begin

  getgroup:=getall('/etc/group',gid);

end;

function gettype(mode:integer):char;

begin

  if S_ISREG(mode) then

    gettype:='-'

  else

    if S_ISDIR(mode) then

      gettype:='d'

    else

      if S_ISCHR(mode) then

        gettype:='c'

      else

        if S_ISBLK(mode) then

          gettype:='b'

        else

          if S_ISFIFO(mode) then

            gettype:='p'

          else

            gettype:='l';

end;

function getrights(mode:integer):string;

const

  sympr:array [0..7] of string=(

                                 '---', {0}

                                 '--x', {1}

                                 '-w-', {2}

                                 '-wx', {3}

                                 'r--', {4}

                                 'r-x', {5}

                                 'rw-', {6}

                                 'rwx'  {7}

                               );

  specsympr:array [0..7] of string=(

                                 '---', {0}

                                 '--t', {1}

                                 '-s-', {2}

                                 '-st', {3}



                                 's--', {4}

                                 's-t', {5}

                                 'ss-', {6}

                                 'sst'  {7}

                               );

var

  s,u,g,o,i:integer;

  res:string;

begin

  mode:=mode and octal(7777);

  u:=(mode div octal(100)) mod octal(10);

  g:=(mode mod octal(100)) div octal(10);

  o:=mode mod octal(10);

  s:=mode div octal(1000);

  res:=sympr[u]+sympr[g]+sympr[o];

  for i:=1 to 3 do

    if specsympr[s][i]<>'-' then

    begin

      if res[3*i]='-' then

        res[3*i]:=upcase(specsympr[s][i])

      else

        res[3*i]:=specsympr[s][i];

    end;

  getrights:=res;

end;

procedure obhod(name:pchar);

var

  d:PDIR;

  el:pdirent;

  st:stat;

  res:integer;

  dt:tdatetime;

  polniypath,datetime:array [0..2000] of char;

begin

  d:=opendir(name);

  if d=nil then

  begin

    writeln('Îøèáêà îòêðûòèÿ êàòàëîãà ',name);

    exit;

  end;

  el:=readdir(d);

  while el<>nil do

  begin

    polniypath:=name;

    if strcomp(name,'/')=0 then

      strcat(polniypath,el^.name)

    else

    begin

      if name[strlen(name)-1]<>'/' then

        strcat(polniypath,'/');

      strcat(polniypath,el^.name);

    end;

    if not fstat(pchar(polniypath),st) then

      writeln(' Îøèáêà âûçîâà stat äëÿ ',polniypath)

    else

    begin

      strcopy(datetime,ctime(@st.mtime)+4);

      datetime[12]:=#0;

      write(gettype(st.mode),getrights(st.mode),st.nlink:5,' ',

            getname(st.uid):10,' ',getgroup(st.gid):10,' ',st.size:10,'  ',datetime,'  ' );

      writeln(el^.name);

    end;

    el:=readdir(d);

  end;

 

  closedir(d);

  d:=opendir(name);

  el:=readdir(d);

  while el<>nil do

  begin

    polniypath:=name;

    if strcomp(name,'/')=0 then

      strcat(polniypath,el^.name)

    else

    begin

      if name[strlen(name)-1]<>'/' then

        strcat(polniypath,'/');



      strcat(polniypath,el^.name);

    end;

    if not fstat(pchar(polniypath),st) then

      writeln('Îøèáêà âûçîâà stat äëÿ ',polniypath)

    else

    begin

      if S_ISDIR(st.mode) then

      begin

        if (strcomp(el^.name,'.')<>0) and (strcomp(el^.name,'..')<>0) then

        begin

          writeln;

          writeln(polniypath,':');

          obhod(polniypath);

        end;

      end;

    end;

    el:=readdir(d);

  end;

 

  closedir(d);

end;

var

  name:array [0..2000] of char;

begin

  if paramcount = 0 then

    name:='.'

  else

    name:=paramstr(1);

   

  obhod(name);

end.

Óïðàæíåíèå 13.33. Íàïèøèòå ïðîãðàììó óäàëåíèÿ êàòàëîãà, êîòîðàÿ óäàëÿåò âñå ôàéëû â íåì è, ðåêóðñèâíî, âñå åãî ïîäêàòàëîãè.

uses linux,strings,sysutils,crt;

{$linklib c}

type

  plong=^longint;

function gettype(mode:integer):char;

begin

  if S_ISREG(mode) then

    gettype:='-'

  else

    if S_ISDIR(mode) then

      gettype:='d'

    else

      if S_ISCHR(mode) then

        gettype:='c'

      else

        if S_ISBLK(mode) then

          gettype:='b'

        else

          if S_ISFIFO(mode) then

            gettype:='p'

          else

            gettype:='l';

end;

function obhod(name:pchar):boolean;

var

  flag:boolean;

  d:PDIR;

  el:pdirent;

  st:stat;

  res:integer;

  polniypath:array [0..2000] of char;

begin

  flag:=true;

  d:=opendir(name);

  if d=nil then

  begin

    writeln('Îøèáêà îòêðûòèÿ êàòàëîãà ',name);

    exit;

  end;

  el:=readdir(d);

  while el<>nil do

  begin

    polniypath:=name;

    if strcomp(name,'/')=0 then

      strcat(polniypath,el^.name)

    else

    begin

      if name[strlen(name)-1]<>'/' then

        strcat(polniypath,'/');

      strcat(polniypath,el^.name);

    end;

    if not fstat(pchar(polniypath),st) then

      writeln('Îøèáêà âûçîâà stat äëÿ ',polniypath)



    else

    begin

      if not (gettype(st.mode) = 'd') then

      begin

        writeln('Ñòèðàþ ôàéë ',polniypath);     

        //unlink(polniypath);

        if not unlink(polniypath) then

        begin

          writeln('íåâîçìîæíî ñòåðåòü ôàéë ',polniypath);

          flag:=false;(*îøèáêà óäàëåíèÿ ôàéëà - íåëüçÿ áóäåò ñòåðåòü êàòàëîã*)

        end;

      end;

    end;

    el:=readdir(d);

  end;

  closedir(d);

 

  d:=opendir(name);

  el:=readdir(d);

  while el<>nil do

  begin

    polniypath:=name;

    if strcomp(name,'/')=0 then

      strcat(polniypath,el^.name)

    else

    begin

      if name[strlen(name)-1]<>'/' then

        strcat(polniypath,'/');

      strcat(polniypath,el^.name);

    end;

    if not fstat(pchar(polniypath),st) then

      writeln('Îøèáêà âûçîâà stat äëÿ ',polniypath)

    else

    begin

      if (gettype(st.mode)='d') and

         (strcomp(el^.name,'.')<>0) and

         (strcomp(el^.name,'..')<>0) then

      begin

        writeln('Ïåðåõîä â êàòàëîã ',polniypath);     

        if not obhod(polniypath) then

          flag:=false;

      end;

    end;

    el:=readdir(d);

  end;

  closedir(d);

  if not flag then

    writeln('Êàòàëîã ',name,

    ' íå áóäåò ñòåðò, ò.ê. â íåì íå óäàëîñü ñòåðåòü ÷àñòü ôàéëîâ èëè êàòàëîãîâ')

  else

  begin

    {$i-}

    rmdir(name);

    if ioresult <> 0 then

    begin

      writeln('Îøèáêà óäàëåíèÿ êàòàëîãà ',name);

      flag:=false;

    end;

  end;

  writeln('Äëÿ êàòàëîãà ',name, ' ïîëó÷åí ',flag);

  obhod:=flag;

end;

var

  name:array [0..2000] of char;

begin

  if paramcount<>0 then

  begin

    name:=paramstr(1);

    obhod(name);

  end

  else

    writeln('Ñ îñîáîé îñòîðîæíîñòüþ èñïîëüçóéòå: ',paramstr(0),' óäàëÿåìûé êàòàëîã');

end.


Ñîäåðæàíèå ðàçäåëà