819 lines
25 KiB
Plaintext
819 lines
25 KiB
Plaintext
Program Phone;
|
|
{$IFDEF VER70}
|
|
{$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P+,Q-,R-,S-,T-,V-,X+}
|
|
{$ELSE}
|
|
{$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S-,V-,X+}
|
|
{$ENDIF}
|
|
|
|
{ Source code for Borland/Turbo Pascal 6/7.
|
|
To be compiled with NwTP version 0.6 or higher.
|
|
NwTP is a FreeWare Netware Interface for Pascal.
|
|
}
|
|
|
|
{ Based on the phone.pas program by Eduardo M. Serrat,
|
|
as published in Dr.Dobbs #207, November 1993.
|
|
|
|
The NwTP units and this adaption of his program are
|
|
(c) 1993,1995 by Rene Spronk ,Groningen, the Netherlands. }
|
|
|
|
uses dos,crt,nwMisc,nwBindry,nwConn,nwMess,nwServ,nwIPX;
|
|
|
|
const Socket = $80C3;
|
|
{ This socket was assigned by Novell to an IPX Chatprogram by OXXI }
|
|
{ Don't use this program in conjunction with theirs.. }
|
|
Var
|
|
SendECB,
|
|
ListenECB :TEcb; { Definition of ECBs }
|
|
SendIpxHeader,
|
|
ListenIPXheader:TIpxHeader; { Definition of IPX Headers }
|
|
SendData,
|
|
ReadData :Array [1..100] of Byte; { Data area of packets }
|
|
readflg :Boolean; { Flag to signal received packets }
|
|
|
|
MyConnNbr :Byte;
|
|
MyAddress :TinternetworkAddress;
|
|
MyName :String;
|
|
MyServerId :Byte;
|
|
MyServerName :String;
|
|
myx,myy :Byte; { my viewport cursor position }
|
|
|
|
RconnNbr :Byte;
|
|
Raddress :TinterNetworkAddress;
|
|
Rname :String;
|
|
RfullName :String;
|
|
RserverID :Byte;
|
|
RserverName :String;
|
|
LocalTarget :TnodeAddress; { Node Address of bridge to remote address }
|
|
|
|
NewStack :Array[1..256] of Word; { !! used by ESR }
|
|
StackBottom :Word; { !! used by ESR }
|
|
HeapCheckPtr :pointer; { Pointer that holds heapPointers }
|
|
|
|
{---------------------------------------------------------------------------}
|
|
|
|
Procedure CheckError(b:Boolean;errCode:Word; mess:String);
|
|
begin
|
|
IF b
|
|
then begin
|
|
writeln;
|
|
CASE errCode of
|
|
{ main body: 0000-000F }
|
|
$0001:writeln('IPX not installed.');
|
|
$0002:writeln('Error opening socket.');
|
|
{ Procedure whoami }
|
|
$0010:writeln('Error whilst determining connectionnumber.');
|
|
$0011:writeln('Error determining internet address.');
|
|
$0012:writeln('Error retreiving connection information.');
|
|
{ Procedure process input command }
|
|
$0022:writeln('Servername ',mess,' is invalid.');
|
|
$0023:writeln('Error interpreting connection number parameter :',mess);
|
|
$0025:begin
|
|
writeln('The supplied username is not unique,');
|
|
writeln('or the target user isn''t logged in.');
|
|
end;
|
|
$0026:writeln('Please select a target user from the above list.');
|
|
$0027:writeln('Phone cancelled.');
|
|
{ handshake with sender }
|
|
$0032:writeln('Packet received from a user claiming to be ConnectionNumber $',mess);
|
|
{ Sendbroadcast message in Procedure HandshakeWithreceiver }
|
|
$1000: writeln('Error: Broadcasting a message to the target user failed.');
|
|
$10FC: begin
|
|
Writeln('The target user is logged in, but appears not to be at his/her workstation:');
|
|
writeln('The (last) message was rejected, message buffer for the target station is full.');
|
|
end;
|
|
$10FD: begin
|
|
Writeln('The connection number of the target user has become invalid,');
|
|
Writeln('Most likely because the user has logged out.');
|
|
end;
|
|
$10FF: begin
|
|
Writeln('The target user is logged in, but has blocked incoming messages.');
|
|
end;
|
|
else writeln('An unspecified error occurred.');
|
|
end; {case }
|
|
if errCode>$000F then IPXcloseSocket(socket);
|
|
if errCode>$001F
|
|
then begin
|
|
SetPreferredConnectionId(MyServerId);
|
|
release(HeapCheckPtr);
|
|
end;
|
|
if ((errCode=$0026) or (errCode=$0027))
|
|
then halt(0)
|
|
else halt(1);
|
|
end;
|
|
end;
|
|
|
|
{-----------------------------------------------------------------------------}
|
|
|
|
Function Confirm:Boolean;
|
|
Var ch:char;
|
|
begin
|
|
repeat
|
|
repeat {} until keypressed;
|
|
ch:=readkey;
|
|
if ch=#0 then ch:=readkey;
|
|
until ch IN ['y','Y','n','N'];
|
|
Confirm:=((ch='Y') or (ch='y'))
|
|
end;
|
|
|
|
{-----------------------------------------------------------------------------}
|
|
|
|
{$F+}
|
|
Procedure ESRproc;
|
|
begin
|
|
ReadFlg:=true;
|
|
end;
|
|
|
|
Procedure ESRHandler; assembler;
|
|
asm { ES:SI are the only valid registers when entering this Procedure ! }
|
|
mov dx, seg stackbottom
|
|
mov ds, dx
|
|
|
|
mov dx,ss { setup of a new local stack }
|
|
mov bx,sp { ss:sp copied to dx:bx}
|
|
mov ax,ds
|
|
mov ss,ax
|
|
mov sp,offset stackbottom
|
|
push dx
|
|
push bx
|
|
|
|
CALL EsrProc
|
|
|
|
pop bx
|
|
pop dx
|
|
mov sp,bx
|
|
mov ss,dx
|
|
end;
|
|
{$F-}
|
|
|
|
{-----------------------------------------------------------------------------}
|
|
|
|
Function SameAddress(Var a,b):Boolean;
|
|
{ check if networkaddress a and b have the same net and node address }
|
|
Type Taddress=Array[1..10] of char;
|
|
Var addrA:Taddress ABSOLUTE a;
|
|
addrB:Taddress ABSOLUTE b;
|
|
begin
|
|
SameAddress:=(addrA=addrB);
|
|
end;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
|
|
Function Time:String;
|
|
Function LeadingZero(w:Word):String;
|
|
Var s : String;
|
|
begin
|
|
Str(w:0,s);
|
|
if Length(s) = 1
|
|
then s := '0' + s;
|
|
LeadingZero := s;
|
|
end;
|
|
Var h, m, s, hund : Word;
|
|
begin
|
|
GetTime(h,m,s,hund);
|
|
Time:=LeadingZero(h)+':'+LeadingZero(m)+':'+LeadingZero(s);
|
|
end;
|
|
|
|
{-----------------------------------------------------------------------------}
|
|
Procedure HandshakeWithReceiver;
|
|
const Progress : Array [1..4] of char = ('/','Ä','\','|');
|
|
Var
|
|
SecondInd :Word;
|
|
ProgressInd :Byte;
|
|
x,y :Byte;
|
|
KeyNbr :Byte;
|
|
ConnUp :Boolean;
|
|
|
|
ObjName :String;
|
|
ObjType :Word;
|
|
ObjId :LongInt;
|
|
LogonTime :TnovTime;
|
|
|
|
Message :String;
|
|
ConnList,
|
|
ResultList :TconnectionList;
|
|
begin
|
|
Writeln('Calling User ',Rname);
|
|
Write('Press <ESC> to cancel [ ]');
|
|
x:=wherex-2; y:=wherey;
|
|
Message:='User '+MyName+' is phoning you........... ['+Time+']';
|
|
SecondInd:=0; ProgressInd:=1;
|
|
|
|
SetPreferredConnectionId(RserverId);
|
|
ConnList[1]:=RconnNbr;
|
|
SendBroadcastMessage(message,1,ConnList,ResultList);
|
|
Checkerror(nwMess.result>0,$1000,'');
|
|
CheckError(ResultList[1]>0,$1000+ResultList[1],'');
|
|
|
|
IPXListenForPacket(ListenECB);
|
|
|
|
KeyNbr:=$ff;
|
|
ConnUp:=False;
|
|
FillChar(SendData,SizeOf(SendData),#0);
|
|
SendData[1]:=Hi(MyConnNbr);
|
|
SendData[2]:=Lo(MyConnNbr);
|
|
Move(MyServerName[1],SendData[3],ord(MyserverName[0]));
|
|
Move(MyName[1],SendData[50],ord(Myname[0]));
|
|
|
|
repeat { send a packet every 4 seconds and a broadcast message every 30 seconds }
|
|
gotoxy(x,y);
|
|
write(Progress[ProgressInd]);
|
|
inc(ProgressInd);
|
|
if ProgressInd > 4
|
|
then begin
|
|
ProgressInd:=1;
|
|
IPXSendPacket(SendECB);
|
|
end;
|
|
inc(SecondInd);
|
|
if SecondInd = 30
|
|
then begin
|
|
SendBroadcastMessage(message,1,ConnList,ResultList);
|
|
Checkerror(nwMess.result>0,$1000,'');
|
|
CheckError(ResultList[1]>0,$1000+ResultList[1],'');
|
|
SecondInd:=0;
|
|
end;
|
|
delay(1000);
|
|
if readflg
|
|
then begin
|
|
writeln('recieved a packet..');
|
|
if not SameAddress(ListenIPXheader.source,Raddress)
|
|
then begin
|
|
readflg:=false;
|
|
IPXListenForPacket(ListenECB);
|
|
end
|
|
else ConnUp:=TRUE;
|
|
end;
|
|
if keypressed
|
|
then KeyNbr:=ord(readkey);
|
|
|
|
until (KeyNbr = $1b) or ConnUp;
|
|
|
|
if KeyNbr = $1b
|
|
then begin
|
|
Writeln;
|
|
Write('Wait...');
|
|
Delay(5000);
|
|
SendData[1]:=$1b;
|
|
IPXSendPacket(SendECB);
|
|
message:='The user phoning you canceled the call... ['+Time+']';
|
|
SendBroadcastMessage(message,1,ConnList,ResultList);
|
|
IpxCloseSocket(Socket);
|
|
SetPreferredConnectionID(MyServerId);
|
|
halt(1);
|
|
end;
|
|
Writeln;
|
|
Write('User ',Rname,' answered your call......!');
|
|
delay(1200);
|
|
ReadFlg:=false;
|
|
end;
|
|
|
|
{--------------------------------------------------------------------------}
|
|
|
|
Procedure HandshakeWithSender;
|
|
const Progress:Array [1..4] of char = ('/','Ä','\','|');
|
|
Var p :Byte;
|
|
ObjType :Word;
|
|
ObjId :LongInt;
|
|
LoginTime:TnovTime;
|
|
ticks :Word;
|
|
x,y :Word;
|
|
begin
|
|
Writeln('Listening for calls..');
|
|
Write('Press <ESC> to cancel [ ]');
|
|
x:=wherex-2; y:=wherey;
|
|
IPXListenForPacket(ListenECB);
|
|
p:=1;
|
|
while(p<=4) and (not ReadFlg)
|
|
do begin
|
|
gotoxy(x,y);
|
|
write(Progress[p]);
|
|
delay(1200);
|
|
inc(p);
|
|
end;
|
|
If not readflg
|
|
then begin
|
|
Writeln;
|
|
Writeln('Nobody is Calling you..........');
|
|
writeln;
|
|
writeln('( PHONE ? for help )');
|
|
IpxCloseSocket(Socket);
|
|
SetPreferredConnectionId(MyServerId);
|
|
halt(1);
|
|
end
|
|
else begin
|
|
readflg:=false;
|
|
Raddress:=ListenIPXheader.source;
|
|
Raddress.socket:=Socket;
|
|
RconnNbr:=(ReadData[1]*256)+ReadData[2];
|
|
ZstrCopy(RserverName,ReadData[3],47);
|
|
ZstrCopy(Rname,ReadData[50],47);
|
|
IPXGetLocalTarget(Raddress,LocalTarget,ticks);
|
|
IPXSetupSendECB(NIL, Socket, Raddress,
|
|
Addr(SendData), SizeOf(SendData),
|
|
SendIPXheader,SendECB);
|
|
IPXSendPacket(SendECB); { acknowledge by sending a packet. Packet contents unimportant. }
|
|
end;
|
|
end;
|
|
|
|
|
|
{-----------------------------------------------------------------------------}
|
|
|
|
Procedure InitWindows;
|
|
Var i: Byte;
|
|
begin
|
|
ClrScr;
|
|
myx:=1; myy:=1;
|
|
gotoxy(1,1);
|
|
write('É'); for i:=2 to 79 do write('Í'); write('»');
|
|
write('º'); for i:=2 to 79 do write(' '); write('º');
|
|
|
|
gotoxy(3,2);
|
|
Write('User: '+MyName+' ° Server: '+MyServerName);
|
|
write(' ° Connection: '); write(MyConnNbr);
|
|
gotoxy(1,3);
|
|
write('È'); for i:=2 to 79 do write('Í'); write('¼');
|
|
|
|
gotoxy(1,13);
|
|
write('É'); for i:=2 to 79 do write('Í'); write('»');
|
|
write('º'); for i:=2 to 79 do write(' '); write('º');
|
|
|
|
gotoxy(3,14);
|
|
Write('User: '+Rname+' ° Server: '+RserverName);
|
|
Write(' ° Connection: '); write(RconnNbr);
|
|
Gotoxy(1,15);
|
|
write('È'); for i:=2 to 79 do write('Í'); write('¼');
|
|
|
|
gotoxy(26,25);
|
|
Write('±±±²²² Phone Utility ²²²±±±');
|
|
gotoxy(1,1);
|
|
HighVideo;
|
|
end;
|
|
|
|
{-----------------------------------------------------------------------------}
|
|
|
|
Procedure Talk;
|
|
|
|
Function Timeout(w1,w2:Word;sec:Byte):Boolean;
|
|
Var lw2:Longint;
|
|
begin
|
|
if w2<w1
|
|
then lw2:=$10000+w2
|
|
else lw2:=w2;
|
|
Timeout:=((lw2-w1) DIV 18)>sec;
|
|
end;
|
|
|
|
Procedure MyWindow;
|
|
begin
|
|
Window(1,5,80,12);
|
|
gotoxy(myx,myy);
|
|
end;
|
|
|
|
Procedure RemoteWindow;
|
|
begin
|
|
Window(1,17,80,24);
|
|
end;
|
|
|
|
|
|
Var currMarker,
|
|
SendMarker,
|
|
ListenMarker:Word;
|
|
ch :Char;
|
|
RlastChar,
|
|
RlastX,
|
|
RlastY :byte;
|
|
begin
|
|
MyWindow;
|
|
IPXListenForPacket(ListenECB);
|
|
IPXSetupSendECB(NIL, Socket, Raddress, Addr(SendData), 7,
|
|
SendIPXheader,SendECB); { make size of sendBuffer smaller }
|
|
IPXgetIntervalMarker(SendMarker);
|
|
ListenMarker:=SendMarker;
|
|
SendData[1]:=$FF;
|
|
RlastChar:=$FF;
|
|
|
|
REPEAT
|
|
if keypressed
|
|
then begin
|
|
MyWindow;
|
|
SendData[4]:=SendData[1]; { append last typed char to packet. }
|
|
SendData[5]:=SendData[2]; { original packet may have been lost }
|
|
SendData[6]:=SendData[3]; { Remember: IPX is unreliable ! }
|
|
ch:=readkey;
|
|
if ch=#0
|
|
then begin
|
|
ch:=readkey;
|
|
CASE ord(ch) of
|
|
75:begin { <- 'cursor left' }
|
|
SendData[2]:=myx-1;
|
|
if (myx=1) then SendData[2]:=1;
|
|
gotoxy(SendData[2],myy);
|
|
SendData[3]:=myy;
|
|
SendData[1]:=$00;
|
|
end;
|
|
77:begin { -> 'cursor right' }
|
|
SendData[2]:=myx+1;
|
|
if (myx=80) then SendData[2]:=80;
|
|
gotoxy(SendData[2],myy);
|
|
SendData[3]:=myy;
|
|
SendData[1]:=$00;
|
|
end;
|
|
else SendData[1]:=$FF;
|
|
end; {case}
|
|
|
|
end
|
|
else begin
|
|
SendData[1]:=ord(ch);
|
|
SendData[2]:=myx;
|
|
SendData[3]:=myy;
|
|
Case ord(SendData[1]) of
|
|
8 :write(#8+#$20+#8); { backspace }
|
|
13:writeln; { return }
|
|
else write(chr(SendData[1]));
|
|
end; {case}
|
|
end;
|
|
myx:=wherex;
|
|
myy:=wherey;
|
|
IPXSendPacket(SendECB); { send current and previous char }
|
|
IPXGetIntervalMarker(SendMarker);
|
|
end;
|
|
|
|
if readflg
|
|
then begin
|
|
If SameAddress(ListenIPXheader.source,Raddress)
|
|
then begin
|
|
if (readData[4]<>$FF)
|
|
and ( (readData[4]<>RlastChar)
|
|
or (readData[5]<>Rlastx)
|
|
or (readData[6]<>Rlasty)
|
|
)
|
|
then begin { if we missed a packet, display char now }
|
|
RemoteWindow;
|
|
Gotoxy(ReadData[5],ReadData[6]);
|
|
CASE ReadData[4] of
|
|
0:begin { don't print, cursor movement only }
|
|
end;
|
|
8:write(#8+#$20+#8); { backspace }
|
|
13:writeln; { return }
|
|
else write(chr(ReadData[1]));
|
|
end;{case}
|
|
end;
|
|
|
|
if ReadData[1]<>$FF
|
|
then begin
|
|
RemoteWindow;
|
|
Gotoxy(ReadData[2],ReadData[3]);
|
|
CASE ReadData[1] of
|
|
0:begin { don't print, cursor movement only }
|
|
end;
|
|
8:write(#8+#$20+#8);
|
|
13:writeln;
|
|
else write(chr(ReadData[1]));
|
|
end;{case}
|
|
end;
|
|
RlastChar:=ReadData[1];
|
|
RlastX :=ReadData[2];
|
|
RlastY :=ReadData[3];
|
|
IPXGetIntervalMarker(ListenMarker);
|
|
end;
|
|
readflg:=false;
|
|
IPXListenForPacket(ListenECB);
|
|
end;
|
|
|
|
IPXRelinquishControl;
|
|
IPXGetIntervalMarker(currMarker);
|
|
IF Timeout(SendMarker,currMarker,5) { send an "I'm alive" msg after 5 idle secs }
|
|
then begin
|
|
SendData[4]:=SendData[1]; { redundant info: append last char to packet. }
|
|
SendData[5]:=SendData[2];
|
|
SendData[6]:=SendData[3];
|
|
SendData[1]:=$FF;
|
|
IPXSendPacket(SendECB);
|
|
IPXGetIntervalMarker(SendMarker);
|
|
end;
|
|
IF Timeout(ListenMarker,currMarker,17) { fake an "hang-up" if no msgs received during 17 secs }
|
|
then begin
|
|
ReadData[1]:=$1B;
|
|
RemoteWindow;
|
|
end;
|
|
UNTIL (ReadData[1]=$1b) or (SendData[1]=$1b); { .. until either party has hung up }
|
|
|
|
SendData[1]:=$1b;
|
|
IPXSendPacket(SendECB);
|
|
IpxCloseSocket(Socket);
|
|
Writeln;
|
|
Writeln;
|
|
writeln('<Hanging Up...........>');
|
|
Delay(2000);
|
|
Window(1,1,80,25);
|
|
LowVideo;
|
|
gotoxy(80,25);
|
|
end;
|
|
|
|
{--------------- ProcessInputCommand----------------------------------------}
|
|
|
|
Type PusrInfo=^TusrInfo;
|
|
TusrInfo=record
|
|
ObjName :String[47];
|
|
FullName:String[40];
|
|
ConnId,
|
|
ConnNbr :Byte;
|
|
Address :TinterNetworkAddress; { socket field not used }
|
|
next :PusrInfo;
|
|
end;
|
|
|
|
Var startInfo:PusrInfo;
|
|
|
|
Procedure PushInLL(_objName,_objFullName:String;
|
|
_connId,_connNbr:Byte;
|
|
_address:TinternetworkAddress);
|
|
Var p,m,l:PusrInfo;
|
|
begin
|
|
p:=startInfo;
|
|
new(l);
|
|
With l^
|
|
do begin
|
|
if _objFullName[0]>#40
|
|
then _objFullName[0]:=#40;
|
|
objName:=_objName;
|
|
fullName:=_objFullName;
|
|
connId:=_connId;
|
|
connNbr:=_connNbr;
|
|
address:=_address;
|
|
next:=NIL;
|
|
end;
|
|
if p=NIL
|
|
then startInfo:=l
|
|
else begin
|
|
m:=p;
|
|
While (p<>NIL) and (p^.objName<=_obJname)
|
|
do begin m:=p;p:=p^.next; end;
|
|
if p=startInfo
|
|
then begin { insert before first LL entry }
|
|
l^.next:=startInfo;
|
|
startInfo:=l;
|
|
end
|
|
else begin { insert in LL or append to end }
|
|
l^.next:=m^.next;
|
|
m^.next:=l;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
Function GetTargetUser:PusrInfo;
|
|
{ returns NIL if a target user was not uniquely identified by the user }
|
|
Var l :PusrInfo;
|
|
serverName :String;
|
|
SelectedUsers:Word;
|
|
t :Word;
|
|
s :String;
|
|
ch :char;
|
|
Laddr :TinternetworkAddress;
|
|
AddrSame :boolean;
|
|
begin
|
|
{ are all objNames the same?
|
|
Yes => multple logins (connNbr must have been supplied)
|
|
or login on multiple servers (serverName must h.b. supplied)
|
|
No => the supplied userName is not unique. }
|
|
l:=startInfo;
|
|
SelectedUsers:=0;
|
|
IF l<>NIL
|
|
then Laddr:=l^.address;
|
|
AddrSame:=true;
|
|
While (l<>NIL)
|
|
do begin
|
|
inc(SelectedUsers);
|
|
AddrSame:=AddrSame and SameAddress(Laddr,l^.address);
|
|
l:=l^.next;
|
|
end;
|
|
If AddrSame { are all the users essentially the same ? }
|
|
then SelectedUsers:=1;
|
|
|
|
CASE SelectedUsers of
|
|
0:begin
|
|
GetTargetUser:=NIL;
|
|
end;
|
|
1:begin { OK! unique users identified }
|
|
GetTargetUser:=StartInfo;
|
|
end;
|
|
else begin
|
|
writeln('The target user has multiple connections.');
|
|
writeln('Please give connection number and/or server name of the intended user.');
|
|
writeln;
|
|
writeln('Username | Server | Con | Full Name');
|
|
writeln('---------------------+-----------------+-----+----------------------');
|
|
|
|
t:=3;
|
|
l:=startInfo;
|
|
while l<>NIL
|
|
do begin
|
|
GetFileServerName(l^.connId,servername);
|
|
PstrCopy(s,l^.objName,20);
|
|
write(s,' | ');
|
|
PstrCopy(s,serverName,15);
|
|
write(s,' | ',l^.connNbr:3,' | ');
|
|
PstrCopy(s,l^.fullname,30);
|
|
writeln(s);
|
|
l:=l^.next;
|
|
inc(t);
|
|
if t=20
|
|
then begin
|
|
writeln('--- more (any key)---');
|
|
repeat {} until keypressed;
|
|
ch:=readkey;
|
|
if ch=#0 then ch:=readkey;
|
|
t:=0;
|
|
end;
|
|
end;
|
|
GetTargetUser:=NIL;
|
|
end;
|
|
end; {case}
|
|
end;
|
|
|
|
Procedure ProcessInputCommand;
|
|
Var SearchStartServer,
|
|
SearchEndServer :Byte;
|
|
ConnIdCtr,
|
|
ConnNbrCtr :Byte;
|
|
|
|
LuserName,
|
|
LserverName :String;
|
|
LconnId :Byte;
|
|
LfullName :String;
|
|
LconnNbr :Byte;
|
|
|
|
ServerInfo :TFileServerInformation;
|
|
objName :String;
|
|
objType :Word;
|
|
objId :Longint;
|
|
ticks :Word;
|
|
LoginTime :TnovTime;
|
|
IntNWaddress :TinternetworkAddress;
|
|
|
|
TargetUserPtr :PusrInfo;
|
|
|
|
p :Byte;
|
|
errcode :Integer;
|
|
begin
|
|
StartInfo:=NIL;
|
|
If (ParamCount>0)
|
|
and ( (pos('?',paramstr(1))>0)
|
|
or (pos('help',paramstr(1))>0)
|
|
or (pos('HELP',paramstr(1))>0)
|
|
)
|
|
then begin
|
|
writeln;
|
|
writeln('** Phone V 1.3., By E.M. Serrat and R. Spronk');
|
|
writeln;
|
|
writeln('** Usage: PHONE');
|
|
writeln;
|
|
writeln('Listen for others calling you.');
|
|
writeln;
|
|
writeln;
|
|
writeln('** Usage: PHONE [servername/]UserName [connection]');
|
|
writeln;
|
|
writeln('Call someone.');
|
|
writeln('-Username may be a ''*'' wildcard.');
|
|
writeln(' All logged in users on all attached servers will be shown.');
|
|
writeln('-Sender and receiver must be attached to a common server in the internetwork.');
|
|
writeln('-The supplied username is compared with the first characters of');
|
|
writeln(' the login name and with the full user name, as set by SYSCON.');
|
|
writeln('-Servername must be supplied if the target user has connections');
|
|
writeln(' with more than one server.');
|
|
writeln('-ConnectionNumber must be supplied if the target user is logged in');
|
|
writeln(' at multiple workstations attached to the same server.');
|
|
writeln;
|
|
writeln('The program will timeout if the program on the other end of the link');
|
|
writeln('is terminated abnormally.');
|
|
halt(1);
|
|
end;
|
|
if paramcount=0 { ---- Listen if anyone is calling us ----- }
|
|
then begin
|
|
HandshakeWithSender;
|
|
InitWindows;
|
|
Talk;
|
|
IpxCloseSocket(Socket);
|
|
SetPreferredConnectionId(MyServerId);
|
|
halt(0);
|
|
end;
|
|
{ ** Paramcount>0, We're calling someone ** }
|
|
LconnNbr:=0;
|
|
SearchStartServer:=1;
|
|
SearchEndServer:=8;
|
|
LuserName:=ParamStr(1);
|
|
UpString(LuserName);
|
|
p:=pos('/',LuserName);
|
|
checkError((p=1) and (LuserName[0]=#1),$0020,'');
|
|
if p>0
|
|
then begin
|
|
LserverName:=copy(LuserName,1,p-1);
|
|
delete(LuserName,1,p);
|
|
if LuserName=''
|
|
then LuserName:='*';
|
|
if pos('*',LserverName)=0
|
|
then begin
|
|
GetConnectionId(LserverName,LconnId);
|
|
checkError(nwConn.result>0,$0022,LserverName);
|
|
SearchStartServer:=LconnId;
|
|
SearchEndServer:=LconnId;
|
|
end;
|
|
end;
|
|
if paramcount>1
|
|
then begin
|
|
Val(ParamStr(2),LconnNbr,errcode);
|
|
checkError(errcode<>0,$0023,Paramstr(2));
|
|
end;
|
|
|
|
writeln('Scanning logged in users..');
|
|
ConnIdCtr:=SearchStartServer;
|
|
While ConnIdCtr<=SearchEndServer
|
|
do begin
|
|
If IsConnectionIdInUse(ConnIdCtr)
|
|
then begin
|
|
SetPreferredConnectionId(ConnIdCtr);
|
|
IF NOT GetFileServerInformation(ServerInfo)
|
|
then ServerInfo.connectionsMax:=250; { patch value if call failed }
|
|
for ConnNbrCtr:=1 to ServerInfo.ConnectionsMax
|
|
do begin
|
|
IF GetConnectionInformation(ConnNbrCtr,ObjName,objType,objId,LoginTime)
|
|
and (objType=OT_USER)
|
|
then begin
|
|
GetInterNetAddress(ConnNbrCtr,IntNWaddress);
|
|
GetRealUserName(ObjName,LfullName);
|
|
UpString(LfullName);
|
|
IF (pos('NOT-LOGGED-',objName)=0) { skip not logged in connections }
|
|
and ((LconnNbr=0) or (LconnNbr=ConnNbrCtr)) { if user supplied connNbr, check it }
|
|
and (NOT SameAddress(MyAddress,IntNWAddress)) { no mail to yourself }
|
|
and ( (LuserName[1]='*') { wildcard overrules nameselection }
|
|
or (pos(LuserName,ObjName)=1) { username matched with firts few characters in objName? }
|
|
or (pos(LuserName,LfullName)>0) { usermane matches part of objects' Full_Name ? }
|
|
)
|
|
then PushInLL(objName,LfullName,ConnIdCtr,ConnNbrCtr,
|
|
IntNWaddress);
|
|
end;
|
|
end;
|
|
end;
|
|
inc(ConnIdCtr);
|
|
end;
|
|
TargetUserPtr:=GetTargetUser;
|
|
checkError((LuserName[1]<>'*') and (TargetUserPtr=NIL),$0025,''); { No user selected }
|
|
checkError(TargetUserPtr=NIL,$0026,'');
|
|
RconnNbr:=TargetUserPtr^.connNbr;
|
|
Raddress:=TargetUserPtr^.address;
|
|
Raddress.Socket:=Socket;
|
|
Rname:=TargetUserPtr^.objName;
|
|
RserverId:=TargetUserPtr^.connId;
|
|
GetFileServerName(RserverId,RserverName);
|
|
release(HeapCheckPtr);
|
|
|
|
SetPreferredConnectionId(RserverId);
|
|
GetRealUserName(Rname,RfullName);
|
|
writeln;
|
|
writeln(RserverName,'/',Rname,' Connection_Number= ',RconnNbr);
|
|
writeln('(Full name =',RfullName,')');
|
|
writeln;
|
|
write('Is the above user the intended chat partner ? (Y/N)');
|
|
checkError(NOT Confirm,$0027,''); { user abort }
|
|
writeln;
|
|
|
|
IPXGetLocalTarget(Raddress,LocalTarget,ticks);
|
|
IPXSetupSendECB(NIL, Socket, Raddress, Addr(SendData), SizeOf(SendData),
|
|
SendIPXheader,SendECB);
|
|
HandShakeWithReceiver;
|
|
InitWindows;
|
|
Talk;
|
|
IpxCloseSocket(Socket);
|
|
SetPreferredConnectionId(MyServerId);
|
|
halt(0);
|
|
end;
|
|
|
|
Procedure WhoAmI; {---------------------------------------------------------}
|
|
Var ObjType :Word;
|
|
ObjId :LongInt;
|
|
LogonTime:TnovTime;
|
|
begin
|
|
GetConnectionNumber(MyConnNbr);
|
|
checkError(nwConn.result>0,$0010,'');
|
|
GetInternetAddress(MyConnNbr,MyAddress);
|
|
checkError(nwConn.result>0,$0011,'');
|
|
MyAddress.Socket:=Socket;
|
|
GetConnectionInformation(MyConnNbr,MyName,ObjType,ObjId,LogonTime);
|
|
checkError(nwConn.result>0,$0012,'');
|
|
GetEffectiveConnectionID(MyServerId);
|
|
GetFileServerName(MyServerId,MyServerName);
|
|
end;
|
|
|
|
{-----------------------------------------------------------------------------}
|
|
Var LocSocket:Word;
|
|
|
|
begin
|
|
Writeln('*** PHONE V1.3 ***');
|
|
Mark(HeapCheckPtr);
|
|
LocSocket:=Socket;
|
|
readflg:=false;
|
|
Checkerror(NOT IpxPresent,$0001,'');
|
|
IpxOpenSocket(LocSocket,FALSE);
|
|
Checkerror(nwIPX.result>0,$0002,'');
|
|
WhoAmI;
|
|
IPXSetupListenECB(Addr(EsrHandler),socket,Addr(ReadData),SizeOf(ReadData),
|
|
ListenIPXheader,ListenECB);
|
|
ProcessInputCommand; {doesn't return}
|
|
end. |