Скачиваний:
17
Добавлен:
08.01.2014
Размер:
2.08 Кб
Скачать
(* рТПЗТБННБ etest -- ЧЧПД ЙНЕО ПВЯЕЛФПЧ Ч ПЮЕТЕДШ. *)
{$mode objfpc}
uses ipc,linux,stdio,sysutils;
{$i q.inc}

procedure warn (s:pchar);
begin
writeln(stderr, 'рТЕДХРТЕЦДЕОЙЕ: ', s);
end;

(* йОЙГЙБМЙЪБГЙС ПЮЕТЕДЙ -- РПМХЮЙФШ ЙДЕОФЙЖЙЛБФПТ ПЮЕТЕДЙ *)
function init_queue:longint;
var
queue_id:longint;
begin
(* рПРЩФЛБ УПЪДБОЙС ЙМЙ ПФЛТЩФЙС ПЮЕТЕДЙ УППВЭЕОЙК *)
queue_id := msgget (QKEY, IPC_CREAT or QPERM);
if queue_id = -1 then
perror ('пЫЙВЛБ ЧЩЪПЧБ msgget');
init_queue:=queue_id;
end;


(* рТПГЕДХТБ enter -- РПНЕУФЙФШ ПВЯЕЛФ Ч ПЮЕТЕДШ *)
function enter (objname:string;priority:longint):boolean;
var
len, s_qid:longint;
s_entry:q_entry; (* УФТХЛФХТБ ДМС ИТБОЕОЙС УППВЭЕОЙК *)
begin
(* рТПЧЕТЛБ ДМЙОЩ ЙНЕОЙ Й ХТПЧОС РТЙПТЙФЕФБ *)
len := length (objname);
if len > MAXOBN then
begin
warn ('УМЙЫЛПН ДМЙООПЕ ЙНС');
enter:=false;
exit;
end;
if (priority > MAXPRIOR) or (priority < 0) then
begin
warn ('ОЕДПРХУФЙНЩК ХТПЧЕОШ РТЙПТЙФЕФБ');
enter:=false;
exit;
end;

(* йОЙГЙБМЙЪБГЙС ПЮЕТЕДЙ УППВЭЕОЙК, ЕУМЙ ЬФП ОЕПВИПДЙНП *)
s_qid := init_queue;
if s_qid = -1 then
begin
enter:=false;
exit;
end;
(* йОЙГЙБМЙЪБГЙС УФТХЛФХТЩ РЕТЕНЕООПК s_entry *)
s_entry.mtype := priority;
strlcopy (s_entry.mtext, @objname[1], MAXOBN);
(* рПУЩМБЕН УППВЭЕОЙЕ, ЧЩРПМОЙЧ ПЦЙДБОЙЕ, ЕУМЙ ЬФП ОЕПВИПДЙНП *)
if not msgsnd (s_qid, @s_entry, len, 0) then
begin
perror ('пЫЙВЛБ ЧЩЪПЧБ msgsnd');
enter:=false;
exit;
end
else
enter:=true;
end;


var
priority:longint;
begin
if paramcount <> 2 then
begin
writeln(stderr, 'рТЙНЕОЕОЙЕ: ',paramstr(0),' ЙНС РТЙПТЙФЕФ');
halt (1);
end;
try
priority:=strtoint(paramstr(2));
except
on e:econverterror do
begin
warn ('оЕЮЙУМПЧПК РТЙПТЙФЕФ');
halt (2);
end;
end;
if (priority <= 0) or (priority > MAXPRIOR) then
begin
warn ('оЕДПРХУФЙНЩК РТЙПТЙФЕФ');
halt (2);
end;
if not enter (paramstr(1), priority) then
begin
warn ('пЫЙВЛБ Ч РТПГЕДХТЕ enter');
halt (3);
end;
halt (0);
end.
Соседние файлы в папке 8