[Back to NETWORK SWAG index] [Back to Main SWAG index] [Original]
{
Program Name : Phone.Pas
Written By : Anonymous
E-Mail : nothing
Web Page : nothing
Program
Compilation : Turbo Pascal 5.0 or later
Program Description :
Usefulness for BBS'S and general communications.
For a detailed description of this code source, please,
read the file TENTOOLS.DOC. Thank you
}
Program Phone;
{$F+}
Uses CRT,TenTools;
Type
S80 = String[80];
Var
RemoteID : S12;
Caller : S12;
NodeID : S12;
SendCount,I,TransType,Msgs : INteger;
TransID : Real;
SendString : S80;
RcvString : S80;
RcvLength : Integer;
TenError : Word;
Connect,Hangup,BeingCalled,Calling,CBMess : Boolean;
X,Y,Gar : Integer;
SendKey,SpecChar,Inchar : Char;
Procedure Ring;
Begin
ClrScr;
GotoXY(1,1);Write('With which node do you wish to converse: ');
Readln(RemoteID);
While Length(RemoteID)<12 do RemoteID:=RemoteID+' ';
For I:=1 to 12 do RemoteID[I]:=Upcase(RemoteID[I]);
ClrScr;
SendString:='You are being "PHONE"ed...';
TenError:=Chat(RemoteID,SendString);
If TenError<>0
then
begin
Writeln('Error Chatting...',TenError);
Halt;
end;
SendCount:=0;
TenError:=TBSend(RemoteID,SendString,Length(SendString)+1,SendCount,17,0);
SendString:='';
Window(1,1,80,25);
GotoXY(1,25);
TextColor(White);
Write(
'Ringing ',RemoteID,' (A)bort ');
ClrEol;
Caller:=RemoteID;
Calling:=True;
End;
Procedure Ignore;
Begin
SendString:='Cannot Talk Now...Sorry';
TenError:=TBSend(RemoteID,SendString,Length(SendString)+1,SendCount,18,0);
SendString:='';
Caller:='';
BeingCalled:=False;
Hangup:=True;
End;
Procedure Answer;
Begin
RemoteID:=Caller;
SendCount:=0;
SendString:='Responding...';
TenError:=TBSend(RemoteID,SendString,Length(SendString)+1,SendCount,17,0);
SendString:='';
If TenError<>0
then
begin
Writeln('Error Sending String to ',Caller);
Halt;
end;
End;
Procedure ClearBuffers;
Begin
Repeat
TenError:=TBReceive(RemoteID,RcvString,RcvLength,TransID,TransType,Msgs,CBMess);
Until Msgs=0;
End;
Procedure Communicate;
Begin
X:=1;
Y:=11;
TextColor(White);
Window(1,1,80,25);
GotoXY(1,25);
Write(
' Press [F1] to end Conversation');
GotoXY(1,12);
Write(
'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ ',Caller,' ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ');
Window(1,1,80,24);
Repeat
RcvLength:=0;
TenError:=TBReceive(RemoteID,RcvString,RcvLength,TransID,TransType,Msgs,CBMess);
{ If Msgs>0 then Delay(20); }
If ((TenError=0) and (Msgs>0))
then while ((TenError=0) and (Msgs>0)) do
begin
TextColor(Red);
Sound(1000);
Delay(40);
NoSound;
GotoXY(1,WhereY);
IF ((RemoteID=Caller)and(TransType=20))
then
begin
Window(1,13,80,24);
GotoXY(1,11);
Writeln('');
Writeln(RcvString);
end;
If ((RemoteID=Caller)and(TransType=19))
then
begin
Window(1,13,80,24);
GotoXY(1,11);
Writeln('');
Writeln(' ',RemoteID,' hung up!');
Write(' Press any key to Continue...');
InChar:=ReadKey;
Hangup:=True;
Calling:=False;
Connect:=False;
BeingCalled:=False;
Caller:='';
Msgs:=0;
end;
RcvString:='';
If not Hangup then
TenError:=TBReceive(RemoteID,RcvString,RcvLength,TransID,TransType,Msgs,CBMess);
If Msgs>0 then Delay(20);
If TenError<>0 then Writeln('10Net Error: ',TenError);
end;
If (Keypressed and not Hangup)
then
begin
SendKey:=ReadKey;
If SendKey=#0
then
begin
SpecCHar:=ReadKey;
If SpecCHar=#59
then
begin
Window(1,1,80,25);
GotoXY(1,25);
ClrEOL;
TextColor(White);
Write(
' (E)nd Communication (C)ontinue Communication');
Repeat
Inchar:=Upcase(Readkey);
Until (Inchar in ['E','C']);
If Inchar='E'
then
begin
Hangup:=True;
Connect:=False;
Caller:='';
GotoXY(1,25);
ClrEol;
Write(
' Ending Communication...please wait...');
SendString:='CLICK';
TenError:=TBSend(RemoteID,SendString,Length(SendString)+1,SendCount,19,0);
SendString:='';
Window(1,1,80,25);
ClrScr;
Calling:=False;
BeingCalled:=False;
end;
GotoXY(1,25);
ClrEol;
GotoXY(1,25);
If not Hangup then
Write(
' Press [F1] to end Conversation');
Window(1,1,80,24);
end
else Write(#7);
end
else if Sendkey=#13
then
begin
Window(1,1,80,11);
GotoXY(X,Y);
Writeln('');
X:=WhereX;
Y:=WhereY;
Inc(SendCount);
TenError:=TBSend(RemoteID,SendString,Length(SendString)+1,SendCount,20,0);
SendString:='';
end
else
begin
TextColor(Cyan);
Window(1,1,80,11);
GotoXY(X,Y);
SendString:=SendString+SendKey;
Write(SendKey);
X:=WhereX;
Y:=WhereY;
end;
end;
Until Hangup;
TextColor(White);
End;
Procedure ScreenCalls;
Begin
Repeat
TenError:=TBReceive(RemoteID,RcvString,RcvLength,TransID,TransType,Msgs,CBMess);
If Msgs>0 then Delay(20);
If Msgs>0
then
begin
If Calling
then
begin
If (RemoteID=Caller)
then
begin
If TransType=17 then Connect:=True;
If TransType=18
then
begin
GotoXY(1,25);
ClrEol;
Write(
' Call Refused...');
Sound(1000);
Delay(1000);
NoSound;
Hangup:=True;
Calling:=False;
end;
end;
end
else
begin
If ((TransType=17) and (Caller=''))
then Caller:=RemoteID;
end;
end;
Until (Msgs=0)
End;
Procedure ClearCalls;
Begin
Window(1,1,80,25);
ClrScr;
GotoXY(1,25);
Write('(R)ing someone (Q)uit');
Hangup:=False;
End;
Begin { Main }
TenError:=TenConfig(80,80,20);
If TenError<>0
then
Begin
Writeln('Error Configuring TenTools...',TenError);
Halt;
end;
Connect:=False;
BeingCalled:=False;
Calling:=False;
Hangup:=False;
TextBackground(Black);
TextColor(Cyan);
Window(1,1,80,25);
ClrScr;
{Main Menu}
ClearBuffers;
Repeat
ClearCalls;
Repeat
ScreenCalls;
If Connect
then Communicate
else if Keypressed
then
begin
Inchar:=Upcase(Readkey);
If not (Inchar in ['A','I','R','Q']) then Write(#7);
If ((Inchar='A') and BeingCalled)
then
begin
Answer;
Communicate;
end
else if ((Inchar='A')and Calling)
then
begin
Calling:=False;
Hangup:=True;
Caller:='';
end
else if Inchar='I'
then Ignore
else if Inchar='R'
then
begin
If Calling then Ignore;
Ring;
end
else
begin
Hangup:=True;
Sound(2000);
Delay(10);
NOsound;
end;
end
else if ((Caller<>'')and not (Calling or BeingCalled))
then
begin
BeingCalled:=True;
GotoXY(1,25);
Write('(R)ing someone (A)nswer (I)gnore (Q)uit');
end;
Until Hangup;
Until Inchar in ['Q','q'];
ClearBuffers;
End. { Program TenTAlk}
[Back to NETWORK SWAG index] [Back to Main SWAG index] [Original]