13.7. Управление файлами

Упражнение 13.41. Составьте аналог команды rm.

uses linux,sysutils;

var

f:text;

d:boolean;

k:char;

s:string;

begin

writeln('введите имя файла, который нужно удалить');

readln(s);

assign(f,s);

if s='' then

begin

writeln('повторите попытку');

exit;

end;

writeln('подтвердите удаление файла Y/N');

readln(k);

if (k='Y') or (k='y') then

begin

d:=deletefile(s);

if d then

writeln('файл удален')

else

writeln('файл не удален');

end

else

writeln('файл не удален');

end.

Упражнение 13.42. Используя системный вызов fstat, напишите программу, определяющую тип файла: обычный файл, каталог, устройство, FIFO-файл.

uses linux,strings,sysutils;

function gettype(mode:integer):string;

begin

if S_ISREG(mode) then

gettype:='файл'

else

if S_ISDIR(mode) then

gettype:='каталог'

else

if S_ISCHR(mode) then

gettype:='байтоориентированное устройство'

else

if S_ISBLK(mode) then

gettype:='блочноориентированное устройство'

else

if S_ISFIFO(mode) then

gettype:='FIFO-файл'

else

gettype:='другое';

end;

var

st:stat;

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

begin

if paramcount = 0 then

name:='.'

else

name:=fexpand(paramstr(1));

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

writeln('Ошибка вызова stat для ',name)

else

write(gettype(st.mode));

end.

Упражнение 13.43. Составьте аналог команды chgrp.

Uses linux;

Var

UID,GID:Longint;

F:Text;

Code:Integer;

begin

Writeln('This will only work if you are root.');

if ParamCount<3 then

begin

Writeln('Error!!!');

Writeln('Format: ./task <Filename> <UID> <GID>');

Halt(1);

end;

val(Paramstr(2),UID,Code);

if Code<>0 then

begin

Writeln('Error!!!');

Writeln('Format: ./task <Filename> <UID> <GID>');

Halt(1);

end;

val(Paramstr(3),GID,Code);

if Code<>0 then

begin

Writeln('Error!!!');

Writeln('Format: ./task <Filename> <UID> <GID>');

Halt(1);

end;

if not Chown(ParamStr(1),UID,GID) then

if LinuxError=Sys_EPERM then

Writeln('You are not root!')

else

Writeln('Chmod failed with exit code: ',LinuxError)

else

Writeln('Changed owner successfully!');

end.

Упражнение 13.44. Составьте аналог команды mkdir.

Program Tabs;

begin

{$I-}

if ParamCount=1 then

begin

MkDir(ParamStr(1));

if IOResult <> 0 then Writeln('Cannot create directory')

else Writeln('New directory created');

end

else Writeln('Error');

end.

Упражнение 13.45. Составьте аналог команды chmod.

uses linux;

var

f,ch:string;

n,i:byte;

d:integer;

begin

if paramcount<>2 then

begin

writeln('Используйте: ',paramstr(0),' права_доступа файл/каталог');

exit;

end;

f:=paramstr(2);

ch:=paramstr(1);

n:=length(ch);

d:=0;

for i:=1 to n do

if not (ch[i] in ['0'..'7']) then

begin

writeln('Права доступа должны быть в восьмеричном формате');

exit;

end

else

d:=d*8+byte(ch[i])-byte('0');

if not chmod(f,d) then

writeln('Ошибка установки прав доступа ',ch,' для ',f);

end.

Упражнение 13.46. Составьте аналог команды chown.

uses linux,strings,sysutils,crt;

type

plong=^longint;

procedure perror(s:pchar);cdecl;external 'c';

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;

procedure getall(w:string;name:string;var uid,gid:integer);

var ts,nam1,namb1,namb2:string;

tx:text;

d:integer;

f:boolean;

begin

assign(tx,w);

reset(tx);

f:=false;

while not EOF (tx) and not f do

begin

readln(tx,ts);

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

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

delete(ts,1,d+2);

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

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

delete(ts,1,d);

val(namb1,d);

uid:=d;

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

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

val(namb2,d);

gid:=d;

if nam1=name then

f:=true;

end;

if not f then

begin

uid:=-1;

gid:=-1;

end;

close(tx);

end;

var

username,groupname,fname:string;

uid,gid:integer;

posit,temp:integer;

begin

