Category : BBS Programs+Doors
Archive   : TURBS85E.ZIP
Filename : COMMON1.PAS

UNIT Common1;

{$R+,S+} {2.1 MAKE "-" after debug!}
{$B+,V-}
{$D+,L+}

interface
USES CRT, DOS;

CONST Version = '0.85e(12-07-91)';
Buffer_Max = 4096;
Buffer_End = Buffer_Max;
numsects = 30; { determines how many sectors(areas) there are can be}
actsects : Byte = 1; { always the upload area}
maxmess = 200; { max messages in system is 8600 bytes 2.13}

TYPE
strtype = STRING[128];
line = STRING[90];
person = STRING[27];
name = STRING[14];
strg = STRING[90];

Str3 = String[3]; {0.81}
Str4 = String[4]; {2.12}
Str5 = String[5]; {2.13}
Str8 = String[8]; {2.13}
Str10 = STRING[10];
Str12 = String[12]; {2.12}
Str14 = String[14]; {2.11}
Str24 = String[24]; {0.81}
Str30 = String[30]; {11-22-91}
Str40 = String[40]; {2.11}
Str80 = String[80]; {11-20-91}
Str90 = String[90]; {2.11}

FUNCTION cdet: Boolean;
FUNCTION cts: Boolean; {11-19-91}
FUNCTION Recvchar:char;

FUNCTION inready: Boolean;
PROCEDURE charout(ch: Char); {Character output using word-wrap}
PROCEDURE outchar(cho: Char); {Character output without word-wrap}
FUNCTION timedin: Boolean;
FUNCTION allcaps(letters: Str90): Str90; {2.11}
FUNCTION getinput(prompt: line; maxleng: Byte; withecho: Boolean): line;
FUNCTION getstring(maxsize: Byte): Str90;
PROCEDURE clearsc;
PROCEDURE lineout(message: line);
PROCEDURE outline(message: line);
PROCEDURE resetbuff;
FUNCTION charin(withecho: Boolean): Char;
PROCEDURE disconnect;
FUNCTION GetInt(nmax, star: Integer; prompt: line): Integer; {0.82}
FUNCTION GetWord(nmax, star: Word; prompt: line): Word; {2.13}
FUNCTION GetByte(nmax, star: Byte; prompt: line): Byte; {2.13}
PROCEDURE stringout(message: line);
PROCEDURE outstring(message: line);
{FUNCTION findid(caller: person; VAR pasrec: userec): Word;} {11-21-91}
FUNCTION outfile(fname: Str40; clrfirst: Boolean): Boolean; {11-23-91}
PROCEDURE checktime;
FUNCTION getcap(prompt: line) : Char;
FUNCTION showfile(fname: Str40; wclr: Boolean): Boolean;
PROCEDURE setup; {Hardware initializion for system to start BBS program}
PROCEDURE awaitcall;
PROCEDURE Flush;
PROCEDURE getcomments(maxline : Byte); {11-23-91}
PROCEDURE SoftAlarm;
PROCEDURE sendout(ch: Char);
PROCEDURE hangup; {lowers RTS line for 500ms }
PROCEDURE nl(lines: Byte);
PROCEDURE connecttime;
FUNCTION inputstring(maxchar: Byte; withecho: Boolean): line; {0.81}
PROCEDURE showtime;
PROCEDURE dispinfo;
PROCEDURE pausescr;
FUNCTION timer:longint;
FUNCTION time:Str5; {2.13}
FUNCTION daten:Str8; {2.13}
FUNCTION CstrB(i:Byte): Str8; {11-24-91 New}
FUNCTION cstr(i:integer):Str8;
FUNCTION CstrW(i: Word): Str8;
PROCEDURE iport;
PROCEDURE term_ready(s:Boolean); { the DTR control procedure }
PROCEDURE remove_port;
PROCEDURE xmitchar(ch: Char);
PROCEDURE xmitstring(thestring: Line);
PROCEDURE dump;
PROCEDURE SysLogWrt(systext: Str90); {0.81}
{PROCEDURE sysoponly;} {11-24-91}
PROCEDURE readcomments; {11-24-91 No longer nested}
PROCEDURE changelevel; {11-24-91 no longer nested}
FUNCTION GetKey(thelist:Str40; hot:Boolean): Char;
PROCEDURE savedefaults;
PROCEDURE ChkDef; {11-24-91}
FUNCTION daynum(dt: Str8): Word;{0.85d}
PROCEDURE DROPDOS; {0.85e major changes}

CONST
tab = #9;
f1 = #59;
f2 = #60;
f3 = #61;
f4 = #62;
f5 = #63;
f6 = #64;
f7 = #65;
f8 = #66;
f9 = #67;
f10 = #68;
cs = #12;
bs = #8;
pause = #19;
ring = #50; {11-22-91}
abort = #3;
noecho = false;
cr = #13; {0.81}
lf = #10; {0.81}
null = #0;
space = #32;
echo = True;
twit = 6;
sysop = 5;
paying = 4;
contrib = 3;
reg = 2;
newuser = 1;
deluser = 0;
bl = #7;

dobs: Str4 = #8+#32+#8; {2.12}
crlf: Str4 = #13+#10; {2.12}
LastCall : Str24 = 'NONE'; {11-22-91}
LastCallNum : Str4 = 'NONE'; {11-22-91}
LastCaller : person = 'NONE'; {11-22-91}

TYPE
date_stamp = RECORD
Sdate : Str8; { Date format 0.80}
Stime : Str5; { Time Format 0.80}
END;

fullname = Str40; { filename including sub-directory }
rate = (slow, medm, fast, mid, wow); {11-19-91}
menutype = (MAINM, MESGM, FILEM); {2.13}
log = RECORD
who : Word; {11-23-91}
when : date_stamp;
done : date_stamp;
END;
yesno = ARRAY[Boolean] OF Str3; {0.81}
sectname = ARRAY[1..numsects] OF Str24; {0.81}
sectdir = ARRAY[1..numsects] OF Str40; {0.81}
messages = RECORD
number : Word; {02}
sender : Word; {2.13} {02}
recver : Word; {2.13} {02}
subject: name; {15}
date : date_stamp; {15}
private: Boolean; {01}
section: Byte; {01}
repto : Word; {02}
reply : Word; {02}
recved : Boolean; {01}
END; {Total Bytes= 43}
userec = RECORD
acc : Byte; { Users access level}{01}
user : person; { The users name} {28}
pass : name; { Users password } {15}
exfl : Boolean; { Xpert status } {01}
lsto : date_stamp; { Lst time date/time}{15}
lstm : Integer; { last message read }{02}
upc : Boolean; { User want ALLCAPS }{01}
scrlen: Byte; { Screen len} {01}
tottimeon: LongInt; { time used on board}{04}
upld : Integer; { files uploaded } {02}
dnld : Integer; { files downloaded } {02}
firstcall : String[12]; { date of first call }{13}
upk : Word; { Uploaded K } {02}
dnk : Word; { Download K } {02}
timetoday: Integer; { Time used today } {02}
HotKey: Boolean; { hotkey status } {01}
ScrnClr : Boolean; { Use Screen Clears?} {01}{11-24-91}
res : ARRAY[1..35] OF Byte; { space for future use 35}
END; { Total Bytes = 128} {2.13}

CONST
yn: yesno = ('NO','YES');
inbuffer: line = ''; {2.12}
chknewf : Boolean = False; {11-19-91}
hisp : Boolean = False; {11-19-91}
ModemLock : Boolean = False; {11-19-91}
Clockin : Boolean = True; {11-21-91}
Sectsin : Boolean = True; {11-21-91}
OpenBBS : Boolean = True; {11-21-91}
InfoOnScr : Boolean = False; {11-23-91}
Access : Byte = 0; {11-24-91}
UserNum : Word = 0; {11-24-91}
Caller : person = ' '; {11-24-91}
UseScrnClr : Boolean = False; {11-24-91}
CurXpert : Boolean = False; {11-24-91}
CurHot : Boolean = False; {11-24-91}
DoReboot : Boolean = False; {11-25-91}

VAR
RecBuf : ARRAY[0..Buffer_Max] OF Char;
FileBuf : ARRAY[1..2048] OF Char;
messtable : ARRAY[1..maxmess] OF messages;

