home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
C!T ROM 2
/
ctrom_ii_b.zip
/
ctrom_ii_b
/
PROGRAM
/
PASCAL
/
NWTP04
/
NWMESS.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-01-01
|
13KB
|
386 lines
{$X+,B-,V-}
UNIT nwMess;
{ nwMess unit as of 931228 / NwTP 0.4 API. (c) 1994, R.Spronk }
INTERFACE
Uses nwMisc;
{ Function: Interrupt: comments:
* BroadcastToConsole (F215/09)
DisableStationBroadcast (F215/02)
EnableStationBroadcast (F215/03)
* GetBroadcastMessage (F215/01)
* GetBroadcastMode (DE..(..04))
* SendBroadcastMessage (F215/00)
* SendConsoleBroadcast (F217/D1)
* SetBroadcastMode (DE..(..0x)), x= 0,1,2,3
NOT IMPLEMENTED:
- CheckPipeStatus (F215/08) (1)
- CloseMessagePipe (F215/07) (1)
- GetPersonalMessage (F215/05) (1)
- LogNetworkMessage (F215/0D) (2)
- OpenMessagePipe (F215/06) (1)
- SendPersonalMessage (F215/04) (1)
Secondary Functions:
* SendMessageToUser
Notes:
(1) These calls are NOT supported by Netware 386 versions shipped after
December 1990, because they use pipe mechanisms, which cause a
considerable deal of server overhead.
These functions are not implemented in this unit.
Use IPX/SPX peer-to-peer communication instead (nwComm).
(2) Network msg file no longer supported by 3.x
}
Var result:word;
{F215/09 [2.15c+]}
Function BroadcastToConsole(message:string):boolean;
{ broadcast a message to the file server console.
The message (max 60 chars, in ascii range [$20..$7E]) will be displayed
at the bottom of the console screen.
This function truncates the messagelength to 60 and repaces illegal
characters with a . }
{F215/02 [ ? ]}
Function DisableStationBroadcast:boolean;
{ Allows a station to refuse broadcast messages. }
{F215/03 [ ? ]}
Function EnableStationBroadcast:boolean;
{ Allows a station to accept broadcast messages. }
{F215/01 [2.15c+]}
Function GetBroadcastMessage(var bmessage: string):boolean;
{ An application should poll this to see if there is a broadcastmessage
stored (for this workstation) at the default server.
The message mode must be 2 or 3. (No Notification by Shell)
If no message was stored at the server, or the message was empty,
this function will return FALSE and an errorcode of $103. }
{DE..(..04) [1.x/2.x/ 3.x]}
Function GetBroadcastMode(var bmode:byte):boolean;
{ Returns the message mode.
00 Server Stores : Netware Messages and User Messages,
Shell automaticly displays messages.
01 Server Stores : Server Messages. (User messages discarded)
Shell automaticly displays messages.
02 Server stores : Server messages only.
Applications have to use GetBroadCastMessage to see if there is a message.
03 Server stores : Server messages and User messages.
Applications have to use GetBroadCastMessage to see if there is a message. }
{F215/00 [2.15c+]}
Function SendBroadcastMessage( message:string;
connCount:byte;
connList:TconnectionList;
VAR resultlist:TconnectionList ):boolean;
{ Sends a broadcast message to a number of logical connections.
The connectionlist is an array[1..connCount] of logical connection numbers,
the result of the broadcast can be found in the resultList parameter. }
{DE..(..0n) n=0,1,2,3 [1.x/2.x/3.x]}
Function SetBroadcastMode(bmode:byte):boolean;
{F217/D1 [2.15c+]}
Function SendConsoleBroadcast(message:string; connCount:byte;
connList:TconnectionList ):boolean;
{Sends a message to a number of connections, as if the message was send
by a console broadcast command. Console oprator privileges required.
If connCount equals 0, then the message is send to all connections. }
{--------------------Secondary Functions-------------------------------}
Procedure SendMessageToUser(UserName,Message:String);
{ sends a message to a (group of) users.
The username may contain wildcards (* and ?).
The message will not be received by stations whose status is CASTOFF.}
IMPLEMENTATION {============================================================}
USES Dos,nwConn;
Var UnitReqBuffer:array[1..576] of byte;
UnitReplyBuffer:array[1..576] of byte;
UnitRegs:registers;
Procedure F2SystemCall(subf:byte;req_size,rep_size:word);
begin
With UnitRegs
do begin
DS := Seg(UnitReqBuffer); SI := Ofs(UnitReqBuffer); CX := Req_size;
ES := Seg(UnitReplyBuffer);DI := Ofs(UnitReplyBuffer); DX := rep_size;
AH := $F2; AL := subf;
MSDOS(UnitRegs);
Result:=al;
end;
end;
{DE..(..04) [1.x/2.x/ 3.x]}
Function GetBroadcastMode(var bmode:byte):boolean;
{ Returns the message mode.
00 Server Stores : Netware Messages and User Messages,
Shell automaticly displays messages.
01 Server Stores : Server Messages. (User messages discarded)
Shell automaticly displays messages.
02 Server stores : Server messages only.
Applications have to use GetBroadCastMessage to see if there is a message.
03 Server stores : Server messages and User messages.
Applications have to use GetBroadCastMessage to see if there is a message. }
var regs : registers;
begin
regs.ah := $de;
regs.dl := $04;
msdos(regs);
bmode := regs.al;
result:=$00; { the call has no return codes }
GetBroadCastMode:=True;
end;
{DE..(..0n) n=0,1,2,3 [1.x/2.x/3.x]}
Function SetBroadcastMode(bmode:byte):boolean;
{ Sets the new message mode.
possible resultcode: $FF ( illegal broadcastmode supplied or
the broadcastmode after the call is not equal
to the intended broadcast mode )
00 Server Stores : Netware Messages and User Messages,
Shell automaticly displays messages.
01 Server Stores : Server Messages. (User messages discarded)
Shell automaticly displays messages.
02 Server stores : Server messages only.
Applications have to use GetBroadCastMessage to see if there is a message.
03 Server stores : Server messages and User messages.
Applications have to use GetBroadCastMessage to see if there is a message. }
var regs : registers;
begin
if (bmode <4)
then begin
regs.ah := $de;
regs.dl := bmode;
msdos(regs);
if regs.al<>bmode { if confirmation of new mode unequal desired mode }
then result:=$FF
else result:=$00;
end
else result:=$FF;
SetBroadcastMode:=(result=0);
end;
{F215/01 [2.15c+]}
Function GetBroadcastMessage(var bmessage: string):boolean;
{ An application should poll this to see if there is a broadcastmessage
stored (for this workstation) at the default server.
The message mode must be 2 or 3. (No Notification by Shell)
If no message was stored at the server, or the message was empty,
this function will return FALSE and an errorcode of $103. }
Var req:record
len :word;
subF :byte;
end ABSOLUTE UnitReqBuffer;
reply:record
_message:string[55];
end ABSOLUTE UnitReplyBuffer;
BEGIN
With req
do begin
subF:=$01;
len:=1;
end;
F2SystemCall($15,sizeOf(req),sizeOf(reply));
If result=0
then bmessage:=reply._message;
if bmessage[0]=#0 then result:=$103; { whups! empty message }
GetBroadCastMessage:=(result=0);
{ returncodes:
00 Successful; FC Message Queue Full;
FE I/O failure: Lack of dynamic workspace.
103 No msgs stored at server. }
end;
{F215/00 [2.15c+]}
Function SendBroadcastMessage( message:string;
connCount:byte;
connList:TconnectionList;
VAR resultlist:TconnectionList ):boolean;
{ Sends a broadcast message to a number of logical connections.
The connectionlist is an array[1..connCount] of logical connection numbers,
the result of the broadcast can be found in the resultList parameter.
example:
connCount=5
connList= [ 4,9,1,5,2 ]
resultList= [$00, $00, $FC, $FD, $FF]
possible codes in resultList:
$00: broadcast to this logical connnection was successful.
$FC: message rejected, buffer for this station already contains a message,
$FD: invalid connection number
$FF: The target connection has blocked incoming messages,
or the target connection is not in use. }
Var req:record
len :word;
subF :byte;
_connCount :byte;
connLandMessage:array[1..306] of byte; { 250 conn, 56 msg }
end ABSOLUTE UnitReqBuffer;
reply:record
connCount:byte;
_ResultList:TconnectionList;
end ABSOLUTE UnitReplyBuffer;
t:byte;
BEGIN
With req
do begin
subF:=$00;
_connCount:=connCount;
move(connList[1],connLandMessage[1],connCount);
t:=ord(message[0]); if t>55 then t:=55;
move(message[0],connLandMessage[connCount+1],t+1);
len:=3+connCount+t; { 2 bytes + [connList] + len(str) + str[0] }
end;
F2SystemCall($15,sizeOf(req),sizeOf(reply));
If result=0
then with reply
do begin
resultList:=_resultlist;
end;
SendBroadcastMessage:=(result=0);
end;
{F215/09 [2.15c+]}
Function BroadcastToConsole(message:string):boolean;
{ broadcast a message to the file server console.
The message (max 60 chars, in ascii range [$20..$7E]) will be displayed
at the bottom of the console screen.
This function truncates the messagelength to 60 and repaces illegal
characters with a . }
Var req:record
len :word;
subF :byte;
_message :string;
end ABSOLUTE UnitReqBuffer;
t:byte;
BEGIN
With req
do begin
subF:=$09;
PstrCopy(_message,message,60);
for t:=1 to 60
do if (_message[t]<>#$0) and
((_message[t]<#$20) or (_message[t]>#$7E))
then _message[t]:='.';
len:=62;
end;
F2SystemCall($15,sizeOf(req),0);
BroadcastToConsole:=(result=0);
{ resultcodes: 00 success ; $FC message queue full ;
$FE I/O failure: lack of dynamic workspace }
end;
{F215/02 [2.15c+]}
Function DisableStationBroadcast:boolean;
Var req:record
len :word;
subF :byte;
end ABSOLUTE UnitReqBuffer;
BEGIN
With req
do begin
subF:=$02;
len:=1;
end;
F2SystemCall($15,SizeOf(req),0);
DisableStationBroadcast:=(result=0);
end;
{F215/03 [2.15c+]}
Function EnableStationBroadcast:boolean;
Var req:record
len :word;
subF :byte;
end ABSOLUTE UnitReqBuffer;
BEGIN
With req
do begin
subF:=$03;
len:=1;
end;
F2SystemCall($15,sizeOf(req),0);
EnableStationBroadcast:=(result=0);
end;
{F217/D1 [2.15c+]}
Function SendConsoleBroadcast(message:string; connCount:byte;
connList:TconnectionList ):boolean;
{Sends a message to a number of connections, as if the message was send
by a console oprator. Console oprator privileges required.
If connCount equals 0, then the message is send to all connections. }
Var req:record
len :word;
subF :byte;
_ConnCount:byte;
_connAndMess:array[1..306] of byte;
end ABSOLUTE UnitReqBuffer;
t:byte;
BEGIN
With req
do begin
subF:=$D1;
_connCount:=connCount;
Move(connList[1],_connAndMess[1],connCount);
t:=ord(message[0]); if t>55 then t:=55;
{!! to do: strip hi-bit of message.. }
Move(message[0],_connAndMess[connCount+1],t+1);
len:=t+connCount+3;
end;
F2SystemCall($17,sizeOf(req),0);
SendConsoleBroadcast:=(result=0);
{Resultcodes: $00 success; $C6 No Console Rights}
end;
{=================== Secondary Functions ===================================}
Procedure SendMessageToUser(UserName,Message:String);
{ sends a message to a (group of) users.
The username may contain wildcards (* and ?).
The message will not be received by stations whose status is CASTOFF.}
{ calls nwConn.getObjectConnectionNumber and nwMess.SendBroadcastMessage }
Var NbrOfConn:byte;
connList,ResultList:TconnectionList;
begin
IF NwConn.GetObjectConnectionNumbers(UserName,1 {OT_USER},NbrOfConn,connList)
AND (NbrOfConn>0)
then SendBroadcastMessage(Message,NbrOfConn,connList,ResultList);
end;
end. {unit nwMess}