mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-31 18:11:55 +01:00
118 lines
2.5 KiB
ObjectPascal
118 lines
2.5 KiB
ObjectPascal
program msgtool;
|
|
|
|
Uses ipc;
|
|
|
|
Type
|
|
PMyMsgBuf = ^TMyMsgBuf;
|
|
TMyMsgBuf = record
|
|
mtype : Longint;
|
|
mtext : string[255];
|
|
end;
|
|
|
|
Procedure DoError (Const Msg : string);
|
|
|
|
begin
|
|
Writeln (msg,'returned an error : ',ipcerror);
|
|
halt(1);
|
|
end;
|
|
|
|
Procedure SendMessage (Id : Longint;
|
|
Var Buf : TMyMsgBuf;
|
|
MType : Longint;
|
|
Const MText : String);
|
|
|
|
begin
|
|
Writeln ('Sending message.');
|
|
Buf.mtype:=mtype;
|
|
Buf.Mtext:=mtext;
|
|
If not msgsnd(Id,PMsgBuf(@Buf),256,0) then
|
|
DoError('msgsnd');
|
|
end;
|
|
|
|
Procedure ReadMessage (ID : Longint;
|
|
Var Buf : TMyMsgBuf;
|
|
MType : longint);
|
|
|
|
begin
|
|
Writeln ('Reading message.');
|
|
Buf.MType:=MType;
|
|
If msgrcv(ID,PMSGBuf(@Buf),256,mtype,0) then
|
|
Writeln ('Type : ',buf.mtype,' Text : ',buf.mtext)
|
|
else
|
|
DoError ('msgrcv');
|
|
end;
|
|
|
|
Procedure RemoveQueue ( ID : Longint);
|
|
|
|
begin
|
|
If msgctl (id,IPC_RMID,Nil) then
|
|
Writeln ('Removed Queue with id',Id);
|
|
end;
|
|
|
|
Procedure ChangeQueueMode (ID,mode : longint);
|
|
|
|
Var QueueDS : TMSQid_ds;
|
|
|
|
begin
|
|
If Not msgctl (Id,IPC_STAT,@QueueDS) then
|
|
DoError ('msgctl : stat');
|
|
Writeln ('Old permissions : ',QueueDS.msg_perm.mode);
|
|
QueueDS.msg_perm.mode:=Mode;
|
|
if msgctl (ID,IPC_SET,@QueueDS) then
|
|
Writeln ('New permissions : ',QueueDS.msg_perm.mode)
|
|
else
|
|
DoError ('msgctl : IPC_SET');
|
|
end;
|
|
|
|
procedure usage;
|
|
|
|
begin
|
|
Writeln ('Usage : msgtool s(end) <type> <text> (max 255 characters)');
|
|
Writeln (' r(eceive) <type>');
|
|
Writeln (' d(elete)');
|
|
Writeln (' m(ode) <decimal mode>');
|
|
halt(1);
|
|
end;
|
|
|
|
Function StrToInt (S : String): longint;
|
|
|
|
Var M : longint;
|
|
C : Integer;
|
|
|
|
begin
|
|
val (S,M,C);
|
|
If C<>0 Then DoError ('StrToInt : '+S);
|
|
StrToInt:=M;
|
|
end;
|
|
|
|
Var
|
|
Key : TKey;
|
|
ID : longint;
|
|
Buf : TMyMsgBuf;
|
|
|
|
begin
|
|
If Paramcount<1 then Usage;
|
|
key :=Ftok('.','M');
|
|
ID:=msgget(key,IPC_CREAT or 438);
|
|
If ID<0 then DoError ('MsgGet');
|
|
Case upCase(Paramstr(1)[1]) of
|
|
'S' : If ParamCount<>3 then
|
|
Usage
|
|
else
|
|
SendMessage (id,Buf,StrToInt(Paramstr(2)),paramstr(3));
|
|
'R' : If ParamCount<>2 then
|
|
Usage
|
|
else
|
|
ReadMessage (id,buf,strtoint(Paramstr(2)));
|
|
'D' : If ParamCount<>1 then
|
|
Usage
|
|
else
|
|
RemoveQueue (ID);
|
|
'M' : If ParamCount<>2 then
|
|
Usage
|
|
else
|
|
ChangeQueueMode (id,strtoint(paramstr(2)));
|
|
else
|
|
Usage
|
|
end;
|
|
end. |