{$A+,B+,D-,E+,F+,I+,L-,N-,O-,R-,S+,V-}

unit common;

interface

uses

crt,dos,printer,

myio,tmpcom,timejunk;

{$I func.pas}

{$I rec25.pas}

const strlen=160;

dsaves:integer=0;

BOXEDTITLE='`#[';

sepr2=#3#4+':'+#3#3;

type f_initexecswap = function(p:pointer; s:string):boolean;

f_execwithswap = function(p,c:string):word;

p_shutdownexecswap = procedure;

var initexecswap2:f_initexecswap;

execwithswap2:f_execwithswap;

shutdownexecswap2:p_shutdownexecswap;

var uf:file of userrec; { USER.LST }

bf:file of boardrec; { BOARDS.DAT }

xf:file of protrec; { PROTOCOL.DAT }

ulf:file of ulrec; { UPLOADS.DAT }

ulff:file of ulfrec; { *.DIR }

sf:file of smalrec; { NAMES.LST }

smf:file of smr; { SHORTMSG.DAT }

verbf:file of verbrec; { VERBOSE.DAT }

mixf:file; { *.MIX }

brdf:file; { *.BRD }

sysopf, { SYSOP.LOG }

sysopf1, { SLOGxxxx.LOG }

trapfile, { TRAP*.MSG }

cf:text; { CHAT*.MSG }

systat:systatrec; { configuration information }

fstring:fstringrec; { string configuration }

modemr:modemrec; { modem configuration }

fidor:fidorec; { FidoNet information }