if paramcount<>2 then

begin

writeln('Используйте: ',paramstr(0),' владелец[:группа] файл');

exit;

end;

username:=paramstr(1);

fname:=paramstr(2);

posit:=0;

posit:=pos(':',username);

if posit<>0 then

begin

groupname:=copy(username,posit+1,length(username)-posit);

username[0]:=char(posit-1);

getall('/etc/passwd',username,uid,gid);

getall('/etc/group',groupname,gid,temp);

end

else

getall('/etc/passwd',username,uid,gid);

if (uid=-1) or (gid=-1) then

begin

writeln('Неверное имя владельца (группы)');

exit;

end;

if not chown(fname,uid,gid) then

perror('Ошибка вызова chown');

end.

Упражнение 13.47. Создайте программу chmodr, рекурсивно изменяющую права доступа для всех файлов каталога и вложенных в него подкаталогов. Имя каталога и права указываются в командной строке.

uses linux,strings,sysutils,crt;

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(prava:integer;name:pchar):boolean;

var

flag:boolean;

d:PDIR;

el:pdirent;

st:stat;

res:integer;

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

ch:string;

n,i:byte;

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

if not chmod(pchar(polniypath),prava) then

writeln('Ошибка установки прав доступа ',prava,' для ',polniypath);

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(prava,polniypath) then

flag:=false;

end;

end;

el:=readdir(d);

end;

closedir(d);

if not flag then

writeln(' У каталога ',name, ' не удалось изменить права доступа ');

// writeln('Для каталога ',name, ' получен ',flag);

obhod:=flag;

end;

var

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

prava,i:integer;

ch:string;

begin

if paramcount<>2 then

begin

writeln('Используйте: ',paramstr(0),' права_доступа файл/каталог');

exit;

end;

name:=paramstr(2);

ch:=paramstr(1);

prava:=0;

for i:=1 to length(ch) do

if not (ch[i] in ['0'..'7']) then

begin

writeln('Права доступа должны быть в восьмеричном формате');

exit;

end

else

prava:=prava*8+byte(ch[i])-byte('0');

obhod(prava,name);

end.

Упражнение 13.48. Напишите программу, совмещающая команды mv и cp (в зависимости от своего названия).

uses linux,sysutils;

var

b:byte;

s:string;

f1,f2:file of byte;

begin

s:=paramstr(0);

delete(s,1,length(s)-2);

if s='mv' then

begin

if paramcount<2 then

begin

writeln('Error: wrong arguments');

writeln('введите имя файла, который хотите переименовать и новое имя файла');

halt(1);

end;

Assign(F1,paramstr(1));

Assign(F2,paramstr(2));

if not frename(paramstr(1),paramstr(2)) then

begin

writeln('невозможно переименовать ');

halt(1);

end;

end

else

if s='cp' then

begin

if paramcount<2 then

begin

writeln('Error: wrong arguments');

writeln('format: cp <fileinp> <fileout>');

Halt(1);

end;

Assign(f1,paramstr(1));

Reset(f1);

Assign(f2,paramstr(2));

Rewrite(f2);

while not eof(f1)do

begin

read(f1,b);

write(f2,b);

end;

close(f1);

close(f2);

end

else

writeln('Переименуйте программу в mv / cp');

end.

Упражнение 13.49. Составьте аналог команды sync.

procedure sync;cdecl; external 'c';

begin

sync;

end.

Упражнение 13.50. Создайте программу, выводящую содержимое символической ссылки, а затем – целевого файла, на который она указывает.

uses linux;

var

name,temp:array [0..1023] of char;

kol,fd:integer;

begin

if paramcount<>1 then

begin

writeln('Используйте: ',paramstr(0),' имя_ссылки');

exit;

end;

temp:=paramstr(1);

kol:=readlink(temp,name,1023);

if kol=-1 then

begin

writeln('Ошибка чтения ссылки ',temp);

exit;

end;

name[kol]:=#0;

writeln('По ссылке ',paramstr(1), ' найден файл ',name);

fd:=fdopen(name,Open_RDONLY);

if fd=-1 then

begin

writeln('Ошибка открытия ',name);

exit;

end;

kol:=fdread(fd,name,1024);

while kol>0 do

begin

fdwrite(1,name,kol);

kol:=fdread(fd,name,1024);

end;

fdclose(fd);

end.