UNIX Free Pascal


         


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.

 

L 13.44. T v 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.

 

L 13.45. T v chmod.

uses linux;

var

f,ch:string;

n,i:byte;

d:integer;

begin

if paramcount<>2 then

begin

writeln('L: ',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(' v v ');

exit;

end

else

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

if not chmod(f,d) then

writeln('+ ',ch,' ',f);

end.

L 13.46. T v 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('L: ',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('= (v)');

exit;

end;

if not chown(fname,uid,gid) then

perror('+ v chown');

end.

L 13.47. T chmodr, v . L v𦪸 .

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('+ v ',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('+ v 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('+ v 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(' L ',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('L: ',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(' v v ');

exit;

end

else

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



obhod(prava,name);

end.

L 13.48. = , v 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(' , v ');

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.

L 13.49. T v sync.

procedure sync;cdecl; external 'c';

begin

sync;

end.

L 13.50. T , v v, , v v.

uses linux;

var

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

kol,fd:integer;

begin

if paramcount<>1 then

begin

writeln('L: ',paramstr(0),' _v');

exit;

end;

temp:=paramstr(1);

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

if kol=-1 then

begin

writeln('+ v ',temp);

exit;

end;

name[kol]:=#0;

writeln(' v ',paramstr(1), ' ',name);

fd:=fdopen(name,Open_RDONLY);

if fd=-1 then

begin

writeln('+ v ',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.


    





Forekc.ru
, , , , , , , , , ,