← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to docs/ipcex/msgtool.pp

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

Lines of Context:
docs/ipcex/msgtool.pp
1
 
program msgtool;
2
 
 
3
 
Uses ipc;
4
 
 
5
 
Type
6
 
  PMyMsgBuf = ^TMyMsgBuf;
7
 
  TMyMsgBuf = record
8
 
    mtype : Longint;
9
 
    mtext : string[255];
10
 
  end; 
11
 
 
12
 
Procedure DoError (Const Msg : string);
13
 
 
14
 
begin
15
 
  Writeln (msg,'returned an error : ',ipcerror);
16
 
  halt(1);
17
 
end;
18
 
 
19
 
Procedure SendMessage (Id : Longint; 
20
 
                       Var Buf : TMyMsgBuf; 
21
 
                       MType : Longint; 
22
 
                       Const MText : String);
23
 
 
24
 
begin
25
 
  Writeln ('Sending message.');
26
 
  Buf.mtype:=mtype;
27
 
  Buf.Mtext:=mtext;
28
 
  If not msgsnd(Id,PMsgBuf(@Buf),256,0) then
29
 
    DoError('msgsnd');
30
 
end;
31
 
 
32
 
Procedure ReadMessage (ID : Longint;
33
 
                       Var Buf : TMyMsgBuf;
34
 
                       MType : longint);
35
 
 
36
 
begin
37
 
  Writeln ('Reading message.');
38
 
  Buf.MType:=MType;
39
 
  If msgrcv(ID,PMSGBuf(@Buf),256,mtype,0) then
40
 
    Writeln ('Type : ',buf.mtype,' Text : ',buf.mtext)
41
 
  else 
42
 
    DoError ('msgrcv');
43
 
end;
44
 
 
45
 
Procedure RemoveQueue ( ID : Longint);
46
 
 
47
 
begin
48
 
  If msgctl (id,IPC_RMID,Nil) then
49
 
    Writeln ('Removed Queue with id',Id);
50
 
end;
51
 
 
52
 
Procedure ChangeQueueMode (ID,mode : longint);
53
 
 
54
 
Var QueueDS : TMSQid_ds;
55
 
 
56
 
begin
57
 
  If Not msgctl (Id,IPC_STAT,@QueueDS) then
58
 
    DoError ('msgctl : stat');
59
 
  Writeln ('Old permissions : ',QueueDS.msg_perm.mode);
60
 
  QueueDS.msg_perm.mode:=Mode;
61
 
  if msgctl (ID,IPC_SET,@QueueDS) then
62
 
    Writeln ('New permissions : ',QueueDS.msg_perm.mode)
63
 
  else
64
 
   DoError ('msgctl : IPC_SET');
65
 
end;
66
 
 
67
 
procedure usage;
68
 
 
69
 
begin
70
 
  Writeln ('Usage : msgtool s(end)    <type> <text> (max 255 characters)');
71
 
  Writeln ('                r(eceive) <type>');
72
 
  Writeln ('                d(elete)');
73
 
  Writeln ('                m(ode) <decimal mode>');
74
 
  halt(1);
75
 
end;
76
 
 
77
 
Function StrToInt (S : String): longint;
78
 
 
79
 
Var M : longint;
80
 
    C : Integer;
81
 
 
82
 
begin
83
 
  val (S,M,C);
84
 
  If C<>0 Then DoError ('StrToInt : '+S);
85
 
  StrToInt:=M;
86
 
end;
87
 
 
88
 
Var 
89
 
  Key : TKey;
90
 
  ID  : longint;
91
 
  Buf : TMyMsgBuf;
92
 
 
93
 
begin
94
 
  If Paramcount<1 then Usage;
95
 
  key :=Ftok('.','M');
96
 
  ID:=msgget(key,IPC_CREAT or 438);
97
 
  If ID<0 then DoError ('MsgGet');
98
 
  Case upCase(Paramstr(1)[1]) of 
99
 
   'S' : If ParamCount<>3 then 
100
 
           Usage
101
 
         else
102
 
           SendMessage (id,Buf,StrToInt(Paramstr(2)),paramstr(3));
103
 
   'R' : If ParamCount<>2 then
104
 
           Usage
105
 
         else
106
 
           ReadMessage (id,buf,strtoint(Paramstr(2)));
107
 
   'D' : If ParamCount<>1 then
108
 
           Usage 
109
 
         else
110
 
           RemoveQueue (ID);
111
 
   'M' : If ParamCount<>2 then
112
 
           Usage
113
 
         else
114
 
           ChangeQueueMode (id,strtoint(paramstr(2)));
115
 
   else
116
 
     Usage
117
 
   end;
118
 
end.
 
 
b'\\ No newline at end of file'