Полищук, Семериков. Системное программирование в UNIX средствами Free Pascal / examples / 9 / unfreeze

(* рТПЗТБННБ unfreeze -- ПУЧПВПЦДЕОЙЕ ФЕТНЙОБМБ *)
uses stdio,linux,strings;

const
LINESZ =150;
SUCCESS=0;
ERROR =(-1);

(* рПМХЮЙФШ РПДФЧЕТЦДЕОЙЕ, ЪБФЕН ЪБЧЕТЫЙФШ ТБВПФХ РТПЗТБННЩ *)
function dokill(procid:longint;line,hd:pchar):integer;
var
c:char;
begin
writeln (#$a'оБКДЕО РТПГЕУУ, ЧЩРПМОСАЭЙК ЪБДБООХА РТПЗТБННХ :');
writeln (#9,hd,#9,line);
writeln ('оБЦНЙФЕ `y` ДМС ЪБЧЕТЫЕОЙС РТПГЕУУБ ', procid);
write (#$a'Yes\No? > ');
(* чЧЕДЙФЕ УМЕДХАЭЙК ОЕ РТПВЕМШОЩК УЙНЧПМ *)
readln (c);
if (c = 'y') or (c = 'Y') then
begin
kill (procid, SIGKILL);
dokill:=SUCCESS;
exit;
end;
dokill:=ERROR;
end;


const
killflag:integer=0;
(* йОЙГЙБМЙЪБГЙС ЬФПК РЕТЕНЕООПК ЪБЧЙУЙФ ПФ ЧБЫЕК УЙУФЕНЩ *)
pspart:pchar = 'ps t ';
fmt:pchar = '%d %*s %*s %*s %s';
var
comline, inbuf, header, name:array [0..LINESZ-1] of char;
f:pfile;
j:integer;
pid:longint;
begin
if paramcount <2 then
begin
writeln (stderr, 'УЙОФБЛУЙУ: ',paramstr(0),' ФЕТНЙОБМ РТПЗТБННБ ...');
halt (1);
end;

(* уВПТЛБ ЛПНБОДОПК УФТПЛЙ *)
strcopy (comline, pspart);
strcat (comline, argv[1]);

(* ъБРХУЛ ЛПНБОДЩ ps *)
f := pipeopen (comline, 'r');
if f = nil then
begin
writeln (stderr, paramstr(0),': ОЕ НПЗХ ЪБРХУФЙФШ ЛПНБОДХ ps ');
halt (2);
end;

(* рПМХЮЙФШ РЕТЧХА УФТПЛХ ПФ ps Й ЙЗОПТЙТПЧБФШ ЕЕ *)
if fgets (header, LINESZ, f) = nil then
begin
writeln (stderr, paramstr(0),': ОЕФ ЧЩЧПДБ ПФ ps?');
halt (3);
end;

(* рПЙУЛ РТПЗТБННЩ, ЛПФПТХА ОХЦОП ЪБЧЕТЫЙФШ *)
while fgets (inbuf, LINESZ, f) <> nil do
begin
if sscanf (inbuf, fmt, [@pid, pchar(name)]) < 2 then
break;
for j := 2 to argc-1 do
begin
if strcomp (name, argv[j]) = 0 then
begin
if dokill (pid, inbuf, header) = SUCCESS then
inc(killflag);
end;
end;
end;
(* ьФП РТЕДХРТЕЦДЕОЙЕ, Б ОЕ ПЫЙВЛБ *)
if killflag=0 then
writeln(stderr, paramstr(0),': ТБВПФБ РТПЗТБННЩ ОЕ ЪБЧЕТЫЕОБ ',
paramstr(1));
pipeclose(f);
halt (0);
end.