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
|
Program shmtool;
uses ipc,strings,Baseunix;
Const SegSize = 100;
var key : Tkey;
shmid,cntr : longint;
segptr : pchar;
Procedure USage;
begin
Writeln ('Usage : shmtool w(rite) text');
writeln (' r(ead)');
writeln (' d(elete)');
writeln (' m(ode change) mode');
halt(1);
end;
Procedure Writeshm (ID : Longint; ptr : pchar; S : string);
begin
strpcopy (ptr,s);
end;
Procedure Readshm(ID : longint; ptr : pchar);
begin
Writeln ('Read : ',ptr);
end;
Procedure removeshm (ID : Longint);
begin
shmctl (ID,IPC_RMID,Nil);
writeln ('Shared memory marked for deletion');
end;
Procedure CHangeMode (ID : longint; mode : String);
Var m : word;
code : integer;
data : TSHMid_ds;
begin
val (mode,m,code);
if code<>0 then
usage;
If shmctl (shmid,IPC_STAT,@data)=-1 then
begin
writeln ('Error : shmctl :',fpgeterrno);
halt(1);
end;
writeln ('Old permissions : ',data.shm_perm.mode);
data.shm_perm.mode:=m;
If shmctl (shmid,IPC_SET,@data)=-1 then
begin
writeln ('Error : shmctl :',fpgeterrno);
halt(1);
end;
writeln ('New permissions : ',data.shm_perm.mode);
end;
const ftokpath = '.'#0;
begin
if paramcount<1 then usage;
key := ftok (pchar(@ftokpath[1]),ord('S'));
shmid := shmget(key,segsize,IPC_CREAT or IPC_EXCL or 438);
If shmid=-1 then
begin
Writeln ('Shared memory exists. Opening as client');
shmid := shmget(key,segsize,0);
If shmid = -1 then
begin
Writeln ('shmget : Error !',fpgeterrno);
halt(1);
end
end
else
Writeln ('Creating new shared memory segment.');
segptr:=shmat(shmid,nil,0);
if longint(segptr)=-1 then
begin
Writeln ('Shmat : error !',fpgeterrno);
halt(1);
end;
case upcase(paramstr(1)[1]) of
'W' : writeshm (shmid,segptr,paramstr(2));
'R' : readshm (shmid,segptr);
'D' : removeshm(shmid);
'M' : changemode (shmid,paramstr(2));
else
begin
writeln (paramstr(1));
usage;
end;
end;
end.
|
