1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
|
program msgtool;
Uses ipc,baseunix;
Type
PMyMsgBuf = ^TMyMsgBuf;
TMyMsgBuf = record
mtype : Longint;
mtext : string[255];
end;
Procedure DoError (Const Msg : string);
begin
Writeln (msg,' returned an error : ',fpgeterrno);
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 msgsnd(Id,PMsgBuf(@Buf),256,0)=-1 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)<>-1 then
Writeln ('Type : ',buf.mtype,' Text : ',buf.mtext)
else
DoError ('msgrcv');
end;
Procedure RemoveQueue ( ID : Longint);
begin
If msgctl (id,IPC_RMID,Nil)<>-1 then
Writeln ('Removed Queue with id ',Id);
end;
Procedure ChangeQueueMode (ID,mode : longint);
Var QueueDS : TMSQid_ds;
begin
If msgctl (Id,IPC_STAT,@QueueDS)=-1 then
DoError ('msgctl : stat');
Writeln ('Old permissions : ',QueueDS.msg_perm.mode);
QueueDS.msg_perm.mode:=Mode;
if msgctl (ID,IPC_SET,@QueueDS)=0 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;
const ipckey = '.'#0;
begin
If Paramcount<1 then Usage;
key :=Ftok(@ipckey[1],ord('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.
|