load_sectno, load_secdno: Byte; {2.13}
cancelled: Boolean;
logfile : FILE OF log;
logrec : log;
idfile : FILE OF userec;
syslog : Text;
idrec : userec;
temprec : userec; {11-21-91}
{caller : person;}{11-24-91}
timeon, timeoff: date_stamp;
password,temp,message : name;
baud: rate;
mtype: menutype; {2.13}
buffer: Str90; {0.81}
lastspace,charcount,width: Byte;
lastmess,nextmess: Word;
bufpointer, restart : Integer;
linecnt: Byte; {0.80}
uploads,dnloads: Word;
firstread, controls, delayed_exit, local, filesopen, messopen : Boolean;
{usernum: Word;} {2.13}
caps, expert : Boolean;
exitchar: Char; {2.12}
usetime: Longint; { time used on system }
tottimeonx : LongInt;
maxtime: Byte; {2.13}
masterfile : Text;
ioport : Word; { 11-19-91 }
iodata : Integer;
menumain: Boolean;
Buffer_Head, Buffer_Tail,Buffer_Count: Word;
messagefile : FILE OF messages;
msgcount: Word; {2.13}
preformat,ineditor: Boolean;
messdrive,filedrive: STRING[2];
applying,answer,welcome,logon,otherBBS,helpfile,sysinfo: STRING[14];
meetings,bulletin,filehelp,filerecm,mainmenu,msgmenu: STRING[14];
readmenu,filemenu,editmenu,sysmenu,sysophlp,syspass: STRING[14];
sysopt,payingt,contribt,regt,newusert: Byte; {2.13}
{clockin,sectsin,openBBS: Boolean;}
maxidle: Word; {2.20}
screenon,{printon,}sysopin: Boolean; {11-22-91}
totfast,totmedm,totslow,totmid,totwow: Word; {11-91-91}
usercnt: Integer;
upload_factor : Byte;
clockinx,sectsinx,openBBSx,screenonx,{printonx,}sysopinx,mlockx : STRING[5];
upload_sect{right_margin}: Byte; {0.81}
pgbrk : Char;
commport : Char; {String[1];}
strtspd : String[4];
thisbbs : Str40;
goodbye : String[14];
dsaves : Integer;
sect: sectname;
secd: sectdir;
base : Integer;
logintime: Longint;
uploadk, downloadk: Word;
outport: Word; { 11-19-91 }
Async_Irq: Word;
cdetport: Word; { 11-19-91 }
AsyncVector: Pointer;
Shutdown,Timeout,HotKeys: Boolean;
Regs: Registers;
InitString: Strg;
ontime,timeused:Integer;
CpuSpeed: Integer;
delay_calc: Real;
MaxLength: Integer;
ChReady: Boolean;
TimeLeft: Integer;
FilesMenu: Boolean; {2.13}
calldone: Boolean; {2.13}
FirstTime: Boolean; {2.13}
HexFormat: Str4; {0.81}
Gspeed : rate; {11-20-91}
Srow : Byte; {11-22-91}
ChTime: LongInt; {11-25-91}
Homedir: String[40];
Homedrv: string[2];

FUNCTION findid(caller: person; VAR pasrec: userec): Word; {11-21-91}

Implementation
USES Common2;

{$F+} { NOTE: This MUST be a FAR PROCEDURE!}
PROCEDURE async_isr; Interrupt;
BEGIN
Inline($FB); {STI} {Allow other interrupts}
RecBuf[Buffer_Head] := Chr(Port[Base]); {Let interupt convert type!}
IF (Buffer_Head = Buffer_End) THEN
Buffer_Head := 1
ELSE
INC(Buffer_Head);
INC(Buffer_Count);
ChReady := True;
Port[$20] := $20;
END;

procedure dump;
begin
Inline($FA); {CLI}
buffer_head := 1;
buffer_tail := 1;
buffer_count := 0;
ChReady := False;
Inline($FB); {STI}
Port[$20] := $20;
end;

FUNCTION Recvchar:char;
VAR t:char;
BEGIN
IF NOT ChReady THEN
t := #0
ELSE
BEGIN
inline($FA);
t := RecBuf[buffer_Tail];
IF Buffer_Tail < Buffer_End THEN
INC(Buffer_Tail)
ELSE
Buffer_Tail := 1;
DEC(buffer_count);
IF Buffer_Count = 0 THEN ChReady := False;
inline($FB);
Port[$20] := $20;
END;
recvchar := t;
END;

procedure remove_port;
VAR i,m: Word;
begin
inline($FA); {CLI}
i := port[$21];
m := 1 SHL Async_Irq;
port[$21] := i OR m;
port[base+2] := 0;
port[base+4] := port[base+4] AND 1;
inline($FB); {STI}
Port[$20] := $20; {1.9}
end;
{$F-} {11-21-91 for safety all these guys now FAR!}

procedure term_ready(s:Boolean); { the DTR control procedure }
var x:byte;
begin
x := port[base+4] and $FE;
if s then x := x+1;
port[base+4] := x;
if s THEN delay(500); {2.12}
end;

FUNCTION Empty: Boolean; {11-22-91}
BEGIN
Empty := NOT(ChReady OR Keypressed);
END;

PROCEDURE iport1;
BEGIN
CASE commport OF
'1' : begin base := $3f8; Async_Irq := 4; end;
'2' : begin base := $2f8; Async_Irq := 3; end;
'3' : begin base := $3E8; Async_Irq := 4; end;
'4' : begin base := $2E8; Async_Irq := 3; end;
END;
outport := Base+5; {precalc for speed}
cdetport := Base+6; {precalc for speed}
ioport := Base; {precalc for speed}
END;

procedure iport;
var i,m:Integer; regs: Registers;
BEGIN
buffer_Head := 1;
buffer_Tail := 1;
buffer_Count := 0;
ChReady := False; {1.8}
port[base+3]:= $03;
with regs do
begin
ah := $25; al := async_irq+8;
ds := cseg;
dx := ofs(async_isr);
msdos(regs);
end;
inline($FA);
i := port[base+5];
i := port[base];
i := port[$21];
m := (1 shl Async_Irq) xor $00FF;
port[$21] := i and m;
port[base+1] := $01;
i := port[base+4];
port[4+base] := i or $0B; {use CTS here!! 11-19-91}
inline($FB);
Port[$20] := $20; {1.9}
term_ready(true);
END;

FUNCTION timer:longint;
VAR reg:registers; h,m,s:longint;
BEGIN
reg.ax := $2C00;
msdos(reg);
h := (reg.cx SHR 8);
m := (reg.cx MOD 256);
s := (reg.dx SHR 8);
timer := h*3600+m*60+s;
END;

FUNCTION tch(i:strg):strg;
BEGIN
IF ORD(i[0]) > 2 THEN
i := copy(i,length(i)-1,2)
ELSE
IF ORD(i[0]) = 1 THEN i := '0'+i;
tch := i;
END;

FUNCTION time:Str5;
VAR reg:registers; h,m:string[4];
BEGIN
reg.ax:=$2C00;
msdos(reg); {0.80}
str(reg.cx shr 8,h);
str(reg.cx mod 256,m);
time:=tch(h)+':'+tch(m);
END;


FUNCTION valueW(i: Str8): Word;
VAR n,n1: Integer;
BEGIN
IF i <> '' THEN
BEGIN
Val(i,n,n1);
IF n1 <> 0 THEN
BEGIN
i := Copy(i,1,PRED(n1));
Val(i,n,n1);
IF n1 = 0 THEN valueW := n ELSE valueW := 0;
END
ELSE
valueW := n;
END
ELSE
valueW := 0;
END;

FUNCTION valueI(i: Str8): Integer;
VAR n,n1: Integer;
BEGIN
IF i <> '' THEN
BEGIN
Val(i,n,n1);
IF n1 <> 0 THEN
BEGIN
i := Copy(i, 1, PRED(n1));
Val(i,n,n1);
IF n1 = 0 THEN valueI := n ELSE valueI := 0;
END
ELSE
valueI := n;
END
ELSE
valueI := 0;
END;

FUNCTION valueB(inv: Str8): Byte;
VAR n,n1: Integer;
BEGIN
valueB := 0;
IF inv <> '' THEN
BEGIN
IF (Length(inv) < 3) OR ((Length(inv) = 3) AND (inv[1] < '3')) THEN
BEGIN
n := 0;
n1 := 0;
Val(inv,n,n1);
IF n1 <> 0 THEN
valueB := 0
ELSE
BEGIN
IF n < 256 THEN valueB := n;
END;
END;
END;
END;

FUNCTION cstr(i:integer):Str8; {0.81}
VAR c:str8;
BEGIN
IF (i >= -32768) AND (i <= 32767) THEN {11-24-91}
BEGIN
str(i,c); cstr := c;
END
ELSE Cstr := 'Error!';
END;

FUNCTION cstrw(i:Word): Str8; {1.8}
VAR c:str8;
BEGIN
IF (i >= 0) AND (i <= 65535) THEN {11-24-91}
BEGIN
str(i,c); cstrw := c;
END
ELSE CstrW := 'Error!';
END;