thisuser:userrec; { user's account records }

macros:macrorec; { user's macros, if any }

zscanr:zscanrec; { user's zscan records }

{ BRD files }

msg_on:integer; { current message being read }

{ EVENTS }

events:array[0..maxevents] of ^eventrec;

numevents:integer; { # of events }

{ PROTOCOLS }

protocol:protrec; { protocol in memory }

numprotocols:integer; { # of protocols }

{ FILE BASES }

memuboard,tempuboard:ulrec; { uboard in memory, temporary uboard }

readuboard, { current uboard # in memory }

maxulb, { # of file bases }

fileboard:integer; { file base user is in }

{ MESSAGE BASES }

memboard:boardrec; { board in memory }

readboard, { current board # in memory }

numboards, { # of message bases }

board:integer; { message base user is in }

{ FILE/MESSAGE BASE COMPRESSION TABLES }

ccboards:array[0..1,1..maxboards] of byte;

ccuboards:array[0..1,0..maxuboards] of byte;

spd:string[6]; { current modem speed, "KB" for local }

spdarq:boolean; { whether modem connected with ARQ }

(*****************************************************************************)

{ message stuff }

mintabloaded:word; { minor table loaded }

mintaboffset:longint; { minor table file offset }

mintab:array[0..99] of msgindexrec; { minor table }

himsg:longint; { highest message number }

himintab:longint; { highest minor table number }

buf:string[255]; { macro buffer }

sitedatetime:packdatetime; { last time site compiled/changed status }

vercs:string;

vertypes:byte; { Alpha/Beta/etc, Registered, Node }

chatr, { last chat reason }

cmdlist, { list of cmds on current menu }

irt, { reason for reply }

lastname, { author of last message displayed }

lastuname, { last name, whether anon or not }

licenseinfo, { licensing info, if present }

ll, { "last-line" string for word-wrapping }

start_dir:string; { directory BBS was executed from }

tim, { time last keystroke entered }

timeon:datetimerec; { time user logged on }

choptime, { time to chop off for system events }

extratime, { extra time - given by F7/F8, etc }

freetime, { free time }

oltime:real;

answerbaud, { baud rate to answer the phone at }

exteventtime, { # minutes before external event }

maxheapspace, { max heap space available }

serialnumber:longint; { serial number, if present }

chatt, { number chat attempts made by user }

etoday, { E-mail sent by user this call }

ftoday, { feedback sent by user this call }

lastprot, { last protocol # }

ldate, { last daynum() }

lil, { lines on screen since last pausescr() }

mread, { # public messages has read this call }

pap, { characters on this line so far }

ptoday, { posts made by user this call }

realdsl, { real DSL level of user }

realsl, { real SL level of user (for F9) }

usernum:integer; { user's user number }

bread, { board loaded, or -1 for e-mail }

bwant:integer;

chelplevel, { current help level }

curco, { current ANSI color }

elevel, { ERRORLEVEL to exit with }

tshuttlelogon:byte; { type of special Shuttle Logon command }

const

allowabort:boolean=TRUE; { are aborts allowed? }

echo:boolean=TRUE; { is text being echoed? (FALSE=use echo chr)}

flistverb:boolean=TRUE; { list verbose descriptions? }

hangup:boolean=TRUE; { is user offline now? }

nofile:boolean=TRUE; { did last pfl() file NOT exist? }

onekcr:boolean=TRUE; { does ONEK prints<CR> upon exit? }

onekda:boolean=TRUE; { does ONEK display the choice? }

slogging:boolean=TRUE; { are we outputting to the SysOp log? }

sysopon:boolean=TRUE; { is SysOp logged onto the WFC menu? }

wantout:boolean=TRUE; { output text locally? }

wcolor:boolean=TRUE; { in chat: was last key pressed by SysOp? }

badfpath:boolean=FALSE; { is the current DL path BAD? }

badufpath:boolean=FALSE; { is the current UL path BAD? }

badini:boolean=FALSE; { was last call to ini/inu value()=0, s<>"0"? }

bchanged:boolean=FALSE; { was BRD file changed? }

beepend:boolean=FALSE; { whether to beep after caller logs off }

bnp:boolean=FALSE; { was file base name printed yet? }

cfilteron:boolean=FALSE; { is the color filter on? }

cfo:boolean=FALSE; { is chat file open? }

ch:boolean=FALSE; { are we in chat mode? }

chatcall:boolean=FALSE; { is the chat call "noise" on? }

checkit:boolean=FALSE; { }

contlist:boolean=FALSE; { continuous message listing mode on? }

croff:boolean=FALSE; { are CRs turned off? }

ctrljoff:boolean=FALSE; { turn color to #1 after ^Js?? }

cwindowon:boolean=FALSE; { is SysOp window ON? }

doneafternext:boolean=FALSE; { offhook and exit after next logoff? }

doneday:boolean=FALSE; { are we done now? ready to drop to DOS? }

dosansion:boolean=FALSE; { output chrs to DOS for ANSI codes?!!? }

dyny:boolean=FALSE; { does YN return Yes as default? }

enddayf:boolean=FALSE; { perfrom "endday" after logoff? }

fastlogon:boolean=FALSE; { if a FAST LOGON is requested }

hungup:boolean=FALSE; { did user drop carrier? }

incom:boolean=FALSE; { accepting input from com? }

inmsgfileopen:boolean=FALSE; { are we //U ULing a file into a message? }

inwfcmenu:boolean=FALSE; { are we in the WFC menu? }

lan:boolean=FALSE; { was last post/email anonymous/other? }

lastcommandgood:boolean=FALSE;{ was last command a REAL command? }

lastcommandovr:boolean=FALSE; { override PAUSE? (NO pause?) }

lmsg:boolean=FALSE; { }

macok:boolean=FALSE; { are macros OKay right now? }

mailread:boolean=FALSE; { did user delete some e-mail? }

(* minitermonly:boolean=FALSE; { load up MiniTerm ONLY? }*)

localioonly:boolean=FALSE; { local I/O ONLY? }

packbasesonly:boolean=FALSE; { pack message bases ONLY? }

mtcfilteron:boolean=FALSE; { Manhattan Transfer color-filter active }

mtcolors:boolean=FALSE; { Manhattan Transfer colors in use }

newmenutoload:boolean=FALSE; { menu command returns TRUE if new menu to load }

nightly:boolean=FALSE; { execute hard-coded nightly event? }

nofeed:boolean=FALSE; { }

nopfile:boolean=FALSE; { }

overlayinems:boolean=FALSE; { is overlay file in EMS memory? }

outcom:boolean=FALSE; { outputting to com? }

printingfile:boolean=FALSE; { are we printing a file? }

quitafterdone:boolean=FALSE; { quit after next user logs off? }

reading_a_msg:boolean=FALSE; { is user reading a message? }

readingmail:boolean=FALSE; { reading private mail? }

read_with_mci:boolean=FALSE; { read message with MCI? }

returna:boolean=FALSE; { return from MiniTerm and answer phone? }

shutupchatcall:boolean=FALSE; { was chat call "SHUT UP" for this call? }

smread:boolean=FALSE; { were "small messages" read? (delete them) }

trapping:boolean=FALSE; { are we trapping users text? }

trm:boolean=FALSE; { is MiniTerm in use? }

useron:boolean=FALSE; { is there a user on right now? }

wantfilename:boolean=FALSE; { display message filename in scan? }

wascriterr:boolean=FALSE; { critical error during last call? }

wasguestuser:boolean=FALSE; { did a GUEST USER log on? }

wasnewuser:boolean=FALSE; { did a NEW USER log on? }

write_msg:boolean=FALSE; { is user writing a message? }

telluserevent:byte=0; { has user been told about the up-coming event? }

exiterrors:byte=254; { ERRORLEVEL for Critical Error exit }

exitnormal:byte=255; { ERRORLEVEL for Normal exit }

unlisted_filepoints=5; { file points for unlisted downloads }

var

first_time:boolean; { first time loading a menu? }

menustack:array[1..8] of string[12]; { menu stack }

menustackptr:integer; { menu stack pointer }

last_menu, { last menu loaded }

curmenu:string; { current menu loaded }

menur:menurec; { menu information }

cmdr:array[1..50] of commandrec; { command information }

noc:integer; { # of commands on menu }

fqarea,mqarea:boolean; { file/message quick area changes }

doit,doitt:boolean;

newdate:string[8]; { NewScan pointer date }

lrn:integer; { last record # for recno/nrecno }

lfn:string; { last filename for recno/nrecno }

batchtime:real; { }

numbatchfiles:integer; { # files in DL batch queue }

batch:array[1..20] of record

fn:string[65];

section:integer;

pts:integer;

blks:longint;

tt:real;

end;

numubatchfiles:integer; { # files in UL batch queue }

ubatch:array[1..maxubatchfiles] of record

fn:string[12];

section:integer;

description:string[65];

vr:byte;

end;

ubatchv:array[1..maxubatchfiles] of ^verbrec;

hiubatchv:integer;

function lenn(s:string):integer;

function lennmci(s:string):integer;

procedure loaduboard(i:integer);

procedure loadboard(i:integer);

function smci(c:char):string;

procedure sprompt(s:string);

procedure tc(n:integer);

function mso:boolean;

function fso:boolean;

function cso:boolean;

function so:boolean;

function timer:real;

function fbaseac(b:byte):boolean;

function mbaseac(nb:integer):boolean;

procedure newcomptables;

procedure changefileboard(b:integer);

procedure changeboard(b:integer);

function freek(d:integer):longint; (* See disk space *)

function nma:integer;

function okansi:boolean;

function okavatar:boolean;

procedure cline(var s:string; dd:string);

function nsl:real;

function ageuser(bday:string):integer; (* returns age of user by birthdate *)

function allcaps(s:string):string; (* returns a COMPLETELY capitalized string *)

function caps(s:string):string; (* returns a capitalized string.. *)

procedure remove_port;

procedure iport;

{procedure initthething;}

function getwindysize(wind:integer):integer;

procedure commandline(s:string);

procedure sclearwindow;

procedure schangewindow(needcreate:boolean; newwind:integer);

function ccinkey1:char;

function cinkey1:char;

procedure gameport;

procedure sendcom1(c:char);

function recom1(var c:char):boolean;

procedure term_ready(ready_status:boolean);

procedure checkhangup;

function cinkey:char;

{procedure o(c:char);}

function intime(tim:real; tim1,tim2:integer):boolean;

(* check whether in time range *)

function sysop1:boolean;

function checkpw:boolean;

function sysop:boolean;

function stripcolor(o:string):string;

procedure sl1(s:string);

procedure sysoplog(s:string);

function tch(s:string):string;

function time:string;

function date:string;

function value(s:string):longint;

function cstr(i:longint):string;

function nam:string;

procedure shelldos(bat:boolean; cl:string; var rcode:integer);

procedure sysopshell(takeuser:boolean);

procedure readinzscan;

procedure savezscanr;

procedure redrawforansi;

function leapyear(yr:integer):boolean;

function days(mo,yr:integer):integer;

function daycount(mo,yr:integer):integer;

function daynum(dt:string):integer;

function dat:string;

procedure doeventstuff;

procedure getkey(var c:char);

procedure pr1(s:string);

procedure pr(s:string);

procedure sde; {* restore curco colors (DOS and tc) loc. after local *}

procedure sdc;

procedure stsc;

procedure setc(c:byte);

procedure cl(c:integer);

(*procedure promptc(c:char);*)

procedure dosansi(c:char);

procedure prompt(s:string);

function sqoutsp(s:string):string;

function exdrv(s:string):byte;

function mln(s:string; l:integer):string;

function mlnnomci(s:string; l:integer):string;

function mlnmci(s:string; l:integer):string;

function mrn(s:string; l:integer):string;

function mn(i,l:longint):string;

procedure pausescr;

procedure print(s:string);

procedure nl;

procedure prt(s:string);

procedure ynq(s:string);

procedure mpl(c:integer);

procedure tleft;

procedure prestrict(u:userrec);

procedure topscr;

procedure readinmacros;

procedure saveuf;

procedure loadurec(var u:userrec; i:integer);

procedure saveurec(u:userrec; i:integer);

function empty:boolean;

function inkey:char;

{procedure oc(c:char);}

procedure outkey(c:char);

function checkeventday(i:integer; t:real):boolean;

function checkpreeventtime(i:integer; t:real):boolean;

function checkeventtime(i:integer; t:real):boolean;

function checkevents(t:real):integer;

procedure dm(i:string; var c:char);

procedure cls;

procedure wait(b:boolean);

procedure swac(var u:userrec; r:uflags);

function tacch(c:char):uflags;

procedure acch(c:char; var u:userrec);

procedure sprint(s:string);

procedure lcmds(len,c:byte; c1,c2:string);

procedure autovalidate(var u:userrec; un:integer);

procedure rsm;

procedure inittrapfile;

procedure sysopstatus;

procedure chatfile(b:boolean);

function aonoff(b:boolean; s1,s2:string):string;

function onoff(b:boolean):string;

function syn(b:boolean):string;

procedure pyn(b:boolean);

function yn:boolean;

function pynq(s:string):boolean;

procedure inu(var i:integer);

procedure ini(var i:byte);

procedure inputwn1(var v:string; l:integer; flags:string; var changed:boolean);

procedure inputwn(var v:string; l:integer; var changed:boolean);

procedure inputwnwc(var v:string; l:integer; var changed:boolean);

procedure inputmain(var s:string; ml:integer; flags:string);

procedure inputwc(var s:string; ml:integer);

procedure input(var s:string; ml:integer);

procedure inputl(var s:string; ml:integer);

procedure inputcaps(var s:string; ml:integer);

procedure onek(var c:char; ch:string);

procedure local_input1(var i:string; ml:integer; tf:boolean);

procedure local_input(var i:string; ml:integer);

procedure local_inputl(var i:string; ml:integer);

procedure local_onek(var c:char; ch:string);

function centre(s:string):string;

procedure wkey(var abort,next:boolean);

function ctim(rl:real):string;

function tlef:string;

procedure printa1(s:string; var abort,next:boolean);

procedure printacr(s:string; var abort,next:boolean);

function longtim(dt:datetimerec):string;

function dt2r(dt:datetimerec):real;

procedure r2dt(r:real; var dt:datetimerec);

procedure timediff(var dt:datetimerec; dt1,dt2:datetimerec);

procedure getdatetime(var dt:datetimerec);

function cstrl(li:longint):string;

function cstrr(rl:real; base:integer):string;

procedure savesystat; (* save systat *)

procedure pfl(fn:string; var abort,next:boolean; cr:boolean);

procedure printfile(fn:string);

function exist(fn:string):boolean;

procedure printf(fn:string);

procedure mmkey(var s:string);

procedure com_flush_rx;

function com_carrier:boolean;

function com_rx_empty:boolean;

procedure com_set_speed(speed:word);

procedure chat;

procedure skey(c:char);

procedure showudstats;

procedure skey1(c:char);

function verline(i:integer):string;

function aacs1(u:userrec; un:integer; s:string):boolean;

function aacs(s:string):boolean;

procedure DisableInterrupts;

procedure EnableInterrupts;

implementation

uses common1, common2, common3;

(*****************************************************************************\

**

** These routines have been placed in the overlay to decrease the

** in-memory size of the BBS. Routines that are used frequently, and are

** HIGHLY related to the overall speed of the BBS, have been kept out

** of the overlay file, and remain in memory at all times.

**

\*****************************************************************************)

function checkpw:boolean; begin checkpw:=common1.checkpw; end;

procedure newcomptables; begin common1.newcomptables; end;

procedure cline(var s:string; dd:string); begin common1.cline(s,dd); end;

procedure pausescr; begin common1.pausescr; end;

procedure wait(b:boolean); begin common1.wait(b); end;

(*procedure fix_window; begin common1.fix_window; end;*)

procedure inittrapfile; begin common1.inittrapfile; end;

procedure chatfile(b:boolean); begin common1.chatfile(b); end;

procedure local_input1(var i:string; ml:integer; tf:boolean);

begin common1.local_input1(i,ml,tf); end;

procedure local_input(var i:string; ml:integer);

begin common1.local_input(i,ml); end;

procedure local_inputl(var i:string; ml:integer);

begin common1.local_inputl(i,ml); end;

procedure local_onek(var c:char; ch:string);

begin common1.local_onek(c,ch); end;

function chinkey:char; begin chinkey:=common1.chinkey; end;

procedure inli1(var s:string); begin common1.inli1(s); end;

procedure chat; begin common1.chat; end;

procedure sysopshell(takeuser:boolean);

begin common1.sysopshell(takeuser); end;

procedure globat(i:integer); begin common1.globat(i); end;

procedure exiterrorlevel; begin common1.exiterrorlevel; end;

procedure showsysfunc; begin common1.showsysfunc; end;

procedure readinzscan; begin common1.readinzscan; end;

procedure savezscanr; begin common1.savezscanr; end;

procedure redrawforansi; begin common1.redrawforansi; end;

procedure showudstats; begin common2.showudstats; end;

procedure skey1(c:char); begin common2.skey1(c); end;

procedure savesystat; begin common2.savesystat; end;

procedure remove_port; begin common2.remove_port; end;

procedure iport; begin common2.iport; end;

{procedure initthething; begin common2.initthething; end;}

procedure gameport; begin common2.gameport; end;

procedure sendcom1(c:char); begin common2.sendcom1(c); end;

function recom1(var c:char):boolean; begin recom1:=common2.recom1(c); end;

procedure term_ready(ready_status:boolean); begin common2.term_ready(ready_status); end;

function getwindysize(wind:integer):integer; begin getwindysize:=common2.getwindysize(wind); end;

procedure commandline(s:string); begin common2.commandline(s); end;

procedure sclearwindow; begin common2.sclearwindow; end;

procedure schangewindow(needcreate:boolean; newwind:integer);

begin common2.schangewindow(needcreate,newwind); end;

procedure topscr; begin common2.topscr; end;

procedure tleft; begin common2.tleft; end;

procedure readinmacros; begin common2.readinmacros; end;

procedure saveuf; begin common2.saveuf; end;

procedure inu(var i:integer); begin common3.inu(i); end;

procedure ini(var i:byte); begin common3.ini(i); end;

procedure inputwn1(var v:string; l:integer; flags:string; var changed:boolean);

begin common3.inputwn1(v,l,flags,changed); end;

procedure inputwn(var v:string; l:integer; var changed:boolean);

begin common3.inputwn(v,l,changed); end;

procedure inputwnwc(var v:string; l:integer; var changed:boolean);

begin common3.inputwnwc(v,l,changed); end;

procedure inputmain(var s:string; ml:integer; flags:string);

begin common3.inputmain(s,ml,flags); end;

procedure inputwc(var s:string; ml:integer); begin common3.inputwc(s,ml); end;

procedure input(var s:string; ml:integer); begin common3.input(s,ml); end;

procedure inputl(var s:string; ml:integer); begin common3.inputl(s,ml); end;

procedure inputcaps(var s:string; ml:integer);

begin common3.inputcaps(s,ml); end;

procedure mmkey(var s:string); begin common3.mmkey(s); end;

procedure com_flush_rx; begin tmpcom.com_flush_rx; end;

function com_carrier:boolean; begin com_carrier:=tmpcom.com_carrier; end;

function com_rx_empty:boolean; begin com_rx_empty:=tmpcom.com_rx_empty; end;

procedure com_set_speed(speed:word); begin tmpcom.com_set_speed(speed); end;

(*****************************************************************************)

var cfilter:cfilterrec;

cfiltertype,cfilternum,cfiltercount:integer;

procedure shelldos(bat:boolean; cl:string; var rcode:integer);

var t:text;

s:string;

i,speed:integer;

emsswap:boolean;

begin

nosound;

if (bat) then begin

assign(t,'tgtempx.bat'); rewrite(t);

writeln(t,cl);

close(t);

cl:='tgtempx.bat';

end;

if (cl<>'') then cl:='/c '+cl; { if '', just a local shell to DOS }

s:=^M^J+#27+'[0m';

for i:=1 to length(s) do dosansi(s[i]);

remove_port;

emsswap:=FALSE;

if (systat.swapshell) then

if (initexecswap2(heapptr,systat.swappath+'TGSWAP.$$$')) then

emsswap:=TRUE;

swapvectors;

if (not emsswap) then exec(getenv('COMSPEC'),cl) else begin

textcolor(7); writeln('Swapping...');

if (execwithswap2(getenv('COMSPEC'),cl)<>0) then begin

writeln('Cannot swap, performing normal execution');

exec(getenv('COMSPEC'),cl);

end else shutdownexecswap2;

end;

swapvectors;

rcode:=lo(dosexitcode);

if (bat) then begin

assign(t,'tgtempx.bat');

{$I-} erase(t); {$I+}

if (ioresult<>0) then ;

end;

if (spd='KB') then speed:=modemr.waitbaud else speed:=value(spd);

iport; { installint(modemr.comport);}

openport(modemr.comport,speed,'N',8,1);

end;

procedure sysopstatus;

begin

if (sysop) then begin

nl;

printf('SYSOPIN');

if (nofile) then sprint(fstring.sysopin);

end else begin

nl;

printf('SYSOPOUT');

if (nofile) then sprint(fstring.sysopout);

end;

end;

procedure DisableInterrupts;

begin

{rcg11172000 not needed under Linux.}

(*

inline($FA); {cli}

*)

end;

procedure EnableInterrupts;

begin

{rcg11172000 not needed under Linux.}

(*

inline($FB); {sti}

*)

end;

procedure autovalidate(var u:userrec; un:integer);

var settings:set of uflags;

b:boolean;

begin

settings:=[rlogon,rchat,rvalidate,rbackspace,ramsg,rpostan,rpost,remail,

rvoting,rmsg,fnodlratio,fnopostratio,fnofilepts,fnodeletion];

with u do begin

if (un=usernum) then begin

realsl:=sl; realdsl:=dsl;

newcomptables;

end;

sl:=systat.autosl; dsl:=systat.autodsl;

ac:=ac-settings;

ac:=ac+(systat.autoac*settings);

(* do NOT modify user's personal settings, such as ANSI, color, etc.. *)

ar:=systat.autoar;

tltoday:=systat.timeallow[sl];

end;

end;

procedure rsm;

var x:smr;

i:integer;

begin

{$I-} reset(smf); {$I+}

if ioresult=0 then begin

i:=0; cl(1);

repeat

if (i<=filesize(smf)-1) then begin seek(smf,i); read(smf,x);

end;

while (i<filesize(smf)-1) and (x.destin<>usernum) do begin

inc(i);

seek(smf,i); read(smf,x);

end;

if (x.destin=usernum) and (i<=filesize(smf)-1) then begin

print(x.msg);

seek(smf,i); x.destin:=-1; write(smf,x);

smread:=TRUE;

end;

inc(i);

until (i>filesize(smf)-1) or hangup;

close(smf);

cl(1);

end;

end;

function lenn(s:string):integer;

var i,len:integer;

begin

len:=length(s); i:=1;

while (i<=length(s)) do begin

if (s[i] in [#3,'^']) then

if (i<length(s)) then begin dec(len,2); inc(i); end;

inc(i);

end;

lenn:=len;

end;

function lennmci(s:string):integer;

var i,len:integer;

lastco,lastmci:boolean;

begin

len:=length(s);

lastco:=FALSE; lastmci:=FALSE;

for i:=1 to length(s) do

if (not lastco) and (not lastmci) then

case s[i] of

#3,'^':if (not lastco) and (i<>length(s)) then lastco:=TRUE;

'@':if (not lastmci) and (i<>length(s)) then lastmci:=TRUE;

end

else begin

if (lastco) then

if s[i] in [#0..#9,'0'..'9'] then begin

dec(len,2);

lastco:=FALSE;

end;

if (lastmci) then begin

dec(len,2);

inc(len,lennmci(smci(s[i])));

lastmci:=FALSE;

end;

end;

lennmci:=len;

end;

procedure loaduboard(i:integer);

var ulfo:boolean;

begin

if (readuboard<>i) then begin

ulfo:=(filerec(ulf).mode<>fmclosed);

if (not ulfo) then reset(ulf);

if ((i>=0) and (i<=filesize(ulf)-1)) then begin

seek(ulf,i);

read(ulf,memuboard);

end else

memuboard:=tempuboard;

readuboard:=i;

if (not ulfo) then close(ulf);

end;

end;

procedure loadboard(i:integer);

var bfo:boolean;

begin

if (readboard<>i) then begin

bfo:=(filerec(bf).mode<>fmclosed);

if (not bfo) then reset(bf);

if ((i-1<0) or (i-1>filesize(bf)-1)) then i:=1;

seek(bf,i-1); read(bf,memboard);

readboard:=i;

if (not bfo) then close(bf);

end;

end;

procedure lcmds(len,c:byte; c1,c2:string);

var s:string;

begin

s:=copy(c1,2,lenn(c1)-1);

if (c2<>'') then s:=mln(s,len-1);

sprompt(#3#1+'('+#3+chr(c)+c1[1]+#3#1+')'+s);

if (c2<>'') then sprompt(#3#1+'('+#3+chr(c)+c2[1]+#3#1+')'+copy(c2,2,lenn(c2)-1));

nl;

end;

procedure tc(n:integer);

begin

textcolor(n);

end;

function mso:boolean;

var i:byte;

b:boolean;

begin

b:=FALSE;

for i:=1 to 5 do

if (board=thisuser.boardsysop[i]) then b:=TRUE;

mso:=((cso) or (aacs(systat.msop)) or (b));

end;

function fso:boolean;

begin

fso:=((cso) or (aacs(systat.fsop)));

end;

function cso:boolean;

begin

cso:=((so) or (aacs(systat.csop)));

end;

function so:boolean;

begin

so:=(aacs(systat.sop));

end;

function timer:real;

var r:registers;

h,m,s,t:real;

begin

r.ax:=44*256;

msdos(dos.registers(r));

h:=(r.cx div 256); m:=(r.cx mod 256); s:=(r.dx div 256); t:=(r.dx mod 256);

timer:=h*3600+m*60+s+t/100;

end;

function fbaseac(b:byte):boolean;

begin

fbaseac:=FALSE;

if ((b<0) or (b>maxulb)) then exit;

loaduboard(b);

fbaseac:=aacs(memuboard.acs);

end;

function mbaseac(nb:integer):boolean;

begin

mbaseac:=FALSE;

if ((nb<1) or (nb>numboards)) then exit;

loadboard(nb);

mbaseac:=aacs(memboard.acs);

end;

procedure changefileboard(b:integer);

var s:string[20];

go:boolean;

begin

go:=FALSE;

if (b>=0) and (b<=maxulb) then

if (fbaseac(b)) then { fbaseac loads memuboard itself ... }

if (memuboard.password='') then go:=TRUE

else begin

nl; sprint('File base '+cstr(ccuboards[1][b])+': '+

#3#5+memuboard.name);

prt('Password? '); mpl(20); input(s,20);

if (s=memuboard.password) then go:=TRUE else print('Wrong.');

end;

if (go) then begin fileboard:=b; thisuser.lastfil:=fileboard; end;

end;

procedure changeboard(b:integer);

var s:string[20];

go:boolean;

begin

go:=FALSE;

if (b>=1) and (b<=numboards) then

if (mbaseac(b)) then { mbaseac loads memboard itself ... }

if (memboard.password='') then go:=TRUE

else begin

nl; sprint('Message base '+cstr(ccboards[1][b])+': '+

#3#5+memboard.name);

prt('Enter thy Password? '); mpl(20); input(s,20);

if (s=memboard.password) then go:=TRUE else print('Wrong.');

end;

if (go) then begin board:=b; thisuser.lastmsg:=board; end;

end;

function freek(d:integer):longint;

var lng:longint;

begin

lng:=diskfree(d);

freek:=lng div 1024;

end;

function nma:integer;

begin

nma:=thisuser.tltoday;

end;

function okansi:boolean;

begin

okansi:=((ansi in thisuser.ac) or (avatar in thisuser.ac));

end;

function okavatar:boolean;

begin

okavatar:=((avatar in thisuser.ac) and (not mtcolors));

end;

function nsl:real;

var ddt,dt:datetimerec;

beenon:real;

begin

if ((useron) or (not inwfcmenu)) then begin

getdatetime(dt);

timediff(ddt,timeon,dt);

beenon:=dt2r(ddt);

nsl:=((nma*60.0+extratime+freetime)-(beenon+choptime));

end else

nsl:=3600.0

end;

procedure checkhangup;

begin

if (not com_carrier) then

if ((outcom) and (not hangup)) then begin

hangup:=TRUE; hungup:=TRUE;

end;

end;

function waitackfile(s:string):boolean;

var rl:real;

begin

pr1(^T+'f'+s+';');

rl:=timer;

waitackfile:=TRUE;

repeat

if (not com_rx_empty) then

case com_rx of

#6:exit; { ACK }

#21:begin waitackfile:=FALSE; exit; end; { NAK }

end;

until (timer-rl>10.0);

waitackfile:=FALSE;

end;

procedure sendfilep(s:string);

var f:file of char;

ps:string[67];

ns:string[8];

es:string[4];

c:char;

begin

assign(f,s);

{$I-} reset(f); {$I+}

if (ioresult<>0) then begin

pr('');

pr('"'+s+'": File not found.');

pr('');

end else begin

fsplit(s,ps,ns,es);

if (waitackfile(ns+es)) then begin

while (not eof(f)) do begin read(f,c); com_tx(c); end;

pr1(^Z^Z^Z);

end;

close(f);

end;

end;

procedure handlempcode(var ccc:char);

var tf:file of tfilerec;

temptfilebase:tfilerec;

tempboard:boardrec;

s:string;

i,j:integer;

mc:array[1..6] of char;

bfo,ulfo:boolean;

begin

if (not mpcoder) then exit;

ccc:=#0;

for i:=1 to 6 do mc[i]:=chr(mpcode[i]);

case chr(mpcode[1]) of

'r':begin

if (mc[2]+mc[3]='mt') then mtcolors:=(mc[4]='1');

end;

'*':begin

if (mc[2]+mc[3]='li') then

case mc[4] of

'b':begin

pr('');

bfo:=(filerec(bf).mode<>fmclosed);

if (not bfo) then reset(bf);

i:=1;

with tempboard do

while (not eof(bf)) do begin

read(bf,tempboard);

s:=aonoff(aacs(acs),' ','*')+mn(i,3)+':'+

mln(stripcolor(name),40)+':'+acs+'/'+password;

pr1(s+^M^J);

inc(i);

end;

pr('');

if (not bfo) then close(bf);

end;

'f':begin

pr('');

ulfo:=(filerec(ulf).mode<>fmclosed);

if (not ulfo) then reset(ulf);

i:=1;

with tempuboard do

while (not eof(ulf)) do begin

read(ulf,tempuboard);

s:=aonoff(aacs(acs),' ','*')+mn(i,3)+':'+

mln(stripcolor(name),40)+':'+acs+'/'+password;

pr1(s+^M^J);

inc(i);

end;

pr('');

if (not ulfo) then close(ulf);

end;

'r':sendfilep(start_dir+'\err.log');

't':begin

pr('');

assign(tf,systat.gfilepath+'gfiles.dat');

{$I-} reset(tf); {$I+}

i:=1;

read(tf,temptfilebase); j:=temptfilebase.gdaten;

with temptfilebase do

while ((not eof(tf)) and (i<j)) do begin

read(tf,temptfilebase);

s:=aonoff(aacs(acs),' ','*')+mn(i,3)+':'+

mln(filen,12)+':'+mln(stripcolor(title),40)+':'+

acs+'/'+gdate;

pr1(s+^M^J);

inc(i);

end;

pr('');

close(tf);

end;

end;

end;

end;

(* write('(<-'); for i:=1 to 6 do write(chr(mpcode[i])); write('->)');*)

mpcoder:=FALSE;

end;

function ccinkey1:char;

var tar:array[1..20] of char;

rl:real;

tarc:integer;

c:char;

begin

if (recom1(c)) then begin

ccinkey1:=c;

if ((c=^A) and (not trm)) then begin

tarc:=1; tar[1]:=^B;

rl:=timer;

repeat

if (recom1(c)) then begin tar[tarc]:=c; inc(tarc); end;

until ((timer-rl>2.0) or (tarc>11) or (tar[1]<>^B));

{ commandline('<<'+tar[3]+tar[4]+tar[5]+tar[6]+tar[7]+tar[8]+'>>');}

if (tarc>11) then begin

mpcoder:=(tar[1]+tar[2]+tar[9]+tar[10]+tar[11]=^B^A+#253+#254+#255);

if (mpcoder) then begin

for tarc:=1 to 6 do mpcode[tarc]:=ord(tar[tarc+2]);

handlempcode(c); ccinkey1:=#0;

end;

end;

end;

end else

ccinkey1:=#0;

end;

function cinkey1:char;

var rl:real;

c:char;

begin

cinkey1:=ccinkey1;

(* if (recom1(c)) then begin

cinkey1:=c;

if ((c=^A) and (not trm)) then begin