Êàòàëîãè
Óïðàæíåíèå 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.
