Category : Pascal Source Code
Archive   : PASFONE.ZIP
Filename : PASFONE.PAS
{$F+}
{This simple unit accepts user input to dial Hayes compatible modems.
The phone number may be numeric or alpha (acronyms) or a mix of both.
It is an extension of something I downloaded with no ID attached.
Bios interrupt $14 is used to send characters to the serial port.
The interrupt will return information in register ah, and al if
your interested in checking them. A good bios services reference
will contain the return codes
This should work on IBM pc's and compatibles.
If you have trouble communicating with the serial port, check and change
as needed the value assigned to register 'dl' as noted.
It selects the COM port which is connected to the modem
Number formats accepted are:
1) aaa-aaaa
2) (aaa) aaa-aaaa
3) aaa-aaa-aaaa
4) 1-aaa-aaa-aaaa
5) 1-aaa-aaaa
All other formats are rejected as invalid numbers.
The proc will insert a leading '1' prolog if necessary.
Communications ports 1 through 4 are valid.
After the modem dials and is off hook:
1. To activate the phone, pickup the phone and press [Enter].
2. If you leave the phone on the cradle and press a key, the
modem will hang up and the program will continue.
3. If the phone is off the cradle and you press a key, the
program will continue, and you will have control of the
phone.
I added a few accessory routines to illustrate usage
{====================================}
{ Any helpful suggestion contact: }
{ Ed Cuneo }
{ Renaissance Software and Systems }
{ 1428 Dauphin Lane }
{ Orlando, Fl 32803-1802 }
{ (407) 896-1206 }
{ CompuServ ID: 71620,2211 }
{ Programmer's Corner ID: 1011 }
{====================================}
interface
uses dos,crt;
type str80 =string[80];
var
dialpak: registers; {regipak; }
Bah,Bal,Bdh,Bdl: byte;
portnum,dispcol,disprow : integer;
pnumb : str80;
function upcasestr(s: string): string;
procedure msg(msgstr:string;var dispcol,disprow:integer);
procedure dialnum(port:integer;num:str80);
function convert_alpha(TNumbr:string):string;
function parsepnumb(num:string):boolean;
function check_length(p1,p2,p3:string):boolean;
procedure Send_Char;
procedure send_Num(Num:str80);
procedure send_Code(InStr:str80);
procedure setup;
procedure pickphone;
implementation
function upcasestr(s: string): string; {change to uppercase}
var
result: string;
i: integer;
begin
result := '';
for i := 1 to length(s) do
result := result + upcase(s[i]);
upcasestr := result;
end;
procedure movecursor;
{move cursor to position 0,25 making it invisible }
{on the screen }
{I like this uncomplicated method of doing this }
{not only is it fast but you need only move the }
{cursor to a rational screen position to make it }
{visible again}
begin
asm
xor bh,bh {select page 0}
mov ah,2 {specify set cursor routine number}
mov dh,25 {load row}
mov dl,0 {load column}
int 10h {call bios video service}
end;
end;
procedure msg(msgstr:string;var dispcol,disprow:integer); {write a message}
begin
clrscr;
textbackground(red);
textcolor(White);
gotoxy(dispcol,disprow);
write(msgstr);
movecursor;
delay(1500);
end;
function convert_alpha(TNumbr:string):string;
{======================================================}
{ convert all alpha strings to phone number }
{ TNumbr -> phone number from calling routine }
{ n -> loop counter }
{ c -> character obtained from phone number }
{ pnumb -> phone number after conversion }
{======================================================}
var
n:integer;
c:string[1];
const
ok:boolean=true;
begin
pnumb:='';
if tnumbr='' then ok:=not ok;
if ok then
begin
for n:=1 to length(TNumbr) do
begin
c:=copy(TNumbr,n,1); {get a single character from the number}
if pos(' ',c)=0 then {if it's not a space, try to convert it}
begin
c:=upcasestr(c); { convert alpha strings to appropriate digits}
case c[1] of
'A'..'C':c:='2';
'D'..'F':c:='3';
'G'..'I':c:='4';
'J'..'L':c:='5';
'M'..'O':c:='6';
'P'..'S':c:='7';
'T'..'V':c:='8';
'W'..'Y':c:='9';
end;
end;
pnumb:=pnumb+c {add converted char to string}
end;
end;
if ok then convert_alpha:=pnumb {return converted number part of string}
else convert_alpha:= ''; {signal error,i.e nothing to dial}
end;
function parsepnumb(num:string):boolean;
{======================================}
{Break number into constituent parts. }
{Validate length of parts. }
{Construct dialable number adding '1' }
{prologue where needed. }
{Return boolean true if a good number. }
{======================================}
var
p1,p2,p3 : string;
ch : string[1];
x : byte;
begin
ch:=copy(pnumb,1,1);
case ch[1] of
'(':begin
p1:=copy(pnumb,2,3);
if pos('-',pnumb)=10 then
begin
p2:=copy(pnumb,7,3);
p3:=copy(pnumb,11,4)
end;
if check_length(p1,p2,p3)=true then
begin
pnumb:='1'+p1+p2+p3;
parsepnumb:=true;
end
else
parsepnumb:=false;
end;
'1':begin
ch:=copy(pnumb,10,1);
if ch='-' then
begin
p1:=copy(pnumb,3,3);
p2:=copy(pnumb,7,3);
p3:=copy(pnumb,11,4)
end
else
begin
p1:='';
p2:=copy(pnumb,3,3);
p3:=copy(pnumb,7,4)
end;
if check_length(p1,p2,p3)=true then
begin
pnumb:='1'+p1+p2+p3;
parsepnumb:=true;
end
else
parsepnumb:=false;
end;
'2'..'9':begin
p2:=copy(pnumb,1,3);
if pos('-',pnumb)=8 then
begin
p1:=copy(pnumb,1,3);
p2:=copy(pnumb,5,3);
p3:=copy(pnumb,9,4);
if check_length(p1,p2,p3)=true then
begin
pnumb:='1'+p1+p2+p3;
parsepnumb:=true;
end
else
parsepnumb:=false;
end
else
begin
p1:='';
if pos('-',pnumb)=4 then
p3:=copy(pnumb,5,4)
else
p3:=copy(pnumb,4,4);
if check_length(p1,p2,p3) then
begin
pnumb:=p2+p3;
parsepnumb:=true;
end
else
parsepnumb:=false;
end;
end;
end;
end;
function check_length(p1,p2,p3:string):boolean;
{====================================}
{Check number of digits in number }
{p1 could be blank if TNumbr is local}
{if p1 is not blank, then its length }
{must be 3. }
{the length of p2 is always 3 }
{the length of p3 is always 4 }
{====================================}
begin
if ((p1<>'') and (length(p1)<>3)) or
(length(p2)<>3) or (length(p3)<>4 )
then
check_length:=false
else
check_length:=true;
end;
procedure Send_Char;
{Send a character to the modem}
begin
with dialpak do
begin
ax := Bah shl 8 + Bal;
dx := Bdh shl 8 + Bdl;
intr($14,dialpak);
end;
end;
procedure send_Num(Num:str80);
{======================================================}
{add control code }
{Break the number into characters and send }
{finish number with ascii character 13 to cause dialup }
{======================================================}
var
ct : integer;
number :string[40];
digit : char;
begin
number:='ATL1DT'+Num+chr(13);
for ct:=1 to length(number) do
begin
digit:=number[ct];
Bal:=ord(digit); {character to send}
Bah:=1; {send one character}
Bdl:=portnum-1; {port number(0 or 1}
Send_Char;
end;
end;
procedure send_Code(InStr:str80);
{===========================================}
{send inividual command codes to serial port}
{===========================================}
var
ct : integer;
digit : char;
begin
for ct:=1 to length(instr) do
begin
digit:=InStr[ct];
Bal:=ord(digit); {character to send}
Bah:=1; {send one character}
Bdl:=portnum-1; {port number(0 or 1}
Send_Char;
end;
end;
procedure setup;
{========================================================}
{initialize serial port using interrupt $14 }
{dx=serial port number 0 or 1 }
{al=control bits }
{bits 00 and 01 = word length (11=8,10=7) }
{bit 02 = stop bits (0=1,1=2) }
{bits 03 and 04 = parity (00,10=none 01=odd 11=even)}
{bits 05 to 07 = baud rate }
{000=110,001=150,010=300,011=600 }
{100=1200,101=2400,110=4800,111=9600 }
{========================================================}
begin
Bdh:=0;
Bah:=0;
Bdl:=0;
Bal:=231;
Send_Char;
Bah:=4;
Bdl:=portnum-1; {port number(0 or 1}
Send_Char;
end;
procedure pickphone;
begin
msg('Pick up the phone and press a key to talk.',dispcol,disprow);
readln;
end;
{main}
procedure dialnum(port:integer;num:str80);
begin
dispcol:=1; {these are placed here for illustrative purposes }
disprow:=24; {you will want to put the messages where appropriate}
if convert_alpha(num)='' then
msg('No number available to dial',dispcol,disprow)
else
begin
if parsepnumb(pnumb)=false then
msg(num+' is not a valid phone number...',dispcol,disprow)
else
begin
portnum:=port;
setup;
send_num(pnumb);
pickphone;
send_code('H0'); {hang up line}
end
end;
end;
end.
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/