FUNCTION CstrB(i:Byte): Str8; {11-24-91 New}
VAR c:str8;
BEGIN
IF (i >= 0) AND (i <= 255) THEN
BEGIN
str(i,c); CstrB := c;
END
ELSE CstrB := 'ERROR!';
END;

FUNCTION leapyear(yr: Integer): Boolean;
BEGIN
leapyear := (yr MOD 4 = 0) AND ((yr MOD 100 <> 0) OR (yr MOD 400 = 0));
END;

FUNCTION days(mo,yr: Integer): Integer;
VAR d: Integer;
BEGIN
d := valueI(Copy('312831303130313130313031', 1+(mo-1)*2, 2));
IF (mo = 2) AND leapyear(yr) THEN INC(d);
days := d;
END;

FUNCTION daycount(mo,yr: Integer): Integer;
VAR m,t: Integer;
BEGIN
t := 0;
FOR m := 1 TO PRED(mo) DO t := t+days(m,yr);
daycount := t;
END;

FUNCTION daynum(dt: Str8): Word; {0.85d}
VAR d,m,y,t,c: Integer;
BEGIN
t := 0;
m := valueI(Copy(dt,1,2));
d := valueI(Copy(dt,4,2));
y := valueI(Copy(dt,7,2))+1900;
FOR c := 1985 TO PRED(y) DO
IF leapyear(c) THEN t := t+366 ELSE t := t+365;
t := t+daycount(m,y)+PRED(d);
daynum := t;
IF y < 1985 THEN daynum := 1;
END;

FUNCTION daten:Str8; {2.13}
VAR reg:registers; m,d,y:string[4];
BEGIN
reg.ax:=$2A00;
msdos(reg);
str(reg.cx,y);
str(reg.dx mod 256,d);
str(reg.dx shr 8,m);
daten := tch(m)+'/'+tch(d)+'/'+tch(y);
END;

