UNIX Free Pascal


         

proc


13.35. , : , , .

uses dos,linux,strings;

var

i,n,pid:integer;

s,fullname:array [0..200] of char;

temp:string;

d:pdir;

el:pdirent;

begin

i:=fdopen('/etc/passwd',Open_RDONLY);

n:=paramcount;

writeln(' ',paramcount+1, ' ');

for i:=0 to n do

writeln(' ',i+1,' - ',paramstr(i));

writeln(' :');

n:=envcount;

for i:=1 to n do

writeln(envstr(i));

pid:=getpid;

strcopy(s,'/proc/');

str(pid,temp);

strpcopy(s+strlen(s),temp);

strcat(s,'/fd/');

d:=opendir(pchar(s));

el:=readdir(d);

writeln(', :');

while el<>nil do

begin

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

begin

strcopy(fullname,s);

strcat(fullname,el^.name);

writeln(' ',el^.name,' ',readlink(fullname));

end;

el:=readdir(d);

end;

closedir(d);

end.

 

13.36. ps.

uses linux,strings,sysutils; (* Linux PChar*)

var

d:^TDir; (* *)

elem:^Dirent; (* , *)

realname, (* status*)

fullpath (* *)

:array [0..1000] of char;

number,coder:integer; (* *)

f:text;

name:string;

begin

d:=opendir('/proc'); (* *)

if d=nil then (* *)

begin

writeln(' opendir /proc'); (**)

halt(1); (* *)

end;

elem:=readdir(d); (* *)




while elem<>nil do (* *)

begin

(* *)

val(strpas(elem^.name),number,coder);

(* , *)

if coder=0 then

begin

(* status /proc/_/status *)

strcopy(fullpath,'/proc/');

strcat(fullpath,elem^.name);

strcat(fullpath,'/status');

(* *)

assign(f,fullpath);

reset(f);

readln(f,name);

close(f);

(* , *)

strlcopy(realname,@name[7],length(name));

realname[length(name)-6]:=#0;

(* *)

writeln(number,#9,realname);

end;

elem:=readdir(d); (* *)

end;

closedir(d); (* opendir *)

end.

13.37. /proc, .

uses linux,strings,sysutils; (* Linux PChar*)

var

d,d1:^TDir; (* *)

elem,elem1:^Dirent; (* , *)

realname, (* status*)

fullpath,fullpath1 (* *)

:array [0..1000] of char;

number,coder:integer; (* *)

f:text;

name:string;

begin

d:=opendir('/proc'); (* *)



if d=nil then (* *)

begin

writeln(' opendir /proc'); (**)

halt(1); (* *)

end;





elem:=readdir(d); (* *)

while elem<>nil do (* *)

begin

(* *)

val(strpas(elem^.name),number,coder);

(* , *)

if coder=0 then

begin

(* status /proc/_/fd *)

strcopy(fullpath,'/proc/');

strcat(fullpath,elem^.name);

strcat(fullpath,'/fd');

d1:=opendir(fullpath);

if d1=nil then

writeln(' ',number,' ')

else

begin

writeln(' ',number,' :');

elem1:=readdir(d1); (* *)

while elem1<>nil do (* *)

begin

strcopy(fullpath1,fullpath);

strcat(fullpath1,'/');

strcat(fullpath1,elem1^.name);

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

begin

(*realname[readlink(realname,fullpath1,999)]:=#0;*)

writeln(#9,readlink(strpas(fullpath1)));

end;

elem1:=readdir(d1); (* *)

end;

end;

end;

elem:=readdir(d); (* *)

end;

closedir(d); (* opendir *)

end.

13.38. /proc, , .

uses sysutils,crt,linux;

var

f:text;

count:integer;

ch:char;

begin

assign(f,'/proc/version');

reset(f);

if IOResult<>0 then

begin

writeln(' , ');

halt;

end;

textcolor(7);

write(' - ');



read(f,ch);

textcolor(2);

write(ch);

while ch<>' ' do

begin

read(f,ch);

write(ch);

end;

writeln;

while ch=' ' do

begin

read(f,ch);

end;

while ch<>' 'do

begin

read(f,ch);

end;

while ch=' ' do

begin

read(f,ch);

end;

textcolor(7);

write(' - ');

textcolor(2);

write(ch);

while ch<>' 'do

begin

read(f,ch);

write(ch);

end;

while ch<>'#' do

begin

read(f,ch);

end;

read(f,ch);

writeln;

textcolor(7);

write(' -');

textcolor(2);

while not eof(f)do

begin

read(f,ch);

write(ch);

end;

textcolor(7);

Close(f);

end.

13.39. /proc, (vendor_id, cpu family, model, model name, stepping, cpu MHz, cache size, fdiv_bug, hlt_bug, sep_bug, f00f_bug, coma_bug, fpu, fpu_exception, cpuid level, wp, flags, bogomips).

uses sysutils,linux;

var

f,count:integer;

ch:array [0..511] of byte;

begin

f:=fdopen('/proc/cpuinfo',Open_RDONLY);

if f=-1 then

begin

writeln(' ');

halt;

end;

writeln('Information about CPU');

count:=fdread(f,ch,512);

while count>0 do

begin

fdwrite(1,ch,count);

count:=fdread(f,ch,512);

end;

fdClose(f);

end.

13.40. /proc, .

uses sysutils,linux;

var

f,count:integer;

ch:array [0..511] of char;

begin

f:=fdopen('/proc/meminfo',Open_RDONLY);

if f=-1 then

begin

writeln(' ');

halt;

end;

writeln('Information about MEMORY');

count:=fdread(f,ch,512);

while count>0 do

begin

fdwrite(1,ch,count);

count:=fdread(f,ch,512);

end;

fdClose(f);

end.


    





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