FUNCTION AllCaps(letters: Str90): Str90; {2.12 totally new scheme}
VAR cnt,size: Byte; tmp: Str90; tmpc: Char;
BEGIN
size := ORD(letters[0]);
tmp[0] := chr(size);
cnt := 1;
REPEAT
tmpc := letters[cnt];
IF ( (tmpc >= #97) AND (tmpc <= #122) ) THEN tmpc := chr(ORD(tmpc)-32);
tmp[cnt] := tmpc;
INC(cnt);
UNTIL cnt > size;
AllCaps := tmp;
END;

(* ------ This is no longer used! 11-20-91 -------
FUNCTION outready: Boolean; {True if output port ready to xmit a char}
BEGIN
IF Port[cdetport] AND $10 <> 0 THEN {11-20-91 needed if used!}
outready := Port[outport] AND 32 > 0 {11-20-91}
ELSE
outready := False; {11-20-91}
END;
---------- *)

{$R-,S-}
PROCEDURE xmitchar(ch: Char); {XMITS ch when port ready}
BEGIN
IF NOT local THEN
BEGIN
REPEAT UNTIL Port[cdetport] AND $10 <> 0; {11-20-91}
REPEAT UNTIL Port[outport] AND 32 > 0;
Port[iodata] := Ord(ch);
END;
END;

{ This procedure outputs a string at max speed! All items }
{ are optimized! Minimum calls and calculations involved. }

PROCEDURE xmitstring(thestring: Line); { 1.5 }
VAR size,cnt: Byte; {2.1}
BEGIN
IF NOT local THEN
BEGIN
size := ORD(thestring[0]);
cnt := 1; {2.13}
REPEAT
REPEAT UNTIL Port[cdetport] AND $10 <> 0; {11-20-91}
REPEAT UNTIL Port[outport] AND 32 > 0;
Port[iodata] := Ord(thestring[cnt]);
INC(cnt);
UNTIL cnt > size;
END;
END;

PROCEDURE outline(message:line); {0.81 revamped!}
VAR size,cnt: Byte;
BEGIN
size := ORD(message[0]);
INC(size);
message[size] := cr;
INC(size);
message[size] := lf;
message[0] := CHR(size);
IF NOT local THEN
BEGIN
cnt := 1; {2.13}
REPEAT
REPEAT UNTIL Port[cdetport] AND $10 <> 0; {11-20-91}
REPEAT UNTIL Port[outport] AND 32 > 0;
Port[iodata] := Ord(message[cnt]);
INC(cnt);
UNTIL cnt > size; {NOTE: REPEAT much faster than FOR loop here}
END;
IF screenon THEN Write(message); {2.13}
INC(linecnt);
IF linecnt >= psize THEN PauseScr;
END;

PROCEDURE outlineF(VAR message:line); {11-21-91 passes pointer NOT string}
VAR size,cnt: Byte;
BEGIN
size := ORD(message[0]);
INC(size);
message[size] := cr;
INC(size);
message[size] := lf;
message[0] := CHR(size);
IF NOT local THEN
BEGIN
cnt := 1; {2.13}
REPEAT
REPEAT UNTIL Port[cdetport] AND $10 <> 0; {11-20-91}
REPEAT UNTIL Port[outport] AND 32 > 0;
Port[iodata] := Ord(message[cnt]);
INC(cnt);
UNTIL cnt > size; {NOTE: REPEAT much faster than FOR loop here}
END;
IF screenon THEN Write(message); {2.13}
INC(linecnt);
IF linecnt >= psize THEN PauseScr;
END;

FUNCTION cdet: Boolean; {true if carrier present, always "true" local mode.}
BEGIN
cdet := ((Port[cdetport] AND 128) <> 0) OR local;
END;

FUNCTION cts: Boolean; {11-19-91}
BEGIN
IF Local THEN
Cts := True
ELSE
Cts := (Port[cdetport] AND $10) <> 0;
END;

FUNCTION inready: Boolean; {true if char in RecBuf or keyboard.}
BEGIN
inready := ChReady OR Keypressed;
END;
{$R+,S+}

PROCEDURE setbaud(speed: rate); {For changing hardware baud rate setting}
BEGIN
Port[ioport+3] := 131; {was $3fb - 1.1}
CASE speed OF
slow : BEGIN
Port[ioport] := $80; {was $3F8}
Port[ioport+1] := 1; {was $3f9}
END;
medm : BEGIN
Port[ioport] := $60; {was $3f8}
Port[ioport+1] := $0; {was $3f9}
END;
fast : BEGIN
Port[ioport] := $30; {was $3f8}
Port[ioport+1] := $0; {was $3f9}
END;
wow : BEGIN {9600 Bps}
port[ioport] := $0C;
Port[ioport+1] := $0;
hisp := True; {11-19-91}
END;
mid : BEGIN {4800 Bps}
port[ioport] := $12;
Port[ioport+1] := $0;
hisp := True; {11-19-91}
END;
END; { case }
Port[ioport+3] := 3;
Delay(50); {allow to swallow}
baud := speed;
END; { setbaud }

PROCEDURE clearmodem; { Send the initstring to modem}
VAR buffer: Str80; loop: Byte; ch: Char;
BEGIN
buffer := initstring;
FOR loop := 1 TO Length(buffer) DO
BEGIN
ch := buffer[loop];
IF ch = '~' THEN {11-20-91 this sequence added}
Delay(500)
ELSE
BEGIN
xmitchar(ch);
delay(50); { let modem swallow ch}
END;
END;
xmitchar(#13);
{WriteLn;} {11-20-91 why was this here??}
delay(1000); {Delay while modem digests initialization codes}
END; { clearmodem }

FUNCTION ansermodem:Char; {11-20-91}
VAR buffer: Str5; tries: Byte; crud,rkey,ch: Char; done: Boolean;
checkph ,looking: Boolean; cnt,loop: Word; {0.85e loop was byte!}
BEGIN
writeln(' - Incoming Call..Answering! -');
WriteLn;
done := False;
cnt := 0;
looking := True;

IF recvchar <> '2' THEN
BEGIN
WHILE (looking AND (cnt < 500)) DO {2 seconds}
BEGIN
IF Chready THEN
BEGIN
crud := recvchar;
IF crud = '2' THEN
BEGIN looking := False; checkph := True; END
ELSE
BEGIN
IF crud > #32 THEN Writeln('CommChar= ',crud);
Delay(5);
INC(cnt);
END;
END
ELSE
BEGIN Delay(5); INC(cnt); END;
END;
END {<> '2'}
ELSE
checkph := True;

IF checkph THEN
BEGIN
buffer := 'ATA';
FOR loop := 1 TO Length(buffer) DO
BEGIN
ch := buffer[loop];
xmitchar(ch);
delay(50);
END;
xmitchar(#13);
writeln('ATA sent to modem!'); Writeln;
tries := 0;
IF hisp THEN Delay(100); {Get the string complete}

loop := 0;
REPEAT
INC(loop); Delay(5);
UNTIL Cdet OR (loop > 3000); {15 seconds}

IF loop > 3000 THEN
BEGIN
done := True;
rkey := '3';
END
ELSE
BEGIN
WriteLn(' Carrier Detected.. Getting caller bps...');
WriteLn;
END;

WHILE NOT done DO
BEGIN
IF ChReady THEN
BEGIN
INC(tries);
rkey := recvchar;

CASE rkey OF
'1' : BEGIN
IF hisp THEN
BEGIN
rkey := recvchar;
CASE rkey OF
'0': BEGIN rkey := '1'; done := True; END; {2400}
'1': BEGIN rkey := '4'; done := True; END;
'2': BEGIN rkey := '9'; done := True; END;
END
END
ELSE
done := True;
END;
'5' : done := True;
'3' : BEGIN {11-20-91}
IF hisp THEN
BEGIN
rkey := recvchar;
IF rkey = '3' THEN BEGIN rkey := '9'; done := True; END;
END
ELSE
done := True;
END;
'2' : BEGIN {11-20-91}
IF hisp THEN
BEGIN
rkey := recvchar;
CASE rkey OF
'2' : BEGIN rkey := '5'; done := True; END; {1200}
'3' : BEGIN rkey := '1'; done := True; END; {2400}
'4' : BEGIN rkey := '4'; done := True; END; {4800}
'5' : BEGIN rkey := '9'; done := True; END; {9600}
END;
END;
END;
END;{case}
END
ELSE
INC(tries);
IF tries > 200 THEN {11-22-91}
BEGIN done := True; rkey := '3'; END
ELSE
Delay(5);
END;{NOT done}
END; {IF checkph}
ansermodem := rkey;
END; { ansermodem }

PROCEDURE setup; {Hardware initializion for system to start BBS program}
BEGIN
iport1;
GetIntVec(Async_irq+8, AsyncVector);
iport;
IF strtspd = '2400' THEN { 1.1}
setbaud(fast)
ELSE
IF strtspd = '9600' THEN {11-19-91}
setbaud(wow)
ELSE
IF strtspd = '4800' THEN { 1.1}
setbaud(mid)
ELSE
setbaud(medm); {1200 baud}
clearmodem;
END; {setup}

PROCEDURE setlocal;
BEGIN
Term_ready(False); {Inhibits auto-answer}
local := True;
END;

PROCEDURE clearlocal; {Clears local flag and allows modem auto-answer}
BEGIN
Term_Ready(True); { enable auto-answer}
local := False;
END;

PROCEDURE SysLogWrt(systext: Str90); {0.81 major restructure}
BEGIN
{$I-} Append(syslog); {$I+}
IF IoResult <> 0 THEN
{$I-} Rewrite(syslog);{$I+}
IF IoResult = 0 THEN
BEGIN
WriteLn(syslog,systext);
Close(syslog);
END;
END;

PROCEDURE ClearInfo; {11-23-91}
BEGIN
InfoOnScr := False;
Window(1,25,80,25);
ClrScr;
Window(1,1,80,24);
END;

PROCEDURE dispinfo;
VAR col,row,junk: Integer; hh,mm,ss: STRING[2]; tstr: STRING[8];
BEGIN
IF screenon THEN
BEGIN
InfoOnScr := True;
col := WhereX;
row := WhereY;
Window(1,25,80,25);
ClrScr;
GoToXY(2,25);
IF sysopin THEN Write('Avail ') ELSE Write('NoAvail');
junk := access;
Write(' Access:',junk,' ');

Write('Called at:',timeon.Stime,' ');
Write('Name:',caller,' ');
Write('User#:',usernum);
IF idrec.pass <> 'X' THEN
Write(' PASS: ',idrec.pass);
IF delayed_exit THEN Write(' [DELAYED EXIT]');
Window(1,1,80,24);
GoToXY(col, row);
END;
END; { dispinfo }

PROCEDURE Play(Octave, Note, Duration : Integer);
{ from turbo pascal disk version 3.0 sound.pas
Play Note in Octave Duration milliseconds
Frequency computed by first computing C in
Octave then increasing frequency by Note-1
times the twelfth root of 2. (1.059463994) }
VAR Frequency : Real; I : Integer;
BEGIN
Frequency := 32.625;
FOR I := 1 TO Octave DO { Compute C in Octave }
Frequency := Frequency*2;
FOR I := 1 TO Note-1 DO { Increase frequency Note-1 times }
Frequency := Frequency*1.059463094;
IF Duration <> 0 THEN
BEGIN
Sound(Round(Frequency));
delay(Duration);
NoSound;
END
ELSE
Sound(Round(Frequency));
END; {play_octive}

PROCEDURE SoftAlarm;
{ Play the notes G and D in octave three 7 times
each with a duration of 70 milliseconds. }
VAR I : Integer;
BEGIN
FOR I := 1 TO 7 DO
BEGIN
Play(4, 8, 80);
Play(4, 3, 80);
END;
END;

PROCEDURE hangup; {Signals modem to hang up - lowers RTS line for 500ms }
BEGIN
IF cdet THEN
BEGIN
delay(2000);
idrec.pass := ' ';
END;
Term_Ready(False);
IF local THEN clearlocal ELSE REPEAT UNTIL NOT cdet;
Term_Ready(True);
END;

PROCEDURE Flush;
{VAR junk: Char;} {11-21-91}
BEGIN
{junk := recvchar;} {11-20-91}
Dump; {11-20-91}
END;

{ END old MACHDEP.INC }

{ Old IO.INC Ver: 3.09a Starts Here }

PROCEDURE sendout(ch: Char);
{Character output - bypasses word-wrap; also performs
"pause" and "abort" input character checks.}
VAR temp: Char; tctl: Boolean;
BEGIN
IF NOT cancelled THEN
BEGIN
IF inready THEN
BEGIN
temp := charin(noecho);
IF (temp = pause) OR (UpCase(temp) = 'S') THEN
BEGIN
tctl := controls;
controls := True;
temp := charin(noecho);
controls := tctl;
END;
IF (temp = abort) OR (UpCase(temp) = ' ') THEN cancelled := True;
END;
xmitchar(ch);
IF screenon THEN {1.7 total new construct}
BEGIN
IF (ch <> bl) AND (ch <> bs) THEN Write(ch);
END;
END;
END;{SendOut}

PROCEDURE flushbuff;
VAR outpointer: Byte;
BEGIN
IF Length(buffer) > lastspace THEN
FOR outpointer := lastspace+1 TO Length(buffer) DO
sendout(buffer[outpointer]);
lastspace := Length(buffer);
END;

PROCEDURE resetbuff;
BEGIN
bufpointer := 0;
lastspace := 0;
charcount := 0;
buffer := '';
END;

PROCEDURE outchar(cho: Char); {Character output word-wrap NOT used!}
BEGIN
IF caps THEN cho := UpCase(cho);
IF cho > #14 THEN
BEGIN
xmitchar(cho);
IF screenon THEN Write(cho);
END
ELSE
CASE cho OF
#13 : BEGIN INC(LineCnt); xmitchar(cho);IF screenon THEN WriteLn; END;
#12 : BEGIN xmitchar(cs); linecnt := 0; IF screenon THEN ClrScr; END; {2.11}
#10 : xmitchar(cho);
#08 : BEGIN
xmitstring(dobs);
IF screenon THEN Write(dobs);
END;
END;
END;

PROCEDURE charout(ch: Char); {Character output using word-wrap}
VAR buffull: Boolean; size: Integer;
BEGIN
IF caps THEN ch := UpCase(ch);
IF ch > #31 THEN {0.81}
INC(charcount)
ELSE
IF (ch = bs) AND (charcount > 0) THEN DEC(charcount);
size := Ord(buffer[0]);
INC(size);
bufpointer := size;
buffer[size] := ch;
buffer[0] := Char(size);
buffull := (charcount+2 > width);
IF buffull THEN
BEGIN
IF lastspace > 0 THEN
BEGIN
buffer := Copy(buffer,lastspace+1,bufpointer-lastspace);
charcount := size;
lastspace := 0;
END {then}
ELSE
BEGIN
flushbuff;
resetbuff;
END;
outstring(crlf);
INC(linecnt);
END;
IF ch < #33 THEN flushbuff; { ? throw out spaces too ? }
IF ch = #13 THEN resetbuff;
END;{charout}

PROCEDURE stringout(message: line);
VAR charpos,size: Byte; {0.81}
BEGIN
size := ord(message[0]);
charpos := 1;
REPEAT {11-21-91}
charout(message[charpos]);
UNTIL charpos > size;
END;

PROCEDURE outstring(message: line);
BEGIN
xmitstring(message);
IF screenon THEN Write(message);
END;

(* --------- this will be replaced soon 11-21-91
PROCEDURE haltprog; { use to stop program }
BEGIN
Window(1,1,80,25);
ClrScr;
END;

PROCEDURE haltDOS; { rename ctty file & exit program w/modem still active }
VAR cttyfile : FILE; e : integer;
CONST tctty = 'tctty.bat';
BEGIN
Assign(cttyfile, 'tctty.bax');
{$I-} Rename(cttyfile, tctty) {$I+} ;
e := IORESULT;
{$I-} Close(cttyfile); {$I+}
e := IORESULT; { 1.0 }
Window(1,1,80,25); { }
ClrScr; {}
END;
---------- *)

PROCEDURE lineout(message:line);
VAR size, charpos: Byte; {2.1}
BEGIN
message := message+crlf;{2.1}
size := ord(message[0]);
FOR charpos := 1 TO size DO charout(message[charpos]);
INC(linecnt);
IF linecnt >= psize THEN PauseScr; {2.12}
END;

PROCEDURE nl(lines: Byte); { 1.5 }
VAR cnt: Byte;
BEGIN
IF lines = 1 THEN
outstring(crlf) {2.1}
ELSE
FOR cnt := 1 TO lines DO outstring(crlf); {2.1}
INC(linecnt); { 2.1}
IF linecnt >= psize THEN PauseScr; {2.1}
END;

FUNCTION timedin: Boolean;
{returns false if no character received in 1 second or carrier is lost}
VAR times: Byte; {2.20 }
BEGIN
times := 0;
WHILE ((times < 180) AND NOT inready) DO {0.81 was 100}
BEGIN
INC(times); delay(5);
END;
timedin := inready AND (((Port[cdetport] AND 128) <> 0) OR local);
END;

FUNCTION charin(withecho: Boolean): Char;
VAR xch,ch: Char; countime: Integer;
BEGIN
ch := null; countime := 0;
REPEAT
IF timedin THEN ch := recvchar ELSE INC(countime);
IF KeyPressed THEN
BEGIN
ch := Readkey;
IF (ch = #0) THEN { 1.5 }
BEGIN
ch := Readkey;
CASE ch OF
f1 : BEGIN local := True; dispinfo; END;
f2 : {NOP}; {BEGIN printon := NOT printon; dispinfo; END;} {11-22-91}
f3 : BEGIN sysopin := NOT sysopin; dispinfo; END;
f4 : BEGIN screenon := NOT screenon; dispinfo; END;
f5 : BEGIN maxtime := 0; dispinfo; END;
f6 : BEGIN
delayed_exit := NOT delayed_exit; dispinfo;
END;
f7 : {NOP}; { spare }
f8 : {NOP}; { spare }
f9 : {NOP}; { spare }
f10 : {NOP}; { spare }
END; {case}
ch := null;
END;
END; {keypressed}
IF countime > maxidle THEN disconnect;
IF NOT cdet THEN ch := cr; {0.81}
{IF (ch <> bs) AND NOT controls THEN ch := Chr(Ord(ch) AND 127);} {0.81}
UNTIL ch IN [abort, pause, bs,cr, space..#127];
IF (ch = #127) AND NOT controls THEN ch := bs;
IF ch = #$8D THEN ch := #13; {2.12}

IF withecho THEN
BEGIN
IF ch <> bs THEN sendout(ch)
END
ELSE
BEGIN {0.81}
IF (ch >= space) THEN {2.1}
BEGIN
xch := '*'; xmitchar(xch);
IF screenon THEN Write(xch); {1.7}
END
ELSE
IF (ch = cr) THEN {0.81}
BEGIN
xmitchar(cr);
xmitchar(lf);
IF screenon AND (ch = cr) THEN WriteLn;
END;
END;
charin := ch;
END; {charin}

(* ------ 0.81
FUNCTION inputstring(maxchar: Byte; withecho: Boolean): line;{0.81}
VAR temp: line; ch: Char;
BEGIN
temp[0] := #0;
Flush;
REPEAT
ch := charin(withecho);
IF (ch <> cr) AND (ORD(temp[0]) < maxchar) {0.81}
AND ((ch IN [tab,bs,space..#126]) OR controls) THEN
BEGIN
IF ch = tab THEN
REPEAT
temp := temp+space;
UNTIL (Length(temp) MOD 8) = 0
ELSE
BEGIN
IF ch = bs THEN
BEGIN
IF Ord(temp[0]) > 0 THEN {0.80}
BEGIN
temp[0] := CHR(ORD(temp[0])-1);
outstring(dobs); {0.80}
IF screenon THEN Write(dobs); {0.80}
END;
END
ELSE
BEGIN
temp := temp+ch;
END;
END;
IF (Length(temp) > right_margin) AND (temp[Length(temp)] = space) THEN
ch := #13; {2.12}
IF (ch <> #13) THEN sendout(bl); {2.12}
END;{valid char}
UNTIL (ch = #13); {2.12}
outchar(#13);
outchar(#10);
inputstring := temp;
END;
--------- *)

FUNCTION inputstring(maxchar: Byte; withecho: Boolean): line;{0.81}
VAR temp: Str90; ch: Char; done: Boolean;
BEGIN
temp[0] := #0;
Dump; {0.81}
done := False; {0.81}
REPEAT
ch := charin(withecho);
CASE ch OF
cr: done := True; {0.81}
lf: {NOP}; {0.81}
bs: BEGIN
IF Ord(temp[0]) > 0 THEN {0.80}
BEGIN
temp[0] := CHR(ORD(temp[0])-1);
outstring(dobs); {0.80}
END;
END;
ELSE
temp := temp+ch;
END;{case}
IF (ORD(temp[0]) >= maxchar) THEN done := True; {0.81}
UNTIL done OR (NOT cdet);
outchar(cr);
outchar(lf);
inputstring := temp;
END;

FUNCTION getstring(maxsize: Byte): Str90; {2.12}
VAR inchar: Char; stringin: Str90; posn,size,start: Byte; done: Boolean; {2.12}
BEGIN
size := 0;
stringin := '';
posn := 0;
start := 0;
done := False;
WHILE ( (size <= maxsize) AND cdet AND (NOT done) ) DO
BEGIN
IF inready THEN
BEGIN
inchar := charin(True);
IF inchar > #31 THEN
BEGIN
INC(posn);
stringin[posn] := inchar;
stringin[0] := char(posn);
size := Ord(stringin[0]);
END
ELSE
BEGIN
CASE inchar OF
#13 : BEGIN done := True; INC(linecnt); END; {0.80}
#8 : BEGIN {0.80}
IF posn > start THEN
BEGIN
DEC(posn);
stringin[0] := char(posn);
outstring(dobs); {2.12}
IF screenon THEN Write(dobs); {0.81}
END;
END;
END;{case}
END;
END;
END;
getstring := stringin;
END;

FUNCTION getinput(prompt: line; maxleng: Byte; withecho: Boolean): line;
VAR posn: Byte; temp: Char;
BEGIN
IF cancelled THEN BEGIN cancelled := False; nl(1); END;
IF inbuffer = '' THEN
BEGIN
REPEAT
cancelled := False;
IF NOT UseScrnClr THEN nl(1);
IF prompt[0] > #0 THEN outstring(prompt);{0.80}
inbuffer := inputstring(maxleng,withecho); {0.81}
UNTIL cancelled = False;
END;
IF maxleng = 1 THEN
BEGIN
IF inbuffer = '' THEN
temp := #13 {2.12}
ELSE
BEGIN
temp := inbuffer[1];
inbuffer := Copy(inbuffer, 2, Length(inbuffer)-1);
IF (Length(inbuffer) > 1) AND (inbuffer[1] = ';') THEN
inbuffer := Copy(inbuffer, 2, Length(inbuffer)-1);
END; {else}
getinput := temp;
END
ELSE
BEGIN
posn := Pos(';', inbuffer);
IF posn = 0 THEN posn := Length(inbuffer)+1;
IF posn > maxleng THEN
BEGIN
posn := maxleng+1; inbuffer := Copy(inbuffer, 1, maxleng);
END;
getinput := Copy(inbuffer,1,posn-1);
IF posn >= Length(inbuffer) THEN
inbuffer := ''
ELSE
inbuffer := Copy(inbuffer, posn+1, Length(inbuffer)-posn);
END;
END;{GetInput}

FUNCTION GetKey(thelist: Str40; hot:Boolean): Char; { 1.5 }
VAR countime: Integer; inthelist: Byte; chin,chout,junk: Char;
done,shown: Boolean;
BEGIN
countime := 0; chout := #0; done := False; inthelist := 0; chin := #0;
shown := False;
REPEAT
IF timedin THEN chin := recvchar ELSE INC(countime);
IF keypressed THEN
BEGIN
chin := Readkey;
IF (chin = #0) AND Keypressed THEN
BEGIN
chin := Readkey;
CASE chin OF
f1 : BEGIN local := True; dispinfo; END;
f2 : {NOP}; {BEGIN printon := NOT printon; dispinfo; END;}{11-22-91}
f3 : BEGIN sysopin := NOT sysopin; dispinfo; END;
f4 : BEGIN screenon := NOT screenon; dispinfo; END;
f5 : BEGIN countime := maxidle+1; dispinfo; END;
f6 : BEGIN
delayed_exit := NOT delayed_exit; dispinfo;
END;
f7 : {NOP}; { spare } { 1.6}
f8 : {NOP}; { spare } { 1.6}
f9 : {NOP}; { spare } { 1.6}
f10 :{NOP}; { spare } { 1.6}
ELSE chin := #0;
chin := #0;
END;{case}
END;{keypressed2}
END; {keypressed1}
chin := Upcase(chin);
inthelist := POS(chin,thelist);
IF inthelist > 0 THEN
BEGIN
chout := chin;
IF NOT shown THEN
BEGIN
IF screenon THEN write(chin); {1.7}
xmitchar(chin);
END;
shown := True;
END
ELSE
BEGIN
IF chin = bs THEN
BEGIN
xmitstring(dobs);
IF screenon THEN Write(dobs);
chout := #0; chin := #0; shown := False;
END;
END;
IF Hot THEN
BEGIN
IF inthelist > 0 THEN done := True;
END
ELSE
IF chin = #13 THEN done := True; {11-24-91 default is chout := #0}
UNTIL done OR (NOT Cdet) OR (countime > maxidle);

IF cdet AND (countime < maxidle) THEN
BEGIN
Getkey := chout;
IF Hot THEN nl(1);
END
ELSE
BEGIN GetKey := #0; timeout := True; END;
END;{getkey}

PROCEDURE clearsc;
BEGIN
IF UseScrnClr THEN
BEGIN
xmitchar(cs); {2.11}
IF screenon THEN ClrScr;{1.7}
linecnt := 0;
delay(50); {allow for slow screen clears}
END
ELSE
BEGIN
linecnt := 0; {11-24-91}
nl(2); {11-24-91}
END;
END;

PROCEDURE DROPDOS; {0.85e major changes}
BEGIN
clearsc;
Outline('Drop to DOS!');
Outline('CAUTION: You MUST Exit from shell in home directory!');
nl(1);
PauseScr;

IF local THEN
BEGIN
Term_ready(False);
EXEC(GetEnv('comspec'),'/C GODOS.BAT');
Term_ready(True);
END
ELSE
BEGIN
Swapvectors;
EXEC(GetEnv('comspec'), '/C DROPDOS.BAT '+commport+' '+homedir+' '+homedrv);
SwapVectors;
iport;
END;
clearsc;
END;

PROCEDURE default_set;
VAR err: Integer;
BEGIN
calldone := False; {2.13}
CurXpert := False; {11-24-91}
caps := False;
psize := 23;
width := 80;{2.13}
access := newuser;
CurHot := False; {11-24-91}
linecnt := 0; {11-24-91}
{$I-} Assign(idfile,'USERS.BBS'); Close(idfile); {$I+}
err := IORESULT;
{$I-} Assign(logfile, 'LOG.BBS'); Close(logfile); {$I+}
err := IORESULT;
lastmess := 0;
caller := ' '; {2.13}
usernum := 0;
uploads := 0; dnloads := 0;
messopen := False;
filesopen := False;
inbuffer := '';
cancelled := False;
controls := False;
timeout := False;
ineditor := False;
exitchar := null; { clear value }
timeon.Stime := ' '; {11-24-91}
timeon.SDate := ' '; {11-24-91}
UseScrnClr := False; {11-24-91}
END;


PROCEDURE readcomments; {11-24-91 No longer nested}
VAR comment: line; comfile: Text; {11-24-91}
BEGIN { readcomments }
IF cdet THEN
BEGIN
clearsc;
Assign(comfile,'COMMENTS.BBS');
{$I-} Reset(comfile); {$I+}
IF IOResult <> 0 THEN
{NOP} {11-23-91}
ELSE
BEGIN
WHILE cdet AND (NOT cancelled) AND NOT EOF(comfile) DO
BEGIN
Readln(comfile, comment);
lineout(comment);
END;
nl(1);
outstring('Kill(y/[N]):');
IF ynq(False) THEN Rewrite(comfile);
Close(comfile);
END;
END;
END;


PROCEDURE changelevel; {11-24-91 no longer nested}
VAR inch: Byte; number: Word; temp: name; err: Integer;
BEGIN
inch := 0; number := 0; temp := '';
REPEAT
nl(1);
number := getid('User name:',temprec); {11-21-91}
IF number > 0 THEN
BEGIN
Str(temprec.acc:2, temp);
outline('Access:'+temp);
inch := getbyte(6,0,'New level(1-5):');
temprec.acc := inch;
Reset(idfile);
Seek(idfile,number-1);
Write(idfile, temprec);
{$I-} Close(idfile); {$I+}
err := IORESULT; {2.12}
END;
UNTIL number = 0;
END;

(* -------
PROCEDURE sysoponly;
VAR temp: Char; cmsize,idx: Word; {11-23-91}

BEGIN { sysoponly }
REPEAT
clearsc;
temp := getcap('Read C)omments or L)evelChange:');
CASE temp OF
'C' : readcomments;
'L' : changelevel;
END;
UNTIL (temp = 'C') OR (temp = 'L') OR (NOT cdet);
Clearsc;
END;
---------- *)

PROCEDURE ShowWait; {11-22-91}
VAR cnt: Word; mess1,mess2: Str90;
BEGIN
IF InfoOnScr THEN ClearInfo; {11-23-91}
GotoXy(5,srow);
mess1 := ThisBBS+' TurboBBS-II '+version+' -Waiting for call!';
mess2 := 'LastCall: '+LastCaller+' #'+LastCallNum+' at '+LastCall;
GotoXy(5,srow);
WriteLn('ÖÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ·');
GotoXY(5,srow+1);
WriteLn('º º');
GotoXY(5,srow+2);
WriteLn('º º');
GotoXY(5,srow+3);
WriteLn('ÓÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĽ');
GotoXY(7,srow+1); Write(mess1);
GotoXY(7,srow+2); Write(mess2);
cnt := 1;
WHILE (empty AND (cnt < 5000)) DO BEGIN Delay(1); INC(cnt); INC(ChTime); END;
ClrScr;
IF srow <= 15 THEN INC(srow,2) ELSE srow := 2;
END;

FUNCTION ChkModem: Boolean; {11-25-91}
VAR inch : Char; done,res: Boolean; cnt: Word;
BEGIN
done := False;
res := False; {11-25-91 force fail}
cnt := 0; {clear value}
dump;
xmitstring('AT');
xmitchar(#13);
Delay(100); {Let swallow}
WriteLn('Checking modem!!!');
REPEAT
IF ChReady THEN
BEGIN
inch := recvchar;
WriteLn('Echo Char = ',inch);
END
ELSE
BEGIN
INC(cnt);
Delay(1);
END;
IF cnt > 1000 THEN
BEGIN
WriteLn('Modem failed to respond!');
done := True; res := False;
END
ELSE
IF inch = '0' THEN
BEGIN
Done := True; res := True;
WriteLn('Modem responded ok!');
END
UNTIL done;
ChTime := 0; {Always reset to 0}
ChkModem := res;
END;

PROCEDURE awaitcall; {main loop of }
VAR junk,key,rchar: Char; err: Integer; sysline: Strg; datebump: Str8; {0.80}
callbps: rate; timew: Word; crate: Str5; TriedReset: Boolean; {11-23-91}
BEGIN
default_set;
Clearsc;
Window(1,1,80,24);
ClrScr; {1.7}
caller := 'System Available';
Shutdown := False;
idrec.pass := 'X';
uploadk := 0; downloadk := 0;
{IF screenon THEN dispinfo;} {11-23-91}
setup;
srow := 2; {11-22-91}
timew := 0; {11-22-91}
Gotoxy(1,1);
WriteLn(' --- TurboBBS-II ',version,' (c)1988,90-91 by L.B.Neal [H] for Help ---');
Flush; {same as dump;}
local := False;
chtime := 0; {11-25-91}
TriedReset := False; {11-25-91}
REPEAT
delay(1); {11-22-91 for ShowWait Loop}
datebump := daten; {0.80}
IF KeyPressed THEN
BEGIN
junk := Readkey; (* 1.5 *)
IF (junk = 'h') OR (junk = 'H') THEN
BEGIN
Writeln;
Writeln;
Writeln(' TurboBBS-II '+version+' SYSOP Help Screen');

Writeln;
Writeln(' F1 = Local Logon. ');
Writeln(' F2 = Read Comments ');{11-24-91}
Writeln(' F3 = SYSOP Available Toggle. ');
Writeln(' F4 = Screen Toggle. ');
Writeln(' F5 = Force User OFF. ');
Writeln(' F6 = Halt after current user.');
Writeln(' F7 = Read SYSOP Log ');
Writeln(' F8 = DROP to DOS ');
Writeln(' F9 = Review Users ');{11-24-91 is true}
Writeln(' F10 = HALT . ');
Writeln;
delay(5000);
ClrScr;
Gotoxy(1,1);
WriteLn(' - TurboBBS-II '+version+' (c)1988-90,91 by L.B.Neal [H] for Help -');
END
ELSE
IF junk = #0 THEN
BEGIN
junk := Readkey;
IF junk = f1 THEN { F1 = Logon Locally }
BEGIN
junk := null;
local := True; { Sets Cdet to True!}
{dispinfo;} {11-22-91 NOT needed!}
END;
IF junk = f2 THEN { Spare 11-22-91 }
BEGIN
ReadComments; {11-24-91}
junk := null; {Dummy}
END;
IF junk = f3 THEN { F3 = Toggle SYSOP Available }
BEGIN
sysopin := NOT sysopin;
dispinfo; junk := null;
END;
IF junk = f4 THEN { F4 = screenon toggle }
BEGIN
screenon := NOT screenon; dispinfo; junk := null;
END;
IF junk = f5 THEN { F5 = log off caller }
BEGIN
maxtime := 0; dispinfo; junk := null;
END;
IF junk = f6 THEN { F6 = Delayed HALT }
BEGIN
delayed_exit := True; {set for halt after current user}
END;
IF junk = f7 THEN { F7 = Read Sysop Log }
BEGIN
screenon := True; {1.7}
local := True; {11-24-91}
{$I-} Close(syslog); {$I+} err := IORESULT;
IF ShowFile('syslog.BBS',True) THEN {11-24-91}
BEGIN
PauseScr; {2.1}
Local := False;
END
ELSE
local := False; {11-24-91}
Clearsc;
{dispinfo;} {11-24-91}
junk := null;
screenon := False;
END;
IF junk = f8 THEN BEGIN Dropdos; dispinfo; END;
IF junk = f9 THEN
BEGIN
screenon := True;
Local := True;
ChangeLevel; {11-24-91}
Local := False; dispinfo;
screenon := False;
junk := null; {11-24-91}
END;
IF junk = f10 THEN { F10 = Halt }
BEGIN shutdown := True; exitchar := abort; END;
END;
IF local THEN
BEGIN { 1.5p }
IF (NOT shutdown) AND (exitchar <> abort) THEN setlocal;
END
ELSE
BEGIN
IF (NOT shutdown) THEN exitchar := junk;
END;
END; {Keypressed}
INC(timew); {11-22-91}
IF recvchar = ring THEN
BEGIN
Writeln('Ring Detected.....');
exitchar := ring; {11-23-91}
ChTime := 0; {11-25-91}
END
ELSE
BEGIN
IF ((timew > 5000) AND NOT local AND NOT shutdown) THEN
BEGIN timew := 0; ClrScr; ShowWait; END; {11-22-91}
END;
INC(ChTime);
IF ChTime > 180000 THEN {About 3 minutes}
BEGIN
IF NOT ChkModem THEN
BEGIN
IF NOT TriedReset THEN
BEGIN
WriteLn(' !! Trying to reset modem!!');
SysLogWrt(' !!! Trying to reset modem!!');
iport; {11-25-91}
TriedReset := True;
END
ELSE
BEGIN
shutdown := True;
DoReboot := True;
WriteLn('Rebooting Modem NOT responding!');
SysLogWrt(' -- !!! Rebooting Modem NOT Responding!');
END;
END;{NOT ChkModem}
END;{ChTime > 300000}
UNTIL (local OR (exitchar = ring) OR shutdown OR (exitchar = abort));
IF NOT shutdown THEN
BEGIN
timeon.Sdate := daten;
timeon.Stime := time;
ClrScr;
caller := '';
screenon := True;
{dispinfo;} {11-23-91}
IF NOT local THEN
BEGIN
key := ansermodem; {11-12-91}
CASE key OF
'1': callbps := fast; { 2400 baud }
'5': callbps := medm; { 1200 baud }
'9': callbps := wow; {9600}
'4': callbps := mid; {4800}
'3': hangup;
END;{case}
END; {NOT local}
IF (NOT ModemLock AND (Gspeed <> callbps) AND NOT Local) THEN
setbaud(callbps); {11-20-91}
IF cdet THEN
BEGIN
Flush;
IF local THEN
outline('Local Logon .....')
ELSE
BEGIN
CASE callbps OF {11-23-91}
fast: crate := '2400';
medm: crate := '1200';
wow : crate := '9600';
mid : crate := '4800';
END;
outline('Incoming call at '+crate+' bps .....');
END;
END;
delay(1000);
END
ELSE
exitchar := abort;
END;

FUNCTION getcap(prompt: line): Char;
VAR dchar: Char;
BEGIN
outstring(prompt);
dchar := Charin(True);
dchar := UpCase(dchar);
getcap := dchar;
END;

FUNCTION GetInt(nmax,star: Integer; prompt: line): Integer; {0.81}
VAR temp,hold: Integer; outstr,userin: name;
BEGIN
Str(nmax, outstr);
REPEAT
temp := 0;
userin := getinput(prompt,4,echo);
temp := ValueI(userin);
IF (temp > nmax) THEN outline('Number too large '+outstr+' maximum!');
UNTIL ((temp > 0) AND (temp <= nmax))
OR (userin = '*') OR (userin = '') OR (userin = '?') OR NOT cdet;
IF ((temp > 0) AND (temp <= nmax)) THEN Hold := Temp;
IF userin = '?' THEN Hold := -2; {2.13}
IF userin = '*' THEN Hold := star;
IF userin = '' THEN Hold := -1;
GetInt := Hold;
END;{GetInt}

FUNCTION GetWord(nmax,star: Word; prompt: line): Word; {0.81}
VAR temp,hold: Word; outstr,userin: name;
BEGIN
Str(nmax, outstr);
REPEAT
temp := 0;
userin := getinput(prompt,4,echo);
temp := ValueW(userin); {0.81}
IF (temp > nmax) THEN outline('Number too large '+outstr+' maximum!');
UNTIL ((temp > 0) AND (temp <= nmax))
OR (userin = '*') OR (userin = '') OR (userin = '?') OR NOT cdet;
IF ((temp > 0) AND (temp <= nmax)) THEN Hold := Temp;
IF userin = '?' THEN Hold := 0; {2.13}
IF userin = '*' THEN Hold := star;
IF userin = '' THEN Hold := 0;
GetWord := Hold; {0.82}
END;{GetWord}

FUNCTION GetByte(nmax,star: Byte; prompt: line): Byte; {0.81}
VAR temp,Hold: Word; outstr,userin: name;
BEGIN
Str(nmax, outstr);
REPEAT
temp := 0;
userin := getinput(prompt,3,echo); {2.13}
temp := ValueB(userin); {0.81}
IF (temp > nmax) THEN outline('Number too large '+outstr+' maximum!');
UNTIL ((temp > 0) AND (temp <= nmax))
OR (userin = '*') OR (userin = '') OR (userin = '?') OR NOT cdet;

IF ((temp > 0) AND (temp <= nmax)) THEN Hold := Temp;
IF (userin = '?') OR (userin = '') THEN Hold := 0; {11-19-91}
IF userin = '*' THEN Hold := star;
GetByte := Hold;
END;{GetByte}

PROCEDURE pausescr;
VAR cnt: Byte; junk: Char; {2.1}
BEGIN
IF NOT ineditor THEN
BEGIN
linecnt := 0;
outstring('');
dump; {2.1}
IF local THEN
junk := Readkey
ELSE
REPEAT {NOP} UNTIL inready OR NOT cdet; {2.1}
cnt := 1;
REPEAT {11-21-91}
xmitstring(dobs);
INC(cnt);
UNTIL cnt > 21;
IF screenon THEN
FOR cnt := 1 TO 21 DO write(dobs);
END;
END;

PROCEDURE showtime;
BEGIN
outstring('Time is: '+time);
END;

PROCEDURE connecttime;
BEGIN
outstring('Time on Today: '+Cstr(idrec.timetoday)+' Min.');
END;

FUNCTION outfile(fname: Str40; clrfirst: Boolean): Boolean; {11-23-91}
VAR fil: Text; fline: String[82]; size,charpos: Byte; err: Integer;
res: Boolean; {11-23-91}
BEGIN
res := False; {11-23-91}
Assign(fil, fname);
{$I-} Reset(fil); {$I+}
IF IORESULT = 0 THEN
BEGIN
SetTextBuf(fil,FileBuf); {2.13 moved here}
res := True; {11-23-91}
IF clrfirst THEN Clearsc;
WHILE NOT EOF(fil) DO
BEGIN
Readln(fil,fline);
size := ord(fline[0]);
FOR charpos := 1 TO size DO sendout(fline[charpos]);
sendout(#13); {2.12}
sendout(#10); {2.12}
INC(linecnt);
IF linecnt >= psize THEN PauseScr;
END;
END;
{$I-} Close(fil); {$I+}
err := IORESULT;
outfile := res; {11-23-91}
END;{outfile}

FUNCTION showfile(fname: Str40; wclr: Boolean): Boolean; {2.1}
VAR fil: Text; fline: line; err: Integer; chin: Char; done: Boolean;
BEGIN
Assign(fil, fname);
{$I-} Reset(fil); {$I+}
IF IORESULT = 0 THEN
BEGIN
SetTextBuf(fil,FileBuf);
IF wclr THEN clearsc;
Done := False; {2.12}
ShowFile := True; {2.1}
WHILE NOT EOF(fil) AND NOT done DO {2.12}
BEGIN
Readln(fil,fline);
outlineF(fline); {11-21-91}
IF chready THEN {2.12}
BEGIN
chin := RecvChar;
CASE chin OF
#32 : Done := True;
'P' : BEGIN Dump; Repeat UNTIL inready; END; {2.12}
'p' : BEGIN Dump; Repeat UNTIL inready; END; {2.12}
END;
END;
END;{NOT EOF(file)}
END
ELSE
ShowFile := False; {2.1}
{$I-} Close(fil); {$I+}
err := IORESULT;
END;

FUNCTION findid(caller: person; VAR pasrec: userec): Word; {11-21-91}
VAR unum,index,fsize: Word; err: Integer; temprec: userec; {11-21-91}
BEGIN
{$I-} Reset(idfile) {$I+} ;
IF IOResult <> 0 THEN {2.12}
BEGIN
{$I-} Close(idfile);{$I+}
err := IORESULT;
findid := 0;
END
ELSE
BEGIN
unum := 0; {2.13}
index := 1;
fsize := FileSize(idfile)-1; {2.12}
WHILE ((unum = 0) AND (index <= fsize)) DO
BEGIN
Seek(idfile,index); {2.12}
Read(idfile,temprec);
IF temprec.user = caller THEN {11-21-91}
BEGIN
pasrec := temprec;
unum := index;
END;
IF (caller = '***') AND (temprec.acc = deluser) THEN
BEGIN {11-21-91}
unum := index;
pasrec := temprec;
END;
INC(index);
END;
{$I-} Close(idfile); {$I+}
err := IORESULT; {2.12}
findid := unum;
END;
END;

PROCEDURE getcomments(maxline: Byte); {11-24-91 now Text File!!}
VAR comfile: Text; linenum: Byte; head,temp: Str80; err: Integer;
BEGIN
Str(maxline:1, temp);
nl(1); {11-23-91}
lineout('Enter comment: up to '+temp+' lines, enter empty line to quit.');
linenum := 0;
Assign(comfile, 'COMMENTS.BBS');
{$I-} Reset(comfile) {$I+} ;
IF IOResult <> 0 THEN Rewrite(comfile);
Append(comfile);
IF IoResult = 0 THEN {11-24-91}
BEGIN
head := caller;
head := head+' '+timeon.Sdate+' '+time;
REPEAT
INC(linenum);
Str(linenum:2, temp);
outstring(temp+': ');
temp := inputstring(76,echo);{11-24-91}
IF temp <> '' THEN
BEGIN
IF linenum = 1 THEN Write(comfile, head);
Write(comfile, temp);
END;
UNTIL (temp = '') OR (linenum = maxline) OR NOT cdet;
{$I-} Close(comfile); {$I+}
err := IoResult;
END;
END;

FUNCTION nextuser: Word;
VAR temp: Word; err: Integer; junk: userec; {11-21-91}
BEGIN
outstring(crlf+'Finding space for new user...');
temp := findid('***',junk); {11-21-91}
IF temp = 0 THEN
BEGIN
{$I-} Reset(idfile);{$I+}
IF IORESULT = 0 THEN
BEGIN
nextuser := FileSize(idfile); {2.12}
Close(idfile);
END
ELSE
nextuser := 1; {2.12}
END
ELSE
nextuser := temp;
{$I-} Close(idfile);{$I+} {2.12}
err := IORESULT;
END;{nextuser}

PROCEDURE savedefaults;
VAR cnt: Integer;
BEGIN
IF usernum = 0 THEN
BEGIN
usernum := nextuser;
WITH idrec DO
BEGIN
user := caller;
IF expert THEN exfl := True ELSE exfl := False;
lsto := timeon;
IF nextmess > 0 THEN
lstm := nextmess-1
ELSE
nextmess := 0;
pass := password;
acc := access;
upc := caps;
scrlen := psize;
dnld := 0;
upld := 0;
tottimeon := 0;
upk := 0;
dnk := 0;
timetoday := 0;
hotkey := Hotkeys;
ScrnClr := UseScrnClr; {11-24-91}
FOR cnt := 1 TO 35 DO res[cnt] := 0; {11-24-91}
END;
END
ELSE
BEGIN
WITH idrec DO
BEGIN
user := caller;
IF expert THEN exfl := True ELSE exfl := False;
lsto := timeon;
IF nextmess > 0 THEN
lstm := nextmess-1
ELSE
nextmess := 0;
pass := password;
acc := access;
upc := caps;
scrlen := psize;
dnld := dnloads;
upld := uploads;
tottimeon := tottimeon+(timer-logintime);
upk := upk+uploadk;
dnk := dnk+downloadk;
timetoday := timetoday+((timer-logintime) DIV 60);
hotkey := Hotkeys;
ScrnClr := UseScrnClr; {11-24-91}
FOR cnt := 1 TO 35 DO res[cnt] := 0; {11-24-91}
END;
END;
{$I-} Reset(idfile); {$I+}
IF IORESULT <> 0 THEN
BEGIN
Rewrite(idfile);
Write(idfile,idrec); {2.13}
Seek(idfile,1);{ 2.12}
END
ELSE
Seek(idfile,usernum);

Write(idfile,idrec);

Close(idfile);
END;

PROCEDURE disconnect;
BEGIN
savedefaults;
IF outfile(goodbye,True) THEN {NOP}; {11-23-91}
nl(1); {0.80}
outstring('Time on Today: '+Cstr(idrec.timetoday)+' Min.');
nl(2);
outline('Thanks for calling '+thisbbs+', '+caller); {2.1}
IF timeout THEN
BEGIN timeout := False; SyslogWrt(' !*!* Timeout'); END;
SyslogWrt(' *** Gone at: '+time); SyslogWrt(' ');
delay(500); {2.13}
calldone := True; {2.13}
hangup;
END; { disconnect }

PROCEDURE checktime;
VAR junk: char; maxtest: Word; {2.13}
BEGIN
ontime := (timer-logintime) DIV 60;
IF idrec.timetoday < 0 THEN idrec.timetoday := 0; {2.13}
timeused := ontime+idrec.timetoday;
CASE access OF {2.13}
reg: maxtime := regt;
newuser: maxtime := newusert;
sysop: maxtime := sysopt;
END;
maxtest := maxtime+(idrec.upk DIV 40); {2.13 40k = 1min}
IF maxtest > 255 THEN maxtest := 255; {2.13}
maxtime := maxtest; {2.13}
timeleft := (maxtime-timeused);
IF timeleft < 1 THEN {0.81}
BEGIN
lineout(crlf+'Time limit exceeded for today...');
delay(2000);
disconnect;
END
ELSE
IF access <> sysop THEN
outstring('Time:'+time+'. Time on:'+Cstr(timeused)+'. Time Left:'+Cstr(timeleft)+' Min.');
dispinfo;
END; { checktime }
{ End of old IO.INC }

PROCEDURE ChkDef; {11-24-91 new}
BEGIN
WITH idrec DO
BEGIN
UseScrnClr := ScrnClr;
Psize := scrlen;
HotKeys := HotKey;
Expert := exfl;
END;
END;

END.