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

interface

uses crt, dos, myio, timefunc, overlay;

{$I records.pas}

const
	strlen=119;
	seperator='^4:^3';

type
  MCIFunctionType = function(const s:astr; Data1, Data2:Pointer):string;
  mnuflags=
   (clrscrbefore,                 { C: clear screen before menu display }
    dontcenter,                   { D: don't center the menu titles! }
    nomenuprompt,                 { N: no menu prompt whatsoever? }
    forcepause,                   { P: force a pause before menu display? }
    autotime,                     { T: is time displayed automatically? }
    forceline,                    { F: Force full line input }
    NoGenericAnsi,                { 1: DO NOT generate generic prompt if ANSI }
    NoGenericAvatar,              { 2: DO NOT generate generic prompt if AVT  }
    NoGenericRIP,                 { 3: DO NOT generate generic prompt if RIP  }
    NoGlobalDisplayed,            { 4: DO NOT display the global commands!    }
    NoGlobalUsed);                { 5: DO NOT use global commands!            }
   {NoVisible                       6: DO NOT display input!                  }

  menurec=                        { *.MNU : Menu records }
  record
    menuname:array[1..3] of string[100]; { menu name }
    directive,                           { help file displayed }
    longmenu:string[12];                 { displayed in place of long menu }
    menuprompt:string[120];              { menu prompt }
    ACS:ACString;                        { access requirements }
    password:string[15];                 { password required }
    fallback:string[8];                  { fallback menu }
    forcehelplevel:byte;                 { forced help level for menu }
    gencols:byte;                        { generic menus: # of columns }
    gcol:array[1..3] of byte;            { generic menus: colors }
    menuflags:set of mnuflags;           { menu status variables }
  end;

  cmdflags=
   (hidden,                       { H: is command ALWAYS hidden? }
    unhidden);                    { U: is command ALWAYS visible? }

  commandrec=                       { *.MNU : Command records }
  record
    ldesc:string[70];               { long command description }
    sdesc:string[35];               { short command description }
    ckeys:string[14];               { command-execution keys }
    ACS:str40;                      { access requirements }
    cmdkeys:string[2];              { command keys: type of command }
    options:string[50];             { MString: command data }
    commandflags:set of cmdflags;   { command status variables }
  end;

  States              = (Waiting, Bracket, Get_Args, Get_Param, Eat_Semi,
                         In_Param, GetAvCmd, GetAvAttr, GetAvRLE1,
                         GetAvRLE2, GetAvX, GetAvY);

  ScreenType = array [0..3999] of Byte;

  StorageType = (Disk, CD, Copied);

  BatchDLQueueRecord = record
    FileName:string[65];
    Storage: StorageType;
    Section,
    Points:integer;
    Uploader:word;
    Size,
    Time,
    OwnerCRC:longint;
  end;

  BatchULQueueRecord = record
    FileName:string[12];
    Section:integer;
    Description:string[55];
    VPointer:byte;
  end;

  IEMSIRecord = record
    UserName,
    Handle:string[36];
    CityState:string[30];
    ph:string[12];
    pw:string[20];
    bdate:string[10];
  end;

  MenuCommandPointer = ^CommandArray;
  CommandArray = array[1..maxmenucmds] of CommandRec;

  MCIBufferType = array[1..MAXCONFIGURABLE] of char;
  MCIBufferPtr = ^MCIBufferType;

  Multitasker = (None, DesqView, Windows, OS2);

const  { predefined variables }
   MCIBuffer: MCIBufferPtr = NIL;
   DIELATER: boolean = FALSE;         { if true, Renegade locks up }
   F_HOME = 18176;      { 256 * Scan Code }
   F_UP   = 18432;
   F_PGUP = 18688;
   F_LEFT = 19200;
   F_RIGHT= 19712;
   F_END  = 20224;
   F_DOWN = 20480;
   F_PGDN = 20736;
   F_INS  = 20992;
   F_DEL  = 21248;
   F_CTRLLEFT  = 29440;
   F_CTRLRIGHT = 29696;
  NoCallInitTime = 30 * 60;     { thirty minutes between modem inits }
	Tasker:Multitasker = None;
	LastScreenSwap:longint = 0;
	ParamArr:Array[1..5] Of Word = (0, 0, 0, 0, 0);
	Params:Word = 0;							{ number of parameters }
	NextState:States = Waiting; 	{ Next state for the parser }
	TempSysOp:boolean = FALSE;		{ is temporary sysop? }
	Reverse:Boolean = False;			{ true if text attributes are reversed }
	TimeLock:boolean = FALSE; 		{ If true, do not Hangup due to time! }
	Savedx:byte=0;								{ for ansi driver}
	Savedy:byte=0;								{ for ansi driver}
  TempPause:boolean=TRUE;       { is pause on or off?  Set at prompts, onek, used everywhere }
	DirFileopen1:boolean=TRUE;		{ whether DirFile has been opened before }
	offlinemail:boolean=FALSE;		{ are we in the offline mail system? }
	multinodechat:boolean=FALSE;	{ are we in multinode chat?}
	ChatChannel:integer=0;				{ What chat channel are we in? }
	displayingmenu:boolean=FALSE; { are we displaying a menu? 						}
  InVisEdit:boolean=FALSE;      { are we in the visual editor? }
	menuAborted:boolean=FALSE;		{ was the menu Aborted? }
	allowAbort:boolean=TRUE;			{ are Aborts allowed? 									}
	mciallowed:boolean=TRUE;			{ is mci allowed? }
	colorallowed:boolean=TRUE;		{ is color allowed? }
	echo:boolean=TRUE;						{ is text being echoed? (FALSE=use echo chr)}
	Hangup:boolean=TRUE;					{ is user offline now?									}
	timedout:boolean=FALSE; 			{ has he timed out? 										}
  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"? }
	beepend:boolean=FALSE;				{ whether to beep after caller logs off }
	bnp:boolean=FALSE;						{ was file base name printed yet? 			}
	cfo:boolean=FALSE;						{ is chat file open?										}
	ch:boolean=FALSE; 						{ are we in chat mode?									}
	chatcall:boolean=FALSE; 			{ is the chat call "noise" on?          }
	contlist:boolean=FALSE; 			{ continuous message listing mode on? 	}
	croff:boolean=FALSE;					{ are CRs turned off? 									}
	ctrljoff:boolean=FALSE; 			{ turn color to #1 after ^Js??					}
	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?				}
	fastlogon:boolean=FALSE;			{ if a FAST LOGON is requested					}
	hungup:boolean=FALSE; 				{ did user drop carrier?								}
	incom:boolean=FALSE;					{ accepting input from com? 						}
	inwfcmenu:boolean=FALSE;			{ are we in the WFC menu? 							}
	lastcommandgood:boolean=FALSE;{ was last command a REAL command?			}
	lastcommandovr:boolean=FALSE; { override PAUSE? (NO pause?) 					}
	localioonly:boolean=FALSE;		{ local I/O ONLY? 											}
	makeqwkfor:integer=0; 				{ make a qwk packet ONLY? 							}
	upqwkfor:integer=0; 					{ upload a qwk packet ONLY? 						}
  RoomNumber:integer=0;         { Room of teleconference                }
	packbasesonly:boolean=FALSE;	{ pack message bases ONLY?							}
	sortfilesonly:boolean=FALSE;	{ sort file bases ONLY? 								}
	newmenutoload:boolean=FALSE;	{ menu command returns TRUE if new menu to load }
  OverLayLocation:byte=0;       { 0=Normal, 1=EMS, 2=XMS                }
	outcom:boolean=FALSE; 				{ outputting to com?										}
	printingfile:boolean=FALSE; 	{ are we printing a file? 							}
	AllowContinue:boolean=FALSE;	{ Allow Continue prompts? 							}
	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? 								}
	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? 					}
	useron:boolean=FALSE; 				{ is there a user on right now? 				}
	wasnewuser:boolean=FALSE; 		{ did a NEW USER log on?								}
	write_msg:boolean=FALSE;			{ is user writing a message?						}
	newechomail:boolean=FALSE;		{ has new echomail been entered?				}
	timewarn:boolean=FALSE; 			{ has user been warned of time shortage? }
	telluserevent:byte=0; 				{ has user been told about the up-coming event? }
	exiterrors:byte=1;						{ errorLEVEL for Critical error exit		}
	exitnormal:byte=0;						{ errorLEVEL for Normal exit						}
	TodayCallers:integer=0; 			{ new system callers }
	TodaynumUsers:integer=0;			{ new number of users }
	node:word=0;									{ node number }
	answerbaud:longint=0; 				{ baud rate to answer the phone at			}
	exteventtime:word=0;					{ # minutes before external event 			}
	LastWFCX:byte = 1;
	LastWFCY:byte = 1;

var
	
      DatFilePath:string[40];
      GlobalMenuCommands:byte;
	Interrupt14:pointer;					{ far ptr to interrupt 14 }
	ticks: longint absolute $0040:$006C;
	IEMSIRec:IEMSIRecord;
	BatchDLQueue:array[1..maxbatchfiles] of ^BatchDLQueueRecord;
	BatchULQueue:array[1..maxbatchfiles] of ^BatchULQueueRecord;
	VotingFile:file of votingr;
	LPT:text; 										{ Printer 															}
	FossilPort:word;
	CallerIDNumber:string[40];		{ Caller ID string obtained from modem }
	ActualSpeed:longint;					{ Actual connect rate }
	Reliable:boolean; 						{ error correcting connection? }
	Speed:longint;								{ com port rate }
	regs:registers;
	uf:file of userrec; 					{ USER.LST															}
	MBasesFile:file of boardrec;	{ MBASES.DAT														}
	xf:file of protrec; 					{ PROTOCOL.DAT													}
	FBasesFile:file of ulrec; 		{ FBASES.DAT														}
	SchemeFile:file of SchemeRec; { SCHEME.DAT														}
	DirFile:file of ulfrec; 			{ *.DIR 																}
	ScnFile:file of boolean;			{ *.SCN 																}
	sf:file of useridxrec;				{ USER.IDX															}
	smf:file of smr;							{ SHORTMSG.DAT													}
	verbf:file of verbrec;				{ EXTENDED.DAT													}
	msgtxtf:file; 								{ *.DAT 																}
	msghdrf:file of mheaderrec; 	{ *.HDR 																}
	msgscnf:file of scanrec;			{ *.SCN 																}
	conf:file of confrec; 				{ CONFRENC.DAT													}
	confr:confrec;								{ Conferences 													}
	nodef:file of noderec;				{ multi node file }
	nodechatlastrec:longint;			{ last record in group chat file read }
	newfilesf:text; 							{ for NEWFILES.DAT in the qwk system }
	Scheme:SchemeRec;
	noder:noderec;
	liner:linerec;

	Lasterror:integer;						{ Results from last ioresult, when needed }

	sysopf, 											{ SYSOP.LOG 														}
	sysopf1,											{ SLOGxxxx.LOG													}
	trapfile, 										{ TRAP*.MSG 														}
	cf:text;											{ CHAT*.MSG 														}

	general:generalrec; 					{ configuration information 						}
	fstring:fstringrec; 					{ string configuration									}

	thisuser:userrec; 						{ user's account records                }

	{ BRD files }
  Msg_On:longint;               { current message being read            }

	{ EVENTS }
	events:array[0..maxevents] of ^eventrec;
	numevents:integer;						{ # of events 													}

	{ PROTOCOLS }
  protocol:protrec;              { protocol in memory                    }

	{ FILE BASES }
	memuboard,tempuboard:ulrec; 	{ uboard in memory, temporary uboard		}
	readuboard, 									{ current uboard # in memory						}
	MaxFBases,										{ Max number of file bases							}
	fileboard:integer;						{ file base user is in									}
	NewScanFBase:boolean; 				{ New scan this base? 									}

	{ MESSAGE BASES }
	memboard:boardrec;						{ board in memory 											}
	readboard,										{ current board # in memory 						}
	lastauthor, 									{ Author # of the last message					}
	MaxMBases,										{ Max number of msg bases 							}
	board:integer;								{ message base user is in 							}
	NewScanMBase:boolean; 				{ New scan this base? 									}
	LastMsgRead:longint;					{ Last message read in current base 		}

	{ FILE/MESSAGE BASE COMPRESSION TABLES }

  { only used in newcomptables and af/am/cf/cmbase fns }

  ccboards:array[0..255] of set of 0..7;
 ccuboards:array[0..255] of set of 0..7;

	junkinfo,
	dirinfo:searchrec;						{see if searchrec can be replaced elsewhere}

	confsystem, 									{ is the conference system enabled? }
	blankmenunow, 								{ is the wfcmenu blanked out? }
	Invisible,										{ Run in Invisible mode? }
	Abort,Next:boolean; 					{ global Abort and Next }

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


		buf:string[255];							{ macro buffer }
		mlc:string[255];							{ multiline bullshit for chat }

		tempdir:string[40]; 					{ Temporary directory base name }

		chatr,												{ last chat reason											}
		cmdlist,											{ list of cmds on current menu					}
		irt,													{ reason for reply											}
		ll, 													{ "last-line" string for word-wrapping  }
		start_dir,										{ directory BBS was executed from 			}
		menukeys:astr;								{ keys to Abort menu display with 			}

		CreditsLastUpdated, 					{ Time Credits last updated }
		timeon:longint; 							{ time user logged on 									}

		LastBeep,
		LastKeyHit,
		choptime, 										{ time to chop off for system events		}
		extratime,										{ extra time - given by F7/F8, etc			}
		credittime, 									{ credit time adjustment }
		freetime:longint; 						{ free time 														}


		chatt,												{ number chat attempts made by user 		}
		ptoday, 											{ posts made by user this call					}
		etoday, 											{ E-mail sent by user this call 				}
		ftoday, 											{ feedback sent by user this call 			}
    utoday,                       { uploads sent by user this call        }
    dtoday,                       { download sent to user this call       }
		lastprot, 										{ last protocol # 											}
		lil,													{ lines on screen since last pausescr() }
		mread,												{ # public messages has read this call	}
		usernum:integer;							{ user's user number                    }
    dktoday,                      { download k by user this call          }
    uktoday:longint;              { upload k by user this call            }

		chelplevel, 									{ current help level										}
		curco,												{ current ANSI color										}
		ExiterrorLevel, 											{ errorLEVEL to exit with 							}
		tshuttlelogon:byte; 					{ type of special Shuttle Logon command }
		tfileprompt:byte; 						{ type of special file prompt command 	}
		treadprompt:byte; 						{ type of special read prompt command 	}

		currentconf:char; 						{ Current conference tag								}
		first_time:boolean; 					{ first time loading a menu?						}
		menustack:array[1..8] of string[12]; { menu stack 										}
		menustackptr:integer; 				{ menu stack pointer										}
		curmenu:astr; 								{ current menu loaded 									}
		menur:menurec;								{ menu information											}
		MenuCommand: MenuCommandPointer; { Command information }
		noc:integer;									{ # of commands on menu 								}
		rqarea,fqarea,mqarea,vqarea:boolean;
																	{ read/file/message/vote quick area changes  }

		newdate:string[10];						{ NewScan pointer date									}
		lrn:integer;									{ last record # for recno/nrecno				}
		lfn:string[12]; 							{ last filename for recno/nrecno				}

		batchtime:longint;						{ }
		numbatchfiles:integer;				{ # files in DL batch queue 						}
		numubatchfiles:integer; 			{ # files in UL batch queue }

		rate:word;										{ cps for file transfers }

		ubatchv:array[1..maxbatchfiles] of ^verbrec;
		hiubatchv:integer;

procedure DisplayBuffer(MCIFunction: MCIFunctionType; Data1, Data2:Pointer);
function readbuffer(FileName:astr):boolean;
function chinkey:char;
function FormatNumber(x:longint):string;
procedure WriteWFC(c:char);
function AccountBalance:longint;
procedure AdjustBalance(Adjustment:integer);
procedure BackErase(Len:byte);
function UpdateCRC32(CRC:longInt; var buffer; Len:word):longint;
function CRC32(s:astr):longint;
function FunctionalMCI(const s:astr; FileName, InternalFileName:astr): string;
function MCI(const s:string):string;
function Plural(Number:longint): string;
function FormattedTime(TimeUsed:longint):string;
function searchuser(Uname:astr; RealNameOK:boolean): word;
function ambase(x:integer):integer;
function cmbase(x:integer):integer;
function afbase(x:integer):integer;
function cfbase(x:integer):integer;
procedure pausescr(IsCont:boolean);
procedure outmodemstring(const s:astr);
procedure dophoneHangup(showit:boolean);
function CRC16(const s:astr):word;
procedure dophoneoffhook(showit:boolean);
procedure inputpath(const s:astr; var v:astr);
function stripname(s:astr):string;
procedure dtr(status:boolean);
procedure purgedir(s:astr; SubDirs:boolean);
procedure dosansi(const c:char);
function himsg:integer;
function onnode(x:word):byte;
function maxusers:integer;
function decode(const x:astr; check:byte):string;
procedure kill(const fn:astr);
procedure screendump(const f:astr);
procedure scaninput(var s:astr; const allowed:astr);
procedure com_flush_rx;
procedure com_flush_tx;
procedure com_purge_tx;
function com_carrier:boolean;
function com_rx:char;
function com_rx_empty:boolean;
function com_tx_empty:boolean;
procedure com_tx(c:Char);
procedure com_set_speed(speed:longint);
procedure com_deinstall;
procedure backspace;
function usename(b:byte; s:string):string;
function lennmci(const s:string):integer;
procedure loadfileboard(i:integer);
procedure loadboard(i:integer);
procedure initport;
function MsgSysOp:boolean;
function FileSysOp:boolean;
function CoSysOp:boolean;
function so:boolean;
function timer:longint;
procedure TeleConfCheck;
function fbaseac(Base:integer):boolean;
function mbaseac(Base:integer):boolean;
function substitute(src:string; const old,new:string):string;
procedure newcomptables;
procedure changefileboard(Base:integer);
procedure changeboard(Base:integer);
function okansi:boolean;
function okavatar:boolean;
function okrip:boolean;
function okvt100:boolean;
function nsl:longint;
function ageuser(const birthdate:longint):integer;
function allcaps(s:string):string;
function caps(s:string):string;
procedure update_screen;
function pagelength:word;
procedure status_screen(WhichScreen:byte; Message:astr; OneKey:boolean; var Answer:astr);
procedure CheckHangup;
function cinkey:char;
function intime(tim,tim1,tim2:longint):boolean;
function checkpw:boolean;
function stripcolor(const o:string):string;
procedure sl1(s:astr);
procedure sysoplog(s:astr);
function Zeropad(s:str8):string;
function time:string;
function date:string;
function value(s:astr):longint;
procedure shelldos(MakeBatch:boolean; const Command:astr; var ResultCode:byte);
procedure sysopshell;
procedure redrawforansi;
function days(var mo,yr:integer):integer;
procedure star(s:astr);
function daycount(var mo,yr:integer):integer;
function daynum(dt:str10):integer;
function dat:string;
function getkey:word;
procedure SerialOut(s:string);
procedure setc(c:byte);
procedure UserColor(c:integer);
procedure prompt(const s:string);
function sqoutsp(s:string):string;
function ExtractDriveNumber(s:astr):byte;
function mln(s:string; l:byte):string;
function mrn(s:string; l:byte):string;
function mn(i:longint; l:byte):string;
procedure print(const s:string);
procedure nl;
procedure prt(const s:string);
procedure mpl(c:integer);
function ctp(t,b:longint):string;
procedure tleft;
procedure loadnode(i:integer);
function update_node(x:byte):byte;
function	maxnodes:integer;
function maxchatrec:longint;
procedure savenode(i:integer);
procedure loadurec(var u:userrec; i:integer);
procedure saveurec(u:userrec; i:integer);
procedure loadsfrec(i:integer; var sr:useridxrec);
procedure savesfrec(i:integer; sr:useridxrec);
function maxsf:integer;
function empty:boolean;
function inkey:word;
procedure outkey(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 lcmds(len,c:byte; c1,c2:astr);
procedure lcmds3(len,c:byte; c1,c2,c3:astr);
procedure autovalidate(var u:userrec; var un:integer; level:char);
procedure inittrapfile;
function aonoff(b:boolean; const s1,s2:astr):string;
function onoff(b:boolean):string;
function syn(b:boolean):string;
function yn:boolean;
function pynq(const s:astr):boolean;
procedure inu(var i:integer);
procedure ini(var i:byte);
procedure inputdefault(var s:string; v:string; l:integer; flags:str8; lf:boolean);
procedure inputformatted(var s:string; v:string; Abortable:boolean);
procedure inputwn1(var v:string; l:integer; flags:str8; 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:str8);
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:astr);
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:astr):string;
procedure wkey;
function ctim(rl:longint):string;
procedure printmain(const ss:string);
procedure printacr(s:string);
function cstr(l:longint):string;
procedure savegeneral(x:boolean);  (* save general *)
procedure pfl(fn:astr);
procedure printfile(fn:astr);
function exist(fn:astr):boolean;
procedure printf(fn:astr);
procedure skey1(var c:char);
function verline(i:integer):string;
function aacs1(u:userrec; un:integer; s:acstring):boolean;
function aacs(s:acstring):boolean;

implementation

uses common1, common2, common3, multnode, spawno, vote, Event;


Function UpdateCRC32(CRC:longInt; var buffer; Len:word):longint; external;
{$L CRC32.OBJ }

function checkpw:boolean; begin checkpw:=common1.checkpw; end;
procedure newcomptables; begin common1.newcomptables; end;
procedure wait(b:boolean); begin common1.wait(b); end;
procedure inittrapfile; begin common1.inittrapfile; end;
procedure initport; begin common2.initport; end;
{procedure chatfile(b:boolean); begin syschat.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;
{procedure chat; begin common1.chat; end;}
procedure sysopshell; begin common1.sysopshell;end;
procedure redrawforansi; begin common1.redrawforansi; end;

procedure skey1(var c:char); begin common2.skey1(c); end;
procedure savegeneral(x:boolean); begin common2.savegeneral(x); end;
procedure update_screen;
	begin common2.update_screen; end;
procedure status_screen(WhichScreen:byte; Message:astr; OneKey:boolean; var Answer:astr);
	begin common2.status_screen(WhichScreen,Message,OneKey,Answer); end;
procedure tleft; begin common2.tleft; end;

procedure inu(var i:integer); begin common3.inu(i); end;
procedure ini(var i:byte); begin common3.ini(i); end;
procedure inputdefault(var s:string; v:string; l:integer; flags:str8; lf:boolean);
	begin common3.inputdefault(s,v,l,flags,lf); end;
procedure inputformatted(var s:string; v:string; Abortable:boolean); begin common3.inputformatted(s,v,Abortable); end;
procedure inputwn1(var v:string; l:integer; flags:str8; 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:str8);
	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;

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

function readbuffer(FileName:astr):boolean;
var
  f:file;
  i,r:integer;
begin
  if (MCIBuffer = NIL) then
    new(MCIBuffer);

  ReadBuffer := FALSE;

  if ((pos('\', FileName) = 0) and (pos(':', FileName) = 0)) then
    FileName := General.MiscPath + FileName;

  if (pos('.', FileName) = 0) then
    begin
      if (okrip) and exist(FileName + '.rip') then
        FileName := FileName + '.rip'
      else if (okavatar) and exist(FileName + '.avt') then
        FileName := FileName + '.avt'
      else if (okansi) and exist(FileName + '.ans') then
        FileName := FileName + '.ans'
      else if (exist(FileName + '.asc')) then
        FileName := FileName + '.asc';
    end;

  if (not exist(FileName)) then
    exit;

  assign(f, FileName);
  reset(f, 1);

  if (ioresult <> 0) then
    exit;

  if (FileSize(f) < MAXCONFIGURABLE) then
    i := FileSize(f)
  else
    i := MAXCONFIGURABLE;

  fillchar(MCIBuffer^, sizeof(MCIBuffer^), 0);
  blockread(f, MCIBuffer^, i, r);

  if (r <> i) then
    exit;

  close(f);
  ReadBuffer := TRUE;
end;

procedure DisplayBuffer(MCIFunction: MCIFunctionType; Data1, Data2:Pointer);
var
  i,x2:integer;
  s:string;
  cs:astr;
  Justify:byte;  {0=Right, 1=Left, 2=Center}
begin
  i := 1;
  while (i <= MAXCONFIGURABLE) and (MCIBuffer^[i] <> #0) do
    begin
      s := '';
      while (i <= MAXCONFIGURABLE) and (MCIBuffer^[i] <> #13) do
        if (MCIBuffer^[i] = '~') and (i + 2 <= MAXCONFIGURABLE) then
          begin
            cs := MCIFunction(MCIBuffer^[i + 1] + MCIBuffer^[i + 2], Data1, Data2);
            if (cs = MCIBuffer^[i + 1] + MCIBuffer^[i + 2]) then
              begin
                s := s + '~';
                inc(i);
                continue;
              end;
            inc(i, 3);
            if (i + 1 <= MAXCONFIGURABLE) and (MCIBuffer^[i] in ['#','{','}']) then
              begin
                if (MCIBuffer^[i] = '}') then
                  Justify := 0
                else if (MCIBuffer^[i] = '{') then
                  Justify := 1
                else
                  Justify := 2;
                if (MCIBuffer^[i + 1] in ['0'..'9']) then
                  begin
                    x2 := ord(MCIBuffer^[i + 1]) - 48;
                    inc(i, 2);
                    if (MCIBuffer^[i] in ['0'..'9']) then
                      begin
                        x2 := x2 * 10 + ord(MCIBuffer^[i]) - 48;
                        inc(i, 1);
                      end;
                    if (x2 > 0) then
                      case Justify of
                        0:cs := mrn(cs, x2);
                        1:cs := mln(cs, x2);
                        2:while (length(cs) < x2) do
                            begin
                              cs := ' ' + cs;
                              if (length(cs) < x2) then
                                cs := cs + ' ';
                            end;
                      end;
                  end;
              end;
            { s := s + cs; }
            if (length(cs) + length(s) <= 255) then
              begin
                move(cs[1], s[length(s)+1], length(cs));
                inc(s[0], length(cs));
              end
            else
              if (length(s) < 255) then
                begin
                  move(cs[1], s[length(s)+1], 255-length(s));
                  s[0] := #255;
                end;
          end
        else
          begin
            inc(s[0]);
            s[length(s)] := MCIBuffer^[i];
            inc(i);
          end;

      if (i <= MAXCONFIGURABLE) and (MCIBuffer^[i] = #13) then
        inc(i, 2);
      croff := TRUE;
      printacr(s);
    end;
end;

function chinkey:char;
var c:char;
begin
  c:=#0; chinkey:=#0;
  if (keypressed) then begin
    c:=readkey;
    if (not wcolor) then UserColor(general.sysopcolor);
    wcolor:=TRUE;
    if (c=#0) then
      if (keypressed) then begin
        c:=readkey;
        skey1(c);
        if (c=chr(46)) then {ALT-C}
          c:=#1
        else
          if (buf<>'') then
            begin
              c:=buf[1];
              buf:=copy(buf,2,length(buf)-1);
            end
          else
            c := #0
      end;
    chinkey:=c;
  end else
    if ((not com_rx_empty) and (incom)) then begin
      c:=cinkey;
      if (wcolor) then UserColor(general.usercolor);
      wcolor:=FALSE;
      chinkey:=c;
    end;
end;

function FormatNumber(x:longint):string;
var
  s:string;
  i,
  j:byte;
begin
  s := '';
  str(x, s);
  i := length(s);  j := 0;
  while (i > 1) do
    begin
      inc(j);
      if (j = 3) then
        begin
          insert(',', s, i);
          j := 0;
        end;
      dec(i);
    end;
  FormatNumber := s;
end;

procedure WriteWFC(c:char);
var
	LastAttr:byte;
begin
  if (blankmenunow) then exit;
	window(23, 11, 78, 15);
	gotoxy(LastWFCX, LastWFCY);
	LastAttr := textattr;
	textattr := 7;
	write(c);
	textattr := LastAttr;
	LastWFCX := WhereX;
	LastWFCY := WhereY;
	window(1, 1, MaxDisplayCols, MaxDisplayRows);
end;

function AccountBalance:longint;
begin
	AccountBalance := Thisuser.Credit - Thisuser.Debit;
end;

procedure AdjustBalance(Adjustment:integer);
begin
	if (Adjustment > 0) then
		inc(Thisuser.Debit, Adjustment) 	 { Add to debits }
	else
		dec(Thisuser.Credit, Adjustment);  { Add to credits }
end;

function CRC32(s:astr):longint;
begin
	CRC32 := not(UpdateCRC32($FFFFFFFF, s[1], length(s)));
end;

Procedure Kill(const fn:astr);
var
  f:file;
begin
  assign(f,fn);
  erase(f);
  Lasterror := ioresult;
end;

procedure backspace;
begin
	if outcom then
		serialout(^H' '^H);
	if wantout then
		write(^H' '^H);
end;

function substitute(src:string; const old,new:string):string;
var
	p:integer;
	diff:integer;
  LastP:integer;
begin
	if (old <> new) then
		begin
      LastP := 0;
			diff := length(new) - length(old);
			repeat
        p := pos(old, copy(src, LastP, 255));   { guard against reinterping }
				if (p > 0) then
					begin
						if (diff <> 0) then
							begin
								move(src[p + length(old)],src[p + length(new)], length(src) - p);
								inc(src[0],diff);
							end;
						move(new[1],src[p],length(new));
            LastP := p + length(new);
					end;
			until (p = 0);
		end;
	substitute:=src;
end;

procedure dosansi(const c:char);
Var
	i:word;
	label Command;

begin
	if (c=#27) and (NextState in [Waiting..In_Param]) then
		begin
			NextState := Bracket;
			exit;
		end;

	if (c = ^V) and (NextState = Waiting) then
		begin
			NextState := GetAvCmd;
			exit;
		end;

	if (c = ^Y) and (NextState = Waiting) then
		begin
			NextState := GetAvRLE1;
			exit;
		end;

	Case NextState Of
		Waiting : if (c = #9) then
								gotoxy(WhereX + 8, WhereY)
							else
								write(c);
	 GetAvRLE1: begin
								ParamArr[1] := ord(c);
								NextState := GetAvRLE2;
							end;
	 GetAvRLE2: begin
								for i := 1 to ord(c) do
									write(chr(ParamArr[1]));
								NextState := Waiting;
							end;
	 GetAvAttr: begin
								TextAttr := ord(c) and $7f;
								NextState := Waiting;
							end;
			GetAvY: begin
								ParamArr[1] := ord(c);
								NextState := GetAvX;
							end;
			GetAvX: begin
								gotoxy (ord(c),ParamArr[1]);
								NextState := Waiting;
							end;
		GetAvCmd: case c of
								^A : NextState := GetAvAttr;
								^B : begin
											 Textattr := Textattr or $80;
											 NextState := Waiting;
										 end;
								^C : begin
											 gotoxy (WhereX,WhereY-1);
											 NextState := Waiting;
										 end;
								^D : begin
											 gotoxy (WhereX,WhereY+1);
											 NextState := Waiting;
										 end;
								^E : begin
											 gotoxy (WhereX-1,WhereY);
											 NextState := Waiting;
										 end;
								^F : begin
											 gotoxy (WhereX+1,WhereY);
											 NextState := Waiting;
										 end;
								^G : begin
											 clreol;
											 NextState := Waiting;
										 end;
								^H : NextState := GetAvY;
							else
										 NextState := Waiting;
						 end;
		Bracket :
			Begin
				If c <> '[' Then
					Begin
						NextState := Waiting;
						Write(c);
					End
				else
				 begin
					 Params := 1;
					 FillChar (ParamArr, 5, 0);
					 NextState := Get_Args;
				 end;
			End;
		Get_Args, Get_Param, Eat_Semi :
			Begin
				If (NextState = Eat_Semi) And (c = ';') Then
				Begin
					If Params < 5 Then Inc(Params);
					NextState := Get_Param;
					Exit;
				End;
				Case c Of
					'0'..'9' :
						Begin
							ParamArr[Params] := Ord(c) - 48;
							NextState := In_Param;
						End;
					';' :
						Begin
							If Params < 5 Then Inc(Params);
							NextState := Get_Param;
						End;
					Else
						GoTo Command;
				End {Case c} ;
			End;
		In_Param :									{ last char was a digit }
			Begin
				{ looking for more digits, a semicolon, or a command char }
				Case c Of
					'0'..'9' :
						Begin
							ParamArr[Params] := ParamArr[Params] * 10 + Ord(c) - 48;
							NextState := In_Param;
							Exit;
						End;
					';' :
						Begin
							If Params < 5 Then Inc(Params);
							NextState := Eat_Semi;
							Exit;
						End;
				End {Case c} ;
Command:
				NextState := Waiting;
				Case c Of
					{ Note: the order of commands is optimized for execution speed }
					'm' :                 {sgr}
						Begin
							For i := 1 To Params Do
							Begin
								If Reverse Then TextAttr := TextAttr Shr 4 + TextAttr Shl 4;
								Case ParamArr[i] Of
									0 :
										Begin
											Reverse := False;
											TextAttr := 7;
										End;
									1 : TextAttr := TextAttr And $FF Or $08;
									2 : TextAttr := TextAttr And $F7 Or $00;
									4 : TextAttr := TextAttr And $F8 Or $01;
									5 : TextAttr := TextAttr Or $80;
									7 : If Not Reverse Then
											Begin
										{
										TextAttr := TextAttr shr 4 + TextAttr shl 4;
										}
												Reverse := True;
											End;
									22 : TextAttr := TextAttr And $F7 Or $00;
									24 : TextAttr := TextAttr And $F8 Or $04;
									25 : TextAttr := TextAttr And $7F Or $00;
									27 : If Reverse Then
											 Begin
												 Reverse := False;
										{
										TextAttr := TextAttr shr 4 + TextAttr shl 4;
										}
											 End;
									30 : TextAttr := TextAttr And $F8 Or $00;
									31 : TextAttr := TextAttr And $F8 Or $04;
									32 : TextAttr := TextAttr And $F8 Or $02;
									33 : TextAttr := TextAttr And $F8 Or $06;
									34 : TextAttr := TextAttr And $F8 Or $01;
									35 : TextAttr := TextAttr And $F8 Or $05;
									36 : TextAttr := TextAttr And $F8 Or $03;
									37 : TextAttr := TextAttr And $F8 Or $07;
									40 : TextAttr := TextAttr And $8F Or $00;
									41 : TextAttr := TextAttr And $8F Or $40;
									42 : TextAttr := TextAttr And $8F Or $20;
									43 : TextAttr := TextAttr And $8F Or $60;
									44 : TextAttr := TextAttr And $8F Or $10;
									45 : TextAttr := TextAttr And $8F Or $50;
                  46 : TextAttr := TextAttr And $8F Or $30;
									47 : TextAttr := TextAttr And $8F Or $70;
								End {Case} ;
								{ fixup for reverse }
								If Reverse Then TextAttr := TextAttr Shr 4 + TextAttr Shl 4;
							End;
						End;
					'A' :                 {cuu}
						Begin
							If ParamArr[1] = 0 Then ParamArr[1] := 1;
							{If (Wherey - ParamArr[1] >= 1)
							Then} GotoXy(WhereX, Wherey - ParamArr[1])
							{Else GotoXy(WhereX, 1);}
						End;
					'B' :                 {cud}
						Begin
							If ParamArr[1] = 0 Then ParamArr[1] := 1;
							{If (Wherey + ParamArr[1] <= Hi(WindMax) - Hi(WindMin) + 1)
							Then }GotoXy(WhereX, Wherey + ParamArr[1])
							{Else GotoXy(WhereX, Hi(WindMax) - Hi(WindMin) + 1);}
						End;
					'C' :                 {cuf}
						Begin
							If ParamArr[1] = 0 Then ParamArr[1] := 1;
							{If (WhereX + ParamArr[1] <= Lo(WindMax)	- Lo(WindMin) + 1)
							Then} GotoXy(WhereX + ParamArr[1], Wherey)
							{Else GotoXy(Lo(WindMax) - Lo(WindMin) + 1, Wherey);}
						End;
					'D' :                 {cub}
						Begin
							If (ParamArr[1] = 0) Then ParamArr[1] := 1;
							{If (WhereX - ParamArr[1] >= 1)
							Then} GotoXy(WhereX - ParamArr[1], Wherey)
							{Else GotoXy(1, Wherey);}
						End;
					'H', 'f' :            {cup,hvp}
						Begin
							If (ParamArr[1] = 0) Then ParamArr[1] := 1;
							If (ParamArr[2] = 0) Then ParamArr[2] := 1;

							{If (ParamArr[2] > Lo(WindMax) + 1)
								then ParamArr[2] := Lo(WindMax) - Lo(WindMin) + 1;
							If (ParamArr[1] > Hi(WindMax) + 1)
								then ParamArr[1] := Hi(WindMax) - Hi(WindMin) + 1;}
							GotoXy(ParamArr[2], ParamArr[1]) ;
						End;
					'J' : if (ParamArr[1] = 2) then clrscr
								else
									for i := WhereY to 25 do delline; { some terms use others! }
					'K' : clreol;
					'L' : if (ParamArr[1] = 0) then
									InsLine
								else
									For i := 1 To ParamArr[1] Do InsLine; { must not move cursor }
					'M' : if (ParamArr[1] = 0) then
									delline
								else
									For i := 1 To ParamArr[1] Do DelLine; { must not move cursor }
					'P' :                 {dc }
						Begin
						End;
					's' :                 {scp}
						Begin
							SavedX := WhereX;
							SavedY := Wherey;
						End;
					'u' : {rcp} GotoXy(SavedX, SavedY);
					'@':; { Some unknown code appears to do nothing }
					else
							Write(c);
				end {Case c} ;
			end;
	end {Case NextState} ;
end {AnsiWrite} ;

procedure shelldos(MakeBatch:boolean; const Command:astr; var ResultCode:byte);
var
	t:text;
	fname:astr;
	i:byte;
  s:astr;
begin
	if (MakeBatch) then
		begin
			fname := 'TEMP'+cstr(node)+'.BAT';
			assign(t,fname);
			rewrite(t);
			writeln(t,Command);
			close(t);
			Lasterror := ioresult;
		end
	else
		fname := Command;

  if (fname <> '') then
    fname := '/c ' + fname;

	com_flush_tx;

	com_deinstall;

	cursoron(TRUE);

	swapvectors;
	if general.swapshell then
		begin
      s := getenv('TEMP');
      if (s = '') then
        s := start_dir;
      init_spawno(s,general.swapto,20,10);
      ResultCode := spawn(getenv('COMSPEC'),fname,0);
		end;

	if not general.swapshell or (ResultCode = -1) then
		begin
			exec(getenv('COMSPEC'),fname);
			ResultCode := lo(dosexitcode);
			Lasterror := ioresult;
		end;

	swapvectors;

	if (MakeBatch) then
		kill(fname);

	initport;

	if (not localioonly) and not (lockedport in liner.mflags) then
		com_set_speed(speed);

	update_screen;

	textattr := curco;

	LastKeyHit := timer;
end;

procedure autovalidate(var u:userrec; var un:integer; level:char);
const
	settings:set of uflags=[rlogon,rchat,ruserlist,rvalidate,ramsg,
													rpostan,rpost,remail,rvoting,rmsg,fnodlratio,
													fnopostratio,fnocredits,fnodeletion];
begin
	if not (level in ['A'..'Z']) then
		exit;

	with u,general,validation[level] do
		begin

			userstartmenu := newmenu;
      Subscription := Level;

			tltoday := timeallow[newsl] -
								 (timeallow[sl] - tltoday);

			sl := newsl;
			dsl := newdsl;

			if not softac then
					flags := flags - settings;

			flags := flags + (newac * settings);

			if softar then
				ar := ar + newar
			else
				ar := newar;

			inc(credit, newcredit);

			if (validation[level].expiration > 0) then
				u.expiration := getpackdatetime +
					(validation[level].expiration * 86400)
			else
				u.expiration := 0;

			if (validation[level].expireto in [' ','A'..'Z']) then
				u.expireto := validation[level].expireto;

			if (un = usernum) then
				newcomptables;
		end;
	saveurec(u, un);
end;

function lennmci(const s:string):integer;
var
	i,len:byte;
  junk:string;
begin
	len:=length(s);
	i := 0;
	while i < length(s) do
		begin
			inc(i);
			case s[i] of
				^S:begin
						dec(len,2);
						inc(i);
					 end;
				'^':if (length(s) > i) and (s[i + 1] in ['0'..'9']) then
							begin
								dec(len, 2);
								inc(i);
							end;
				'|':if (length(s) > i + 1) and (s[i + 1] in ['0'..'9']) and
							(s[i + 2] in ['0'..'9']) then
							begin
								dec(len, 3);
								inc(i);
							end;
				'%':if mciallowed and (length(s) > i + 1) then
							begin
                junk := allcaps(MCI('%' + s[i + 1] + s[i + 2]));
                if (copy(junk,1,3) <> '%' + upcase(s[i + 1]) + upcase(s[i + 2])) then
                  inc(len, length(junk) - 3);
							end;
			end;
		end;
	lennmci:=len;
end;

procedure loadfileboard(i:integer);
var
	fo:boolean;
begin
	if (readuboard = i) then exit;

	if (i < 1) then exit;

	if (i > MaxFBases) {or (i < 1)} then
		begin
			memuboard := tempuboard;
			readuboard := i;	{ was -1 }
			exit;
		end;

	fo := (filerec(FBasesFile).mode<>fmclosed);
	if not fo then
		begin
			reset(FBasesFile);
			if (IOResult > 0) then
				begin
					sysoplog('error opening FBASES.DAT');
					runerror(5);
				end;
		end;

	seek(FBasesFile,i-1);
	read(FBasesFile,memuboard);
	if (IOResult > 0) then
		sysoplog('error loading file base ' + cstr(i))
	else
		readuboard := i;

	if not fo then
		begin
			close(FBasesFile);
			if (IOResult > 0) then
				sysoplog('error closing FBASES.DAT');
		end;
end;

procedure loadboard(i:integer);
var
	fo:boolean;
begin
	if (i = -1) then
		begin
			fillchar(memboard,sizeof(memboard),0);
			memboard.filename:='EMAIL';
			memboard.name:='Private Mail';
			memboard.acs:='^';
			memboard.sysopacs:=general.msop;
			memboard.origin_color:=5;
			memboard.tear_color:=9;
			memboard.text_color:=1;
			memboard.quote_color:=3;
			readboard:= -1;
			NewScanMBase := TRUE;
		end;
	if (i < 1) or (i > MaxMBases) or (readboard = i) then exit;

	fo := (filerec(MBasesFile).mode <> fmclosed);
	if not fo then
		begin
			reset(MBasesFile);
			if (IOResult > 0) then
				begin
					sysoplog('error opening MBASES.DAT');
					runerror(5);
				end;
		end;

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

	if (IOResult > 0) then
		sysoplog('error loading message base ' + cstr(i))
	else
		readboard := i;

	if not fo then
		begin
			close(MBasesFile);
			if (IOResult > 0) then
				sysoplog('error closing MBASES.DAT');
		end;
end;

{$V-}
procedure lcmds3(len,c:byte; c1,c2,c3:astr);
var s:astr;
begin
	s:='';
	s:=s+'^1(^'+chr(c + ord('0'))+c1[1]+'^1)'+mln(copy(c1,2,lennmci(c1)-1),len-1);
	if (c2<>'') then
		s:=s+'^1(^'+ chr(c + ord('0')) + c2[1]+'^1)'+mln(copy(c2,2,lennmci(c2)-1),len-1);
	if (c3<>'') then
		s:=s+'^1(^' + chr(c + ord('0')) + c3[1]+'^1)'+copy(c3,2,lennmci(c3)-1);
  printacr(s);
end;

procedure lcmds(len,c:byte; c1,c2:astr);
var
	s:astr;
begin
	s := copy(c1,2,lennmci(c1) - 1);
	if (c2 <> '') then
		s := mln(s,len - 1);
  prompt('^1(^' + cstr(c) + c1[1] + '^1)' + s);
	if (c2 <> '') then
    prompt('^1(^' + cstr(c) + c2[1] + '^1)' + copy(c2,2,lennmci(c2) - 1));
	nl;
end;

function MsgSysOp:boolean;
begin
	MsgSysOp := (CoSysOp) or (aacs(general.msop)) or (aacs(memboard.sysopacs));
end;

function FileSysOp:boolean;
begin
	FileSysOp := ((CoSysOp) or (aacs(general.fsop)));
end;

function CoSysOp:boolean;
begin
	CoSysOp := ((so) or (aacs(general.csop)));
end;

function so:boolean;
begin
	so := (aacs(general.sop));
end;

function timer:longint;
begin
	timer := ticks * 5 div 91;		 { 2.5 times faster than ticks div 18.2 }
end;

function fbaseac(Base:integer):boolean;
begin
	fbaseac := FALSE;
	if (Base < 1) or (Base > MaxFBases) then
		exit;
	loadfileboard(Base);
	fbaseac := aacs(memuboard.acs);
end;

function mbaseac(Base:integer):boolean;
begin
	mbaseac := FALSE;
	if (Base < 1) or (Base > MaxMBases) then
		exit;
	loadboard(Base);
	mbaseac := aacs(memboard.acs);
end;

procedure changefileboard(Base:integer);
var
	s:string[20];
begin
	if (Base < 1) or (Base > MaxFBases) or (not fbaseac(Base)) then
		exit;
	if (memuboard.password <> '') and not sortfilesonly then
		begin
			print(^M^J'File base ' + cstr(cfbase(Base)) + ': ^5' + memuboard.name);
			prt('Password: ');
			echo := FALSE;
			input(s,20);
			echo := TRUE;
			if (s <> memuboard.password) then
				begin
					print('Wrong.');
					exit;
				end;
		end;
	fileboard := Base;
	thisuser.lastfbase := fileboard;
end;

procedure changeboard(Base:integer);
var
	s:string[20];
begin
	if (Base < 1) or (Base > MaxMBases) then
		exit;
	if (not mbaseac(Base)) then
		exit;
	if (memboard.password<>'') then
		begin
			print(^M^J'Message base ' + cstr(cmbase(Base)) + ': ^5' + memboard.name);
			prt('Password: ');
			echo := FALSE;
			input(s,20);
			echo := TRUE;
			if (s <> memboard.password) then
				begin
					print('Wrong.');
					exit;
				end;
		end;
	board := Base;
	thisuser.lastmbase := board;
end;

function okvt100:boolean;
begin
	okvt100 := (vt100 in thisuser.flags);
end;

function okansi:boolean;
begin
	okansi := (ansi in thisuser.flags);
end;

function okrip:boolean;
begin
	okrip := (rip in thisuser.sflags);
end;

function okavatar:boolean;
begin
	okavatar := (avatar in thisuser.flags);
end;

function nsl:longint;
var
	beenon:longint;
begin
	if ((useron) or (not inwfcmenu)) then
		begin
			beenon := getpackdatetime - timeon;
			nsl := ((longint(thisuser.tltoday) * 60 + extratime + freetime) - (beenon + choptime + credittime));
		end
	else
		nsl := 3600;
end;

procedure CheckHangup; assembler;
asm
	cmp localioonly, 1
	je @getout
	cmp outcom, 1
	jne @getout
	mov dx, Fossilport
	mov ah, 3
	pushf
	call interrupt14
	and al, 10000000b
	jnz @getout
	mov Hangup, 1
	mov hungup, 1
	@getout:
end;

function intime(tim,tim1,tim2:longint):boolean;
begin
	intime := TRUE;
	while (tim >= 86400) do
		tim := tim - 86400;
	if (tim1 <> tim2) then
		if (tim2 > tim1) then
			if (tim <= tim1 * 60) or (tim >= tim2 * 60) then
				intime := FALSE
			else
		else
			if (tim <= tim1 * 60) and (tim >= tim2 * 60) then
				intime := FALSE;
end;

function stripcolor(const o:string):string;
var
	i,j:byte;
	s:string;
begin
	i:=0;
	s:='';
	while (i < length(o)) do
		begin
			inc(i);
			case o[i] of
				 ^S:inc(i);
				'^':if (o[i+1] in ['0'..'9']) then
							inc(i)
						else
							s := s+'^';
				'|':if (o[i + 1] in ['0'..'9']) and
							 (o[i + 2] in ['0'..'9']) then
							begin
								inc(i,2);
								inc(j,2);
							end
						else
							s:=s+'|';
				else s:=s+o[i];
			end;
		end;
	stripcolor:=s;
end;

procedure sl1(s:astr);
begin
	if (slogging) then
		begin
			if (general.stripclog) then
				s:=stripcolor(s);

			if (general.slogtype < 2) then
				begin
					append(sysopf);
					if (ioresult = 0) then
						begin
							writeln(sysopf,s);
							close(sysopf);
							Lasterror := IOResult;
						end;
				end;

			if (slogseparate in thisuser.sflags) then
				begin
					append(sysopf1);
					if (IOResult = 0) then
						begin
							writeln(sysopf1,s);
							close(sysopf1);
							Lasterror := IOResult;
						end;
				end;

			if (general.slogtype > 0) then
				begin
					if (not general.stripclog) then
						s := stripcolor(s);
          Lasterror := IOResult;
          append(lpt);
					writeln(lpt,s);
					close(lpt);
					if (ioresult > 0) then
						general.slogtype := 0;
				end;
	end;
end;

procedure sysoplog(s:astr);
begin
	sl1('   '+s);
end;

function Zeropad(s:str8):string;
begin
	if (length(s)>2) then s:=copy(s,length(s)-1,2) else
		if (length(s)=1) then s:='0'+s;
	Zeropad:=s;
end;

function time:string;
var h,m,ampm:string[3];
		hh,mm,ss,ss100:word;
begin
	gettime(hh,mm,ss,ss100);
	if (hh > 11) then
		ampm := ' pm'
	else
		ampm := ' am';
	if (hh > 12) then
		dec(hh,12);
	if (hh = 0) then
		hh := 12;
	str(hh,h); str(mm,m);
	time:=h+':'+Zeropad(m)+ampm;
end;

function date:string;
var y,m,d:string[4];
    yy,mm,dd,dow:word;

begin
	getdate(yy,mm,dd,dow);
	str(yy,y); str(mm,m); str(dd,d);
  date:=Zeropad(m)+'-'+Zeropad(d)+'-'+y;
end;


function value(s:astr):longint;
var i:longint;
		j:integer;
begin
	val(s,i,j);
	if (j > 0) then
		begin
			s[0] := chr(j-1);
			val(s,i,j)
		end;
	value := i;
	if (s = '') then
		value := 0;
end;

function Ageuser(const birthdate:longint):integer;
var
  dt1:datetime;
  dt2:datetime;
  i:integer;
begin
  PackToDate(dt1, birthdate);
  GetDateTime(dt2);
  i := dt2.year - dt1.year;
  if (dt2.month < dt1.month) then
    dec(i);
  if (dt2.month = dt1.month) and (dt2.day < dt1.day) then
    dec(i);
  Ageuser := i;
end;

function allcaps(s:string):string;
var
	i:integer;
begin
	for i:=1 to length(s) do
		if (s[i] in ['a'..'z']) then
			s[i] := chr(ord(s[i]) - ord('a')+ord('A'));
	allcaps:=s;
end;

function caps(s:string):string;
var i:integer;		{ must be integer, otherwise 0 length arg fucks up }
begin
  if (s[1] in ['a'..'z']) then
    dec(s[1], 32);

  for i := 2 to length(s) do
    if (s[i - 1] in ['a'..'z','A'..'Z']) then
      if (s[i] in ['A'..'Z']) then
        inc(s[i], 32)
      else
    else
      if (s[i] in ['a'..'z']) then
        dec(s[i], 32);

	caps := s;
end;

function days(var mo,yr:integer):integer;
var d:integer;
begin
	d:=value(copy('312831303130313130313031',1+(mo-1)*2,2));
	if ((mo=2) and (yr mod 4 = 0)) then inc(d);
	days:=d;
end;

function daycount(var mo,yr:integer):integer;
var
	m,t:integer;
begin
	t:=0;
	for m:=1 to (mo-1) do
		t:=t+days(m,yr);
	daycount:=t;
end;

function daynum(dt:str10):integer;
var
	d,m,y,c,t:integer;
begin
	t:=0;
	m:=value(copy(dt,1,2));
	d:=value(copy(dt,4,2));
	y:=value(copy(dt,7,4));
	for c:=1985 to y-1 do
		if (c mod 4 = 0) then inc(t,366) else inc(t,365);
	t:=t+daycount(m,y)+(d-1);
	daynum:=t;
	if y<1985 then daynum:=0;
end;

function dat:string;
var year,month,day,dayofweek,hour,minute,second,sec100:word;
		ap:string[2];
begin
	getdate(year,month,day,dayofweek);
	gettime(hour,minute,second,sec100);

	if (hour<12) then ap:='AM'
	else begin
		ap:='PM';
		if (hour>12) then dec(hour,12);
	end;
	if (hour=0) then hour:=12;

	dat:=cstr(hour)+':'+Zeropad(cstr(minute))+' '+ap+'  '+
			 copy(DayString[dayofweek],1,3)+' '+
			 copy(MonthString[month],1,3)+' '+cstr(day)+', '+cstr(year);
		{5:43 pm	Fri Feb 18, 2000}
end;

procedure SerialOut(s:string);
begin
	if outcom then
		with regs do
			repeat
				if (digiboard in liner.mflags) then
					begin
						ah:=$0e;
						bx:=ofs(s[1]);
					end
				else
					begin
						ah:=$19;
						di:=ofs(s[1]);
					end;
				cx := length(s);
				dx:=FossilPort;
				es:=seg(s[1]);
				intr($14,regs);
				move(s[ax + 1], s[1],length(s) - ax);
				dec(s[0], ax);
			until (s='');
end;

function getc(c:byte):string;
const xclr:array[0..7] of char=('0','4','2','6','1','5','3','7');
var s:string[10];
		b:boolean;


	procedure adto(ss:str8);
	begin
		if (s[length(s)]<>';') and (s[length(s)]<>'[') then s:=s+';';
		s:=s+ss; b:=TRUE;
	end;

begin
	b:=FALSE;
	if ((curco and (not c)) and $88)<>0 then begin
		s:=#27+'[0';
		curco:=$07;
	end else
		s:=#27+'[';
	if (c and 7<>curco and 7) then adto('3'+xclr[c and 7]);
	if (c and $70<>curco and $70) then adto('4'+xclr[(c shr 4) and 7]);
	if (c and 128<>0) then adto('5');
	if (c and 8<>0) then adto('1');
	if (not b) then adto('3'+xclr[c and 7]);
	s:=s+'m';
	getc:=s;
end;

procedure setc(c:byte);
begin
	if not (okansi or okavatar) then
		begin
			textattr:=7;
			exit;
		end;

	if (c<>curco) then begin
		if not (color in thisuser.flags) then
			if (c and 8 = 8) then
				 c:=15
			else
				 c:=7;
		if (outcom) then
			if (okavatar) then
				SerialOut(^V^A+chr(c and $7f))
			else
				SerialOut(getc(c));
		textattr:=c;
		curco:=c;
	end;
end;

procedure UserColor(c:integer);
begin
	if (c in [0..9]) then
		if (okansi or okavatar) then
			setc(Scheme.Color[c + 1]);
end;

function sqoutsp(s:string):string;
begin
	while (pos(' ',s)>0) do delete(s,pos(' ',s),1);
	sqoutsp:=s;
end;

function ExtractDriveNumber(s:astr):byte;
begin
	s:=fexpand(s);
	ExtractDriveNumber:=ord(s[1])-64;
end;

function mln(s:string; l:byte):string;
var
	x,j:byte;
begin
	x := lennmci(s);
	if (x > l) then
    while (x > l) do  { can't be done more efficiently, old one had probs }
      begin                      { dealing with the last chars being MCIs }
        s[0] := chr(l + (length(s) - x));
        x := lennmci(s);
      end
	else
		for j := x to l - 1 do
			s := s + ' ';
	mln:=s;
end;

function mrn(s:string; l:byte):string;
var
	x,b:byte;
begin
	x := lennmci(s);
	for b := x to l - 1 do
		s := ' ' + s;
	if x > l then
		s[0] := chr(l + (length(s) - x));
	mrn:=s;
end;

function mn(i:longint; l:byte):string;
begin
	mn:=mln(cstr(i),l);
end;

procedure prompt(const s:string);
var
	old:boolean;
begin
	old:=allowAbort;
	allowAbort:=FALSE;
  printmain(s);
	allowAbort:=old;
end;

procedure print(const s:string);
begin
	prompt(s+^M^J);
end;

procedure nl;
begin
	prompt(^M^J);
end;

procedure prt(const s:string);
begin
	UserColor(4); prompt(s); UserColor(3);
end;

procedure mpl(c:integer);
var i:integer;
		x:byte;
begin
	if (okansi or okavatar) then
		begin
			UserColor(6);
			x:=wherex;
			if (outcom) then
				for i:=1 to c do com_tx(' ');
			if (wantout) then
				for i:=1 to c do write(' ');
			gotoxy(x,wherey);
			if (outcom) then
				begin
					if (okavatar) then
						SerialOut(^Y+^H+chr(c))
					else
						SerialOut(#27+'['+cstr(c)+'D');
				end;
		end;
end;

function empty:boolean;
begin
	Empty := not Keypressed;
	if (Incom) and (not Keypressed) then
		begin
			regs.dx := FossilPort;
			regs.ah := $03;
			intr($14, regs);
			Empty := not (regs.ah and 1 = 1);
		end;
end;

function inkey:word;
var
  c:char;
  l:longint;
begin
  c := #0; inkey := 0;
  CheckHangup;
  if (keypressed) then
    begin
      c := readkey;
      if (c = #0) and (keypressed) then
        begin
          c := readkey;
          skey1(c);
          if (c = #68) then
            c := #1
          else
            begin
              inkey := ord(c) * 256;        { Return scan code in MSB }
              exit;
            end;
        end;
      if (buf <> '') then
        begin
          c := buf[1];
          buf := copy(buf, 2, 255);
        end;
      inkey := ord(c);
    end
  else
    if (incom) then
      begin
        c := cinkey;
        if (c = #27) then
          begin
            if empty then
              delay(100);

            if (c = #27) and not empty then
              begin
                c := cinkey;
                if (c = '[') or (c = 'O') then
                  begin
                    l := ticks + 4;
                    c := #0;
                    while (l > ticks) and (c = #0) do
                      c := cinkey;
                  end;

                case char(c) of
                  'A':inkey := F_UP;      {UpArrow}
                  'B':inkey := F_DOWN;    {DownArrow}
                  'C':inkey := F_RIGHT;   {RightArrow}
                  'D':inkey := F_LEFT;    {LeftArrow}
                  'H':inkey := F_HOME;    {Home}
                  'K',                {End - PROCOMM+}
                  'R':inkey := F_END;     {End - GT}
                  'r':inkey := F_PGUP;    {PgUp}
                  'q':inkey := F_PGDN;    {PgDn}
                  'n':inkey := F_INS;     {Ins}
                end;
                exit;
              end;
          end;
        if (c = #127) then
          inkey := F_DEL
        else
          inkey := ord(c);
      end;
end;

procedure outtrap(c:char);
begin
	if (c<>^G) then
		write(trapfile,c);
	if (IOResult > 0) then
    begin
      sysoplog('error writing to trap file.');
      trapping := FALSE;
    end;
end;

procedure outkey(c:char);
var bb:byte;
begin
	if (not echo) then
		if (general.localsec) and (c in [#32..#255]) then
			c:=fstring.echoc;

	if (c in [#27,^V,^Y]) then
		dosansion:=TRUE;

	if wantout and dosansion and (NextState <> Waiting) then
		begin
			dosansi(c);
			if (outcom) then
				com_tx(c);
			exit;
		end
	else
		if (c <> ^J) and (c <> ^L) then
			if (wantout) and (not dosansion) and not ((c=^G) and incom) then
				write(c)
			else
				if wantout and not ((c=^G) and incom) then
					dosansi(c);

	if (not echo) and (c in [#32..#255]) then
		c:=fstring.echoc;


	case c of
		^J:begin
				 if (not ch) and (not write_msg) and (not ctrljoff) and (not dosansion)
					 then
						 begin
							 if (((curco shr 4) and 7) > 0) or (curco and 128 = 128) then
								 setc(Scheme.Color[1])
						 end
					 else
						 lil := 1;
         if (trapping) then
           OutTrap(c);
				 if (wantout) then
					 write(^J);
				 if (outcom) then
					 com_tx(^J);
				 inc(lil);
				 if (lil >= pagelength) then
					 begin
						 lil := 1;
						 if TempPause then
							 pausescr(TRUE);
					 end;
			 end;
		^L:begin
				 if (wantout) then
					 clrscr;
				 if (outcom) then
					 com_tx(^L);
				 lil := 1;
			 end;
	 else
     begin
       if (outcom) then
         com_tx(c);
       if (trapping) then OutTrap(c);
     end;
	end;
end;


function pagelength:word;
begin
	if incom then
		pagelength := thisuser.pagelen
	else
		if General.WindowOn and not (InWFCMenu) then
			pagelength := MaxDisplayRows - 2
		else
			pagelength := MaxDisplayRows;
end;

procedure TeleConfCheck;
var
	i:byte;
	f:file;
	s:string;
	oldmciallowed:boolean;
{ Only check if we're bored and not slicing }
begin
	if (maxchatrec > nodechatlastrec) then
		begin
			for i := 1 to lennmci(mlc) + 5 do
				backspace;
			assign(f, general.multpath + 'message.'+cstr(node));
			reset(f, 1);
			seek(f, nodechatlastrec);
			while not eof(f) do
				begin
					blockread(f,s[0],1);
					blockread(f,s[1],ord(s[0]));
					multinodechat := FALSE;  {avoid recursive calls during pause!}
					oldmciallowed := mciallowed;
					mciallowed := FALSE;
					print(s);
					mciallowed := oldmciallowed;
					multinodechat := TRUE;
				end;
			close(f);
			Lasterror := IOResult;
			nodechatlastrec := maxchatrec;
			prompt('^3' + mlc);
		end;
end;

function getkey:word;
const
	LastTimeSlice:longint = 0;
	LastCheckTimeSlice:longint = 0;
var
	TempTimer:longint;
	tf:boolean;
	i:integer;
  c:word;
  killme: pointer absolute $0040:$f000;

begin
  if (DIELATER) then
    asm
      call killme
    end;

	lil := 1;
  if (buf <> '') then
		begin
      c := ord(buf[1]);
      buf := copy(buf, 2, 255);
		end
  else
    begin
      if (not empty) then
        begin
          if (ch) then
            c := ord(chinkey)
          else
            c := inkey;
        end
      else
        begin
          tf := FALSE;
          LastKeyHit := timer;
          c := 0;
          while ((c = 0) and (not Hangup)) do
            begin
              TempTimer := timer;
              if (LastScreenSwap > 0) then
                begin
                  if (TempTimer - LastScreenSwap < 0) then
                    LastScreenSwap := Timer - LastScreenSwap + 86400;
                  if (TempTimer - LastScreenSwap > 10) then
                    update_screen;
                end;

              if (alert in thisuser.flags) or ((not shutupchatcall) and (general.chatcall) and (chatr<>'')) then
                begin
                  if (Temptimer - LastBeep) < 0 then
                    LastBeep := (Temptimer - LastBeep) + 86400;
                  if ((alert in thisuser.flags) and ((Temptimer - LastBeep)>=general.alertbeep)) or
                      ((chatr<>'') and (sysopavailable) and ((Temptimer - LastBeep)>=5)) then
                    begin
                      for i := 1 to 100 do
                        begin
                          sound(500 + (i * 10));
                          delay(2);
                          sound(100 + (i * 10));
                          delay(2);
                          nosound;
                        end;
                      LastBeep := Temptimer;
                    end;
                end;

              if (Temptimer - LastKeyHit) < 0 then
                LastKeyHit := (Temptimer - LastKeyHit) + 86400;

              if (general.timeout <> -1) and
                 ((TempTimer - LastKeyHit) > general.timeout * 60) and
                 (not timedout) and (Speed <> 0) then begin
                timedout := TRUE;
                printf('timedout');
                if (nofile) then
                  print(^M^J^M^J'Time out - disconnecting.'^M^J^M^J);
                Hangup := TRUE;
                sysoplog('Inactivity timeout at '+time);
              end;

              if (general.timeoutbell <> -1) and
                 ((Temptimer - LastKeyHit) > general.timeoutbell * 60) and (not tf) then begin
                tf := TRUE;
                outkey(^G); delay(100); outkey(^G);
              end;

              if (Empty) then
                begin
                  if (abs((Ticks - LastTimeSlice)) >= SliceTimer) then
                    begin
                      case Tasker of
                        None: asm
                                int 28h
                              end;
                        DesqView: asm
                                    mov ax, 1000h
                                    int 15h
                                  end;
                        Windows: asm
                                   mov ax, 1680h
                                   int 2Fh
                                 end;
                        OS2: asm
                               push dx
                               xor dx, dx
                               mov ax, 0
                               sti
                               hlt
                               db 035h, 0Cah
                               pop dx
                             end;
                      end;
                      LastTimeSlice := Ticks;
                    end
                  else
                    if multinodechat and not ch
                      and (abs(Ticks - LastCheckTimeSlice) > 9) then
                      begin
                        LastCheckTimeSlice := Ticks;
                        TeleConfCheck;
                        lil := 1;
                      end;
                end;

              if (ch) then
                c := ord(chinkey)
              else
                c := inkey;
            end;

            if (useron) and (GetPackDateTime - CreditsLastUpdated > 60) and not (fnocredits in thisuser.flags) then
              begin
                inc(Thisuser.Debit, General.CreditMinute * ((GetPackDateTime - CreditsLastUpdated) DIV 60));
                CreditsLastUpdated := GetPackDateTime;
              end;
        end;
    end;
  getkey := c;
end;

procedure cls;
begin
	if (okansi or okvt100) then
		SerialOut(^[ + '[1;1H' + ^[ + '[2J')
	else
		outkey(^L);
	if (wantout) then clrscr;
	if (trapping) then OutTrap(^L);
	UserColor(1);
	lil := 1;
end;

procedure swac(var u:userrec; r:uflags);
begin
	with u do
		if (r in flags) then
			flags:=flags-[r]
		else
			flags:=flags+[r];
end;

function tacch(c:char):uflags;
begin
	case c of
		'L':tacch:=rlogon;
		'C':tacch:=rchat;
		'V':tacch:=rvalidate;
		'U':tacch:=ruserlist;
		'A':tacch:=ramsg;
		'*':tacch:=rpostan;
		'P':tacch:=rpost;
		'E':tacch:=remail;
		'K':tacch:=rvoting;
		'M':tacch:=rmsg;
		'1':tacch:=fnodlratio;
		'2':tacch:=fnopostratio;
		'3':tacch:=fnocredits;
		'4':tacch:=fnodeletion;
	end;
end;

procedure acch(c:char; var u:userrec);
begin
	swac(u,tacch(c));
end;

function aonoff(b:boolean; const s1, s2:astr):string; assembler;
ASM
       PUSH DS
       TEST b, 1
       JZ   @@1
       LDS  SI, s1
       JMP  @@2
@@1:   LDS  SI, s2
@@2:   LES  DI, @Result
       XOR  CH, CH
       MOV  CL, BYTE PTR DS:[SI]
       MOV  BYTE PTR ES:[DI], CL
       INC  DI
       INC  SI
       CLD
       REP  MOVSB
       POP  DS
END;

function onoff(b:boolean):string;
begin
	if (b) then onoff:='On ' else onoff:='Off';
end;

function syn(b:boolean):string;
begin
	if (b) then syn:='Yes' else syn:='No ';
end;

function yn:boolean;
var c:char;
begin
	if (not Hangup) then begin
		UserColor(3);
		prompt(sqoutsp(syn(dyny)));
		repeat
      c := upcase(char(getkey));
		until (c in ['Y','N',^M]) or (Hangup);
		if (dyny) and (c<>'N') then c:='Y';
		if (dyny) and (c = 'N') then
      print(#8#8#8'No ')
		else
			if (not dyny) and (c = 'Y') then
        print(#8#8'Yes')
			else
				nl;
    UserColor(1);
		yn := (c = 'Y') and not Hangup;
	end;
	dyny:=FALSE;
end;

function pynq(const s:astr):boolean;
begin
	UserColor(7); prompt(s);
	pynq:=yn;
end;

procedure onek(var c:char; ch:astr);
var
	s:string[3];
begin
  TempPause := (pause in thisuser.flags);
	repeat
    c := upcase(char(getkey));
	until (pos(c, ch) > 0) or (Hangup);
	if (Hangup) then c:=ch[1];
	if (onekda) then
		outkey(c);
	if (trapping) then OutTrap(c);
	if (onekcr) then nl;
	onekcr:=TRUE;
	onekda:=TRUE;
end;

function centre(s:astr):string;
var i,j:integer;
begin
	i := lennmci(s);
	if i < thisuser.linelen then
		begin
			j := (thisuser.linelen - i) div 2;
			move (s[1],s[j+1],length(s));
			inc (s[0],j);
			fillchar (s[1],j,#32);
		end;
	centre:=s;
end;

procedure wkey;
var c:char;
begin
	if (not allowAbort) or (Abort) or (Hangup) or (empty) then exit;
  c := char(getkey);
	if (displayingmenu) and (pos(upcase(c),menukeys)>0) then
		begin
			menuAborted:=TRUE;
			Abort:=true;
			buf:=buf+upcase(c);
		end
	else
		case upcase(c) of
		 ' ',^C,^X,^K:Abort:=TRUE;
					 'N',^N:if (reading_a_msg) then
										begin
											Abort:=TRUE;
											Next:=TRUE;
										end;
           'P',^S:c := char(getkey);
			else
				if (reading_a_msg) or (printingfile) then
					if (c <> #0) then
						buf := buf + c;
		end;
	if (Abort) then
		begin
			com_purge_tx;
			nl;
		end;
end;

function ctim(rl:longint):string;
var h,m,s:string[2];
begin
	h := Zeropad(cstr(rl div 3600));	rl := rl mod 3600;
	m := Zeropad(cstr(rl div 60));		rl := rl mod 60;
	s := Zeropad(cstr(rl));
	ctim:=h+':'+m+':'+s;
end;

function cstr(l:longint):string;
var
	Result: ^string;
begin
	Inline($89/$EC/$16/$FF/$76/$0A); {set pointer to function}
	str(l,Result^);
end;

procedure printmain(const ss:string);
var i,x:word;
		x2:byte;
		c:char;
		cs:string;
    s:string;
    Justify:byte;
begin
	if (Abort) and (allowAbort) then
		exit;

	if (Hangup) then
		begin
			Abort:=TRUE;
			exit;
		end;


  if (not MCIAllowed) then
    s := ss
  else
    begin
      s := '';
      for i := 1 to length(ss) do
        if (ss[i] = '%') and (i + 2 <= length(ss)) then
          begin
            cs := MCI(copy(ss,i,3));      { faster than adding }
            if (cs = copy(ss,i,3)) then
              begin
                s := s + '%';
                continue;
              end;
            inc(i, 2);
            if (length(ss) >= i + 2) and (ss[i + 1] in ['#','{','}']) then
              begin
                if (ss[i + 1] = '}') then
                  Justify := 0
                else if (ss[i + 1] = '{') then
                  Justify := 1
                else
                  Justify := 2;
                if (ss[i + 2] in ['0'..'9']) then
                  begin
                    x2 := ord(ss[i + 2]) - 48;
                    inc(i, 2);
                    if (ss[i + 1] in ['0'..'9']) then
                      begin
                        x2 := x2 * 10 + ord(ss[i + 1]) - 48;
                        inc(i, 1);
                      end;
                    if (x2 > 0) then
                      case Justify of
                        0:cs := mrn(cs, x2);
                        1:cs := mln(cs, x2);
                        2:while (length(cs) < x2) do
                            begin
                              cs := ' ' + cs;
                              if (length(cs) < x2) then
                                cs := cs + ' ';
                            end;
                      end;
                  end;
              end;
            { s := s + cs; }
            if (length(cs) + length(s) <= 255) then
              begin
                move(cs[1], s[length(s)+1], length(cs));
                inc(s[0], length(cs));
              end
            else
              if (length(s) < 255) then
                begin
                  move(cs[1], s[length(s)+1], 255-length(s));
                  s[0] := #255;
                end;
          end
        else
          if (length(s) < 255) then   { s := s + ss[i]; }
            begin
              inc(s[0]);
              s[length(s)] := ss[i];
            end;
    end;

	if not (okansi or okavatar) then
    s := stripcolor(s);

  i := 1;
  if ((not abort) or (not allowAbort)) and (not Hangup) then  { can't change in loop }
    while (i <= length(s)) do
      begin
        case s[i] of
          '%':if mciallowed and (i + 1 < length(s)) then
                 begin
                   if (upcase(s[i + 1]) = 'P') and (upcase(s[i + 2]) = 'A') then
                     begin
                       inc(i, 2);
                       pausescr(FALSE)
                     end
                   else
                     if (upcase(s[i + 1]) = 'D') then
                       if (upcase(s[i + 2]) = 'E') then
                         begin
                           inc(i, 2);
                           outkey(' '); outkey(#8); { guard against +++ }
                           delay(800);
                         end
                       else
                         if ((upcase(s[i + 2]) = 'F') and (not printingfile)) then
                           begin
                             cs := ''; inc(i, 3);
                             while (i < length(s)) and (s[i] <> '%') do
                               begin
                                 cs := cs + s[i];
                                 inc(i);
                               end;
                             printf(stripname(cs));
                           end
                         else
                     else
                       outkey('%');
                 end
               else
                 outkey('%');
          ^S:if (i < length(s)) and (NextState = Waiting) then
               begin
                 if (ord(s[i + 1]) <= 200) then
                   setc(Scheme.Color[ord(s[i + 1])]);
                 inc(i);
               end
             else
               outkey('');
         '|':if (colorallowed) and (i + 1 < length(s)) and
                (s[i + 1] in ['0'..'9']) and (s[i + 2] in ['0'..'9']) then
               begin
                 x := value(copy(s,i + 1,2));
                 case x of
                   0..15:setc(curco - (curco mod 16) + x);
                   16..23:setc(((x - 16) * 16) + (curco mod 16));
                 end;
                 inc(i,2);
               end
             else
               outkey('|');
           #9:for x := 1 to 5 do
                outkey(' ');
         '^':if (colorallowed) and (i < length(s)) and (s[i+1] in ['0'..'9']) then
               begin
                 inc(i);
                 UserColor(ord(s[i]) - 48);
               end
             else
               outkey('^');
          else
            outkey(s[i]);
        end;
        inc(i);
        x2:=i;
        while (x2 < length(s)) and
          not (s[x2] in [^S,'^','|','%',^G,^L,^V,^Y,^J,^[]) do
          inc(x2);

        if (x2 > i) then
          begin
            cs[0] := chr(x2 - i);
            move(s[i], cs[1], x2 - i);     { twice as fast as copy(s,i,x2-i); }
            i := x2;

            if (trapping) then
              write(trapfile, cs);

            if wantout then
              if not dosansion then
                write(cs)
              else
                for x2 := 1 to length(cs) do
                  dosansi(cs[x2]);

            SerialOut(cs);
          end;
      end;
	wkey;
end;

procedure printacr(s:string);
var
	okdoit,turnoff:boolean;
begin
	if ((allowAbort) and (Abort)) then exit;

	Abort:=FALSE;

	turnoff:=(s[length(s)]=#29);
	if turnoff then
		dec(s[0]);

	okdoit:=TRUE;

  CheckHangup;

	if (not croff) and not (turnoff) then
		s := s + ^M^J;

	printmain(s);

	if (Abort) then
		begin
			curco:=255-curco;  {***}
			UserColor(1);
		end;

	croff:=FALSE;
end;

procedure pfl(fn:astr);
var fil:text;
		ls:string[255];
		ps:byte;
		c:char;
		OldPause,ToggleBack,oaa:boolean;
begin
	printingfile:=TRUE;
	oaa:=allowAbort;
  allowAbort:=TRUE;
	Abort:=FALSE; Next:=FALSE;
	ToggleBack := FALSE;
	OldPause := TempPause;
	fn := allcaps(fn);
	if General.WindowOn and (pos('.AN',fn) > 0) or (pos('.AV',fn) > 0) then
		begin
			TempPause := FALSE;
			ToggleBack := TRUE;
			ToggleWindow(FALSE);
			if (OkRIP) then
				SerialOut('!|*|');
		end;
	if (pos('.RI',fn) > 0) then
		TempPause := FALSE;
	if (not Hangup) then begin
		assign(fil,sqoutsp(fn));
		reset(fil);
		if (ioresult > 0) then
			nofile:=TRUE
		else begin
			Abort:=FALSE;
			while (not eof(fil)) and (not Abort) and (not Hangup) do begin
				ps:=0;
				repeat
					inc(ps);
					read(fil,ls[ps]);
					if eof(fil) then								{check again incase avatar parameter}
						begin
							inc(ps);
							read(fil,ls[ps]);
							if eof(fil) then dec(ps);
						end;
        until ((ls[ps] = ^J) and (NextState in [Waiting..In_Param]))
							or (ps = 255) or eof(fil);
				ls[0]:=chr(ps);
				croff:=TRUE;
				CtrlJOff := ToggleBack;
				printacr(ls);
			end;
			close(fil);
		end;
		nofile := FALSE;
	end;
	allowAbort:=oaa;
	printingfile:=FALSE; ctrljoff:=FALSE;
	if ToggleBack then
		ToggleWindow(TRUE);
	redrawforansi;
	if not TempPause then
		lil := 0;
	TempPause := OldPause;
end;

function exist(fn:astr):boolean;
var srec:searchrec;
begin
	findfirst(sqoutsp(fn),anyfile,srec);
	exist:=(doserror=0);
end;

procedure printfile(fn:astr);
var s:astr;
		year,month,day,dayofweek:word;
		i,j:integer;
begin
	fn:=allcaps(fn); s:=fn;
	if (copy(fn,length(fn) - 3,4)='.ANS') then
		begin
			if (exist(copy(fn,1,length(fn)-4)+'.AN1')) then
				repeat
					i:=random(10);
					if (i=0) then
						fn:=copy(fn,1,length(fn)-4)+'.ANS'
					else
						fn:=copy(fn,1,length(fn)-4)+'.AN'+cstr(i);
				until (exist(fn));
		end
	else
		if (copy(fn,length(fn) - 3,4)='.AVT') then
			begin
				if (exist(copy(fn,1,length(fn)-4)+'.AV1')) then
					repeat
						i:=random(10);
						if (i=0) then
							fn:=copy(fn,1,length(fn)-4)+'.AVT'
						else
							fn:=copy(fn,1,length(fn)-4)+'.AV'+cstr(i);
					until (exist(fn));
			end
		else
			if (copy(fn,length(fn) - 3,4)='.RIP') then
				begin
					if (exist(copy(fn,1,length(fn)-4)+'.RI1')) then
						repeat
							i:=random(10);
							if (i=0) then
								fn:=copy(fn,1,length(fn)-4)+'.RIP'
							else
								fn:=copy(fn,1,length(fn)-4)+'.RI'+cstr(i);
						until (exist(fn));
				end;

	getdate(year,month,day,dayofweek);
	s:=fn;
	s[length(s) - 1] := chr(dayofweek + 48);
	if (exist(s)) then
		fn := s;
	pfl(fn);
end;

procedure printf(fn:astr);							{ see if an *.ANS file is available }
var ffn,ps,ns,es:astr;									{ if you have ansi graphics invoked }
		i,j:integer;
begin
	nofile:=TRUE;
	fn:=sqoutsp(fn);
	if (fn='') then exit;
  if (pos('\',fn) <> 0) then
    j := 1
  else
    begin
      j:=2;
      fsplit(fexpand(fn),ps,ns,es);
      if (not exist(general.miscpath+ns+'.*')) then exit;
    end;
	ffn:=fn;
	if ((pos('\',fn)=0) and (pos(':',fn)=0)) then
		ffn := general.miscpath + ffn;
	ffn:=fexpand(ffn);
	if (pos('.',fn)<>0) then printfile(ffn)
	else begin
		if (okrip) and exist(ffn+'.rip') then printfile(ffn+'.rip');
		if (nofile) and (okavatar) and exist(ffn+'.avt') then printfile(ffn+'.avt');
		if (nofile) and (okansi) and exist(ffn+'.ans') then printfile(ffn+'.ans');
		if (nofile) and (exist(ffn+'.asc')) then printfile(ffn+'.asc');
	end;
end;

function decode(const x:astr; check:byte):string;
var b:byte;
    s:astr;
    t:byte;
begin
  s := '';
  t := 0;
  for b:=1 to length(x) do
    begin
      s:=s+chr(ord(x[b]) - ord(x[b-1]));
      inc(t, ord(s[b]));
    end;
  if (t XOR check = 0) then
    DIELATER := TRUE;
  decode:=s;
end;

function verline(i:integer):string;
begin
	if (i = 1) then
    verline := decode('∞‡m’:Z÷;çÚ`≈,çÒVv∏-ôjﬁGµ’ÜÁYΩ›0©êıbﬁGgΩ"îpﬂMm', 189) + ver
  else
    verline := decode('µÂa–@π+î˚c◊˜bãÿ%Eß @äÔUª€#à˙l’C™Kk¨Ñ§ˆ_∆.¢5áÏ_ƒ6¨u£', 238);
{
  if i=1 then verline:=#3#4'The '#3#5'Renegade Bulletin Board System'#3#4', Version '+ver
    else verline:=#3#4'Copyright (C) 1991-1996 by '#3#9'Cott Lang'#3#4'. All Rights Reserved.'

						 if FALSE then verline:=#3#8'Please ask your sysop to register this copy of Renegade!'
								else verline:=#3#4'Registered to: '#3#9+general.sysopname;
}
end;

function aacs1(u:userrec; un:integer; s:acstring):boolean;
var s1,s2:astr;
		i,p1,p2,j:integer;
    c,c1,c2:char;
		b:boolean;

	procedure getrest;
  var incre:byte;
	begin
    s1 := c;
    p1 := i;
    incre := 0;
    if ((i <> 1) and (s[i - 1] = '!')) then
      begin
        s1 := '!' + s1;
        dec(p1);
      end;
    if (c in ['N','C','E','F','G','I','J','M','O','R','V','Z']) then
      begin
        s1 := s1 + s[i + 1];
        inc(i);
        if c in ['N'] then
          while s[i+1+incre] in ['0'..'9'] do
          begin
            inc (incre);
            s1 := s1 + s[i+1+incre];
          end;
      end
    else
      begin
        j := i + 1;
        while (j <= length(s)) and (s[j] in ['0'..'9']) do
          begin
            s1 := s1 + s[j];
            inc(j);
          end;
        i := j - 1;
      end;
    p2 := i;
	end;

	function argstat(s:astr):boolean;
	var vs:astr;
			year,month,day,dayofweek,hour,minute,second,sec100:word;
			vsi:integer;
			boolstate,res:boolean;
			c:char;
	begin
		boolstate:=(s[1]<>'!');
		if (not boolstate) then s:=copy(s,2,length(s)-1);
		vs:=copy(s,2,length(s)-1); vsi:=value(vs);
		case s[1] of
      'A':res:=(ageuser(u.birthdate)>=vsi);
			'B':res:=((ActualSpeed >= (vsi * 100)) and (vsi > 0)) or (Speed = 0);
			'C':begin
						 res:=(currentconf=vs);
						 c:=vs[1];
             if (not confsystem) and (c >= '@') and (c <='Z') then
							 res:=aacs1(thisuser,usernum,confr.conference[vs[1]].acs);
					end;
			'D':res:=(u.dsl>=vsi) or TempSysOp;
			'E':case upcase(vs[1]) of
						'A':res := okansi;
						'N':res := not (okansi or okavatar or okvt100);
						'V':res := okavatar;
						'R':res := okrip;
						'1':res := okvt100;
					end;
			'F':res:=(upcase(vs[1]) in u.ar);
			'G':res:=(u.sex=upcase(vs[1]));
			'H':begin
						gettime(hour,minute,second,sec100);
						res:=(hour=vsi);
					end;
			'I':res:=Invisible;
			'J':res:=(novice in u.flags);
			'K':res:=(readboard = vsi);
			'L':res:=(readuboard = vsi);
			'M':res:=(unvotedtopics = 0);
			'N':res:=(node=vsi);
			'O':res := sysopavailable;
			'P':res := (u.credit - u.debit >= vsi);
			'R':res:=(tacch(upcase(vs[1])) in u.flags);
			'S':res:=(u.sl>=vsi) or TempSysOp;
      'T':res:=(nsl div 60>=vsi);
			'U':res:=(un=vsi);
			'V':res:=(u.sl > general.validation['A'].newsl);
			'W':begin
						getdate(year,month,day,dayofweek);
            res := (dayofweek = ord(s[2]) - 48);
					end;
			'X':res:=(((u.expiration div 86400) - (getpackdatetime div 86400)) <= vsi) and
							 (u.expiration > 0);
			'Y':res:=(timer div 60 >= vsi);
			'Z':if (fnopostratio in u.flags) then
						res:=TRUE
					else
						if (general.postratio[u.sl] > 0) and
               (u.loggedon > 100 / general.postratio[u.sl]) then
              res:=((u.msgpost / u.loggedon * 100) >= general.postratio[u.sl])
						else
							res:=TRUE;
		end;
		if (not boolstate) then res:=not res;
		argstat:=res;
	end;

begin
	i:=0;
	s:=allcaps(s);
  while (i < length(s)) do
    begin
      inc(i);
      c := s[i];
      if (c in ['A'..'Z']) and (i <> length(s)) then
        begin
          getrest;
          b := argstat(s1);
          delete(s, p1, length(s1));
          if (b) then
            s2 := '^'
          else
            s2 := '%';
          insert(s2, s, p1);
          dec(i, length(s1) - 1);
        end;
    end;
  s := '(' + s + ')';

  while (pos('&', s) <> 0) do delete(s,pos('&',s),1);
  while (pos('^^', s) <> 0) do delete(s,pos('^^',s),1);

  while (pos('(', s) <> 0) do begin
    i := 1;
    while ((s[i] <> ')') and (i <= length(s))) do
      begin
        if (s[i] = '(') then
          p1 := i;
        inc(i);
      end;
    p2 := i;
    s1 := copy(s, p1 + 1, (p2 - p1) - 1);
    while (pos('|', s1) <> 0) do
      begin
        i := pos('|', s1);
        c1 := s1[i - 1];
        c2 := s1[i + 1];
        s2 := '%';
        if ((c1 in ['%','^']) and (c2 in ['%','^'])) then
          begin
            if ((c1 = '^') or (c2 = '^')) then
              s2 := '^';
            delete(s1, i - 1, 3);
            insert(s2, s1, i - 1);
          end
        else
          delete(s1, i, 1);
      end;
    while(pos('%%', s1) <> 0) do delete(s1,pos('%%',s1),1);   {leave only "%"}
    while(pos('^^', s1) <> 0) do delete(s1,pos('^^',s1),1);   {leave only "^"}
    while(pos('%^', s1) <> 0) do delete(s1,pos('%^',s1)+1,1); {leave only "%"}
    while(pos('^%', s1) <> 0) do delete(s1,pos('^%',s1),1);   {leave only "%"}
    delete(s, p1, (p2 - p1) + 1);
    insert(s1, s, p1);
	end;
	aacs1:=(pos('%',s) = 0);
end;

function aacs(s:acstring):boolean;
begin
	aacs:=aacs1(thisuser,usernum,s);
end;

procedure loadnode(i:integer);
begin
	if not general.multinode then exit;
	reset(nodef);
	if (i > 0) and (i <= filesize(nodef)) and (IOResult = 0) then
		begin
			seek(nodef,i - 1);
			read(nodef,noder);
		end;
	close(nodef);
	Lasterror := IOResult;
end;

function update_node(x:byte):byte;
begin
	if general.multinode then
		begin
			loadnode(node);
			update_node := noder.activity;
			if (x > 0) then
				noder.activity:=x;
			if (useron) then
				begin
					noder.user := usernum;
					noder.username := thisuser.name;
					noder.sex := thisuser.sex;
          noder.age := ageuser(thisuser.birthdate);
					noder.citystate := thisuser.citystate;
					noder.logontime := timeon;
          noder.channel := chatchannel;
				end;
			{else
				noder.user := 0;}
			if (x = node) and Invisible then
				noder.status := noder.status + [NInvisible];
			savenode(node);
		end;
end;

function maxchatrec:longint;
begin
	findfirst(general.multpath + 'message.'+cstr(node),0,junkinfo);
	if (doserror = 0) then
		maxchatrec := junkinfo.size
	else
		maxchatrec := 0;
end;

function maxnodes:integer;
begin
	findfirst(general.multpath+'multnode.dat',0,junkinfo);
	if doserror=0 then
		maxnodes:=junkinfo.size div sizeof(noderec)
	else
		maxnodes:=0;
end;

procedure savenode(i:integer);
begin
	if not general.multinode then exit;
	reset(nodef);
	if (i > 0) and (i <= filesize(nodef)) and (IOResult = 0) then
		begin
			seek(nodef,i - 1);
			write(nodef,noder);
		end;
	close(nodef);
	Lasterror := IOResult;
end;

procedure loadurec(var u:userrec; i:integer);
var
	fo:boolean;
begin
	fo := filerec(uf).mode<>fmclosed;
	if not fo then
		begin
			reset(uf);
			if (IOResult > 0) then
				begin
					sysoplog('error opening user file.');
					runerror(5);
				end;
		end;

	if (i <> usernum) or (not useron) then begin
		seek(uf,i);
		read(uf,u);
	end else
		u:=thisuser;

	if not fo then
		close(uf);

	Lasterror := IOResult;
end;

procedure saveurec(u:userrec; i:integer);
var
	fo:boolean;
begin
	fo := filerec(uf).mode<>fmclosed;
	if not fo then
		begin
			reset(uf);
			if (IOResult > 0) then
				begin
					sysoplog('error opening user file.');
					runerror(5);
				end;
		end;

	seek(uf,i);
	write(uf,u);

	if not fo then
		close(uf);

	if (i = usernum) then
		thisuser := u
	else
	 if general.multinode then
		 begin
			 i := onnode(i);
			 if (i > 0) then
				 begin
					 loadnode(i);
					 noder.status := noder.status + [NUpdate];
					 savenode(i);
				 end;
		 end;

	Lasterror := IOResult;
end;

function maxusers:integer;
begin
	findfirst(general.datapath+'users.dat',0,junkinfo);
	if (doserror = 0) then
		maxusers := junkinfo.size div sizeof(userrec)
	else
		maxusers := 0;
end;

procedure loadsfrec(i:integer; var sr:useridxrec);
var
	fo:boolean;
begin
	fo := filerec(sf).mode<>fmclosed;
	if not fo then
		reset(sf);
	seek(sf,i);
	read(sf,sr);
	if not fo then
		close(sf);
	Lasterror := IOResult;
end;

procedure savesfrec(i:integer; sr:useridxrec);
var
	fo:boolean;
begin
	fo := filerec(sf).mode<>fmclosed;
	if not fo then
		reset(sf);
	seek(sf,i);
	write(sf,sr);
	if not fo then
		close(sf);
	Lasterror := IOResult;
end;

function maxsf:integer;
begin
	findfirst(general.datapath+'users.idx',0,junkinfo);
	if (doserror = 0) then
		maxsf := junkinfo.size div sizeof(useridxrec)
	else
		maxsf := 0;
	if (not useron) and (junkinfo.size mod sizeof(useridxrec) <> 0) then
		maxsf := -1;		{ useron is so it'll only slow during boot up }
end;

function himsg:integer;
begin
	findfirst(general.msgpath+memboard.filename+'.HDR',0,junkinfo);
	if (doserror = 0) then
		himsg := junkinfo.size div sizeof(mheaderrec)
	else
		himsg := 0;
end;

function Usename(b:byte; s:string):string;
begin
	case b of
		1,
		2:s:=fstring.anonymous;
		3:s:='Abby';
		4:s:='Problemed Person';
	else
		s:=caps(s);
	end;
	Usename:=s;
end;

procedure com_flush_rx;
begin
	if not LocalIOOnly then
		if not InWfcMenu then
			begin
				regs.dx := FossilPort;
				if (DigiBoard in liner.mflags) then
					regs.ah := $9
				else
					regs.ah := $A;
				intr($14, regs);
			end
		else
			begin
				while not (Com_RX_Empty) do
					WriteWFC(cinkey);
			end;
end;

function com_tx_empty:boolean;
begin
	Com_TX_Empty := TRUE;
	if not LocalIOOnly then
		begin
			regs.dx := FossilPort;
			regs.ah := $3;
			intr($14, regs);
			Com_TX_Empty := (regs.ah and 64 = 64);
		end;
end;

procedure com_flush_tx;
var
	r:longint;
begin
	r := timer + 5;
	while (r > timer) and (outcom and com_carrier) and (not com_tx_empty) do;
end;

procedure com_purge_tx;
begin
	if not LocalIOOnly then
		begin
			regs.dx := FossilPort;
			regs.ah := $9;
			intr($14, regs);
		end;
end;

function com_carrier:boolean; assembler;
asm
	mov al, 1
	cmp localioonly, 1
	je @getout
	mov dx, Fossilport
	mov ah, 3
	pushf
	call interrupt14
	and al, 10000000b
	jnz @getout
	xor al, al
	@getout:
end;

function com_rx:char;
begin
	Com_RX := #0;
	if not LocalIOOnly then
		begin
			regs.dx := FossilPort;
			if (DigiBoard in liner.mflags) then
				regs.ah := $8
			else
				regs.ah := $C;
			intr($14, regs);
			if (regs.ah <> $FF) then
				begin
					regs.ah := $2;
					intr($14, regs);
					Com_RX := chr(regs.al);
				end;
		end;
end;

function com_rx_empty:boolean;
begin
	Com_RX_Empty := TRUE;

	if not LocalIOOnly then
		begin
			regs.dx := FossilPort;
			regs.ah := $3;
			intr($14, regs);
			Com_RX_Empty := not (regs.ah and 1 = 1);
		end;
end;

procedure com_tx(c:char);
begin
	if not LocalIOOnly then
		with regs do
			if (DigiBoard in liner.mflags) then
				begin
					repeat
						ah := $1;
						al := ord(c);
						dx := FossilPort;
						intr($14, regs);
					until not (regs.ah and 128 = 128);
				end
			else
				begin
					ah := $1;
					al := ord(c);
					dx := FossilPort;
					intr($14, regs);
				end;
end;

procedure com_set_speed(speed:longint);
begin
	if not LocalIOOnly then
		begin
			if (DigiBoard in liner.mflags) then
				begin
					regs.ah := $04;
					regs.bh := 0;
					regs.bl := 1;
					regs.ch := 3;
					case Speed of
						 300:regs.cl := $2;
						 600:regs.cl := $3;
						1200:regs.cl := $4;
						2400:regs.cl := $5;
						4800:regs.cl := $6;
						9600:regs.cl := $7;
					 19200:regs.cl := $8;
					end;
					if (Speed = 38400) then regs.cl := $9
						else if (Speed = 57600) then regs.cl := $A;
				end
			else
				begin
					regs.ah := $00;
					case Speed of
						 300:regs.al :=  64;
						 600:regs.al :=  96;
						1200:regs.al := 128;
						2400:regs.al := 160;
						4800:regs.al := 192;
						9600:regs.al := 224;
					 19200:regs.al := 	0;
					 else
						 regs.al := 32;
					end;
					inc(regs.al, 3);
				end;
			regs.dx := FossilPort;
			intr($14, regs);
		end;
end;

procedure com_deinstall;
begin
	if not LocalIOOnly and not (DigiBoard in liner.mflags) then
		begin
			regs.dx := FossilPort;
			regs.ah := $5;
			intr($14, regs);
		end;
end;

procedure dtr(status:boolean);
begin
	if not LocalIOOnly then
		begin
			if (DigiBoard in liner.mflags) then
				if status then
					regs.ah := $13
				else
					regs.ah := $B
			else
				regs.ah := $6;

			regs.al := byte(Status);
			intr($14, regs);
		end;
end;

procedure scaninput(var s:astr; const allowed:astr);
var os:astr;
		i:integer;
		c:char;
		gotcmd:boolean;
begin
	gotcmd:=FALSE;
	s:='';
	repeat
    c:=upcase(char(getkey));
		os:=s;
		if ((pos(c,allowed)<>0) and (s='')) then
			begin
				gotcmd:=TRUE;
				s:=c;
			end
		else
			if (pos(c,'0123456789') > 0) or (c = '-') then
				begin
					if ((length(s) < 5) or
							((pos('-', s) > 0) and (length(s) < 9))) then s := s + c;
				end
			else
				if ((s<>'') and (c=^H)) then
					dec(s[0])
				else
					if (c=^X) then
						begin
							for i:=1 to length(s) do backspace;
							s:=''; os:='';
						end
					else
						if (c = #13) then gotcmd:=TRUE;
		if (length(s)<length(os)) then backspace;
		if (length(s)>length(os)) then prompt(s[length(s)]);
	until ((gotcmd) or (Hangup));
	nl;
end;

procedure screendump(const f:astr);
var t:text;
		x,y:byte;
		vidseg:word;
		s:astr;
		c:char;
begin
	assign(t,f);
	append(t);
  if (ioresult = 2) then
		rewrite(t);
	if (MonitorType = 7) then
		vidseg:=$B000
	else
		vidseg:=$B800;
	for y:=1 to MaxDisplayRows do begin
		s:='';
		for x:=1 to MaxDisplayCols do begin
			 c:=chr(mem[vidseg:(160*(y-1)+2*(x-1))]);
			 if (c=#0) then c:=#32;
			 if ((x=wherex) and (y=wherey)) then c:=#178;
			 s:=s+c;
		end;
		while s[length(s)] = ' ' do
			dec(s[0]);
    writeln(t,s);
	end;
	close(t);
	Lasterror := IOResult;
end;

procedure inputpath(const s:astr; var v:astr);
var
	changed:boolean;
begin
	print('^1'+s);
  prt(':'); mpl(39);
  inputwn1(v, 39, 'ui', changed);
  if (v[length(v)] <> '\') and (length(v) > 0) then
		v := v + '\';
end;

function onnode(x:word) : byte;
var i:byte;
begin
	onnode := 0;
	if general.multinode and (x > 0) then
		for i := 1 to maxnodes do
			begin
				loadnode(i);
				if (noder.user = x) then
					begin
						onnode := i;
						exit;
					end;
			end;
end;

procedure purgedir(s:astr; SubDirs:boolean);
{
 Deletes everything in given directory, including recursive
 directories. Deletes directory if SubDirs is TRUE, thus deletes
 any directories under s, no matter what.
}
var
	odir:string[80];
	dirinfo:searchrec;
	f:file;
begin
	s:=fexpand(s);
	while s[length(s)] = '\' do
		dec(s[0]);
	getdir(ExtractDriveNumber(s),odir);
	chdir(s);
	if (IOResult <> 0) then
		begin
			chdir(odir);
			exit;
		end;
	findfirst('*.*',AnyFile,dirinfo);
	while (doserror = 0) do
		begin
			if (dirinfo.attr = Directory) and
				 (dirinfo.name <> '.') and
				 (dirinfo.name <> '..') then
				purgedir(s + '\' + dirinfo.name, TRUE)
			else
				begin
          assign(f,fexpand(dirinfo.name));
					setfattr(f,0);
					erase(f);
					Lasterror := IOResult;
				end;
			findNext(dirinfo);
		end;
	chdir(odir);
	if SubDirs then
		rmdir(s);
	Lasterror := IOResult;
	chdir(start_dir);
end;

function stripname(s:astr):string;
var
	n:integer;
begin
	n := length(s);
	while (n > 0) and (pos(s[n],':\/') = 0) do
		dec(n);
	delete(s,1,n);
	stripname := s;
end;

procedure star(s:astr);
begin
	if (okansi or okavatar) then prompt('^4˛ ') else prompt('* ');
	if (s[length(s)] = #29) then
    dec(s[0])
  else
    s := s + ^M^J;
  prompt('^3'+s);
end;

function ctp(t,b:longint):string;
var s,s1:astr;
		n:longint;
begin
	if ((t=0) or (b=0)) then
		n := 0
	else
		n := (t * 100) div b;
	str(n:6,s);
	ctp:=s;
end;

function cinkey:char;
begin
	if not (localioonly) and (not com_rx_empty) then
    cinkey := com_rx
  else
    cinkey := #0;
end;

function CRC16(const s:astr):word;
var
	crc:word;
	t,r:byte;
begin
	crc := $FFFF;
	for t:=1 to length(s) do
		begin
			crc:=(crc xor (ord(s[t]) shl 8));
			for r:=1 to 8 do
				if (crc and $8000) > 0 then
					crc := ((crc shl 1) xor $1021)
				else
					crc := (crc shl 1);
		end;
	CRC16 := (crc and $FFFF);
end;

procedure outmodemstring(const s:astr);
var i:integer;
begin
	for i:=1 to length(s) do
		case s[i] of
      '~':delay(250);
			'|':begin
						com_tx(^M);
						if InWFCMenu then
							WriteWFC(^M);
					end;
			'^':begin
						dtr(FALSE);
            delay(250);
						dtr(TRUE);
					end;
		else
			begin
				com_tx(s[i]);
				delay(2);
				if InWFCMenu then
					WriteWFC(s[i]);
			end;
		end;
end;

procedure dophoneHangup(showit:boolean);
var rl:longint;
		try:integer;
		c:char;
begin
	if (not localioonly) then
		begin
      if (showit) and not blankmenunow then
				begin
					textcolor(15);
					textbackground(1);
					gotoxy(32,17);
					write('Hanging up phone...');
				end;
			try:=0;
      while (try < 6) and (not keypressed) do
				begin
					com_flush_rx;
					outmodemstring(Liner.Hangup);
					rl := timer;
					while (abs(timer - rl) <= 2) and (com_carrier) do
						begin
							c := cinkey;
							if (c > #0) and inwfcmenu then
								WriteWFC(c);
						end;
					inc(try);
				end;
		end;
	if showit and sysopon and not blankmenunow then
		begin
			textcolor(15);
			textbackground(1);
			gotoxy(1,17); clreol;
		end;
end;

procedure dophoneoffhook(showit:boolean);
var rl1:longint;
		c:char;
		s:astr;
		Done:boolean;
begin
	if showit and not blankmenunow and sysopon then
		begin
			textcolor(15);
			textbackground(1);
			gotoxy(33,17);
			write('Phone off hook');
		end;
	com_flush_rx;
	outmodemstring(liner.offhook);
	rl1 := timer;
	repeat
		c := cinkey;
		if (c > #0) then
			begin
				if InWFCMenu then
					WriteWFC(c);
				if (length(s) >= 160) then
					delete(s, 1, 120);
				s := s + c;
				if (pos(Liner.OK, s) > 0) then
					Done := TRUE;
			end;
	until (abs(timer - rl1) > 2) or (Done) or (keypressed);
	com_flush_rx;
end;

procedure pausescr(IsCont:boolean);
var
	i:integer;
	c:char;
	bb:byte;
	b:boolean;
begin
	b := mciallowed;
	mciallowed := TRUE;
	nosound;
	bb := curco;
  if (not AllowContinue) and not (printingfile and allowabort) then
		IsCont := FALSE;

	if IsCont then
		prompt(fstring.continue)
	else
		prompt(fstring.pause);

	lil := 1;
	if IsCont then
		begin
			onekcr := FALSE;
			onekda := FALSE;
			onek(c,'YNQC '^M);
			case c of
        'C':if IsCont then
							TempPause := FALSE;
				'N':Abort := TRUE;
			end;
		end
	else
    c := char(getkey);

	if IsCont then
    for i := 1 to lennmci(fstring.continue) do
			backspace
	else
    for i := 1 to lennmci(fstring.pause) do
			backspace;
	if Abort then
		nl;
	if (not Hangup) then
		setc(bb);
	mciallowed:=b;
end;

function ambase(x:integer):integer;
var
	y,z:integer;
begin
  if (not general.compressbases) then
    ambase := x
  else
    begin
      z := 0;
      y := 0;
      while (y < x) and (z < MAXBASES) do
        begin
          if (z mod 8) in ccboards[z div 8] then
            inc(y);
          inc(z);
        end;
      ambase := z;
    end;
end;

function cmbase(x:integer):integer;
var
	z,y:integer;
begin
  if (not general.compressbases) then
    cmbase := x
  else
    begin
      z:=1;
      dec(x);
      if (x mod 8) in ccboards[x div 8] then
        for y := 0 to (x - 1) do
          if ((y mod 8) in ccboards[y div 8]) then
            inc(z)
      else
      else
        z := 0;
      cmbase := z;
    end;
end;

function afbase(x:integer):integer;
var
	y,z:integer;
begin
  if (not general.compressbases) then
    afbase := x
  else
    begin
      z := 0;
      y := 0;
      while (y < x) and (z < MAXBASES) do
        begin
          if (z mod 8) in ccuboards[z div 8] then
            inc(y);
          inc(z);
        end;
      afbase := z;
    end;
end;

function cfbase(x:integer):integer;
var
	z,y:integer;
begin
  if (not general.compressbases) then
    cfbase := x
  else
    begin
      z:=1;
      dec(x);
      if (x mod 8) in ccuboards[x div 8] then
        for y := 0 to (x - 1) do
          if ((y mod 8) in ccuboards[y div 8]) then
            inc(z)
      else
      else
        z := 0;
      cfbase := z;
    end;
end;

function searchuser(Uname:astr; RealNameOK:boolean): word;
var
	Current:integer;
	Done:boolean;
	IndexR:useridxrec;
begin

	SearchUser := 0;

	reset(sf);
	if (IOResult > 0) then
		begin
			sysoplog('error opening user file.');
			runerror(5);
		end;

	while (Uname[length(Uname)] = ' ') do
		dec(Uname[0]);

	Uname := Allcaps(Uname);

	Current := 0;
	Done := FALSE;

	if (filesize(sf) > 0) then
		repeat
			seek(sf, Current);
			read(sf, IndexR);
			if (Uname < IndexR.Name) then
				Current := IndexR.Left
			else
				if (Uname > IndexR.Name) then
					Current := IndexR.Right
				else
					Done := TRUE;
		until (Current = -1) or (Done);
	close(sf);

	if (Done) and (RealNameOK or not IndexR.RealName) and (not IndexR.Deleted) then
		SearchUser := IndexR.Number;

	Lasterror := IOResult;
end;

function Plural(Number:longint): string;
begin
	if (Number <> 1) then
		 Plural := 's'
	else
		 Plural := '';
end;

function FormattedTime(TimeUsed:longint) : string;
var
	s:astr;
begin
	s := '';
	if (TimeUsed > 3600) then
		begin
			s := cstr(TimeUsed div 3600) + ' hour' + Plural(TimeUsed div 3600) + ' ';
			TimeUsed := TimeUsed mod 3600;
		end;
	if (TimeUsed > 60) then
		begin
			s := s + cstr(TimeUsed div 60) + ' minute' + Plural(TimeUsed div 60) + ' ';
			TimeUsed := TimeUsed mod 60;
		end;
	if (TimeUsed > 0) then
		s := s + cstr(TimeUsed) + ' second' + Plural(TimeUsed);
	if (s = '') then
		s := 'no time';

	while (s[length(s)] = ' ') do
		dec(s[0]);
	FormattedTime := s + '.';
end;

function FunctionalMCI(const s:astr; FileName, InternalFileName:astr): string;
var
	Index:byte;
	Temp:String;
	Add:astr;
begin
	Temp := '';
	for Index := 1 to length(s) do
		if (s[Index] = '%') then
			begin
				case upcase(s[Index + 1]) of
				 'A':if localioonly then
							 Add := '0'
						 else
							 Add := cstr(ActualSpeed);
				 'B':Add := cstr(Speed);
				 'C':Add := liner.Address;
				 'D':Add := FunctionalMCI(Protocol.DLFList,'','');
				 'E':Add := liner.IRQ;
				 'F':Add := SqOutSp(FileName);
				 'G':if (OKAvatar or OKAnsi) then
							 Add := '1'
						 else
							 Add := '0';
				 'I':Add := InternalFileName;
         'K':begin
               loadfileboard(fileboard);
               if (fbdirdlpath in memuboard.fbstat) then
                 Add := memuboard.dlpath+memuboard.filename+'.DIR'
               else
                 Add := general.datapath+memuboard.filename+'.DIR';
             end;
				 'L':Add := FunctionalMCI(Protocol.TempLog,'','');
				 'M':Add := Start_Dir;
				 'N':Add := Cstr(Node);
				 'O':Add := liner.doorpath;
				 'P':Add := Cstr(Liner.ComPort);
				 'R':Add := Thisuser.RealName;
				 'T':Add := Cstr(nsl div 60);
				 'U':Add := Thisuser.Name;
				 '#':Add := cstr(usernum);
				 '1':Add := Copy(Caps(Thisuser.RealName),1,pos(' ',Thisuser.RealName) - 1);
				 '2':if (pos(' ', Thisuser.RealName) = 0) then
							 Add := Caps(Thisuser.RealName)
						 else
							 Add := Copy(Caps(Thisuser.RealName),pos(' ',ThisUser.RealName) + 1,255);
					else
						Add := '%' + s[Index + 1];
				end;
				Temp := Temp + Add;
				inc(Index);
			end
		else
			Temp := Temp + s[Index];
	FunctionalMCI := Temp;
end;

function MCI(const s:string): string;
var
	Index,I:integer;
	Temp:String;
	Add:astr;
begin
	Temp := '';
	for Index := 1 to length(s) do
		if (s[Index] = '%') and (Index + 1 < Length(s)) then
			begin
				Add := '%' + s[Index + 1] + s[Index + 2];
				with thisuser do
				case upcase(s[Index + 1]) of
					'A':case upcase(s[Index + 2]) of
                'B':Add := FormatNumber(Credit - Debit);
								'D':Add := Street;
								'O':begin
											if (printingfile) or (reading_a_msg) then
												AllowAbort := FALSE;
											Add := '';
										end;
							end;
					'B':case upcase(s[Index + 2]) of
                'D':Add := cstr(ActualSpeed);
								'N':Add := General.BBSName;
								'P':Add := General.BBSPhone;
							end;
          'C':case upcase(s[Index + 2]) of
                'L':Add := ^L;
                'M':Add := cstr(Msg_On);
								'N':Add := Confr.Conference[CurrentConf].Name;
                'R':Add := FormatNumber(Credit);
								'T':Add := CurrentConf;
							end;
					'D':case upcase(s[Index + 2]) of
								'1'..'3':Add := UsrDefStr[ord(s[Index + 2]) - 48];
								'A':Add := Date;
                'B':Add := FormatNumber(Debit);
                'D':Add := FormatNumber(General.DlOneDay[sl]);
                'K':Add := FormatNumber(DK);
                'L':Add := FormatNumber(Downloads);
                'S':Add := cstr(DSL);
                'T':begin
                      if (Timer > 64800) then
                        Add := 'evening'
                      else if (Timer > 43200) then
                        Add := 'afternoon'
                      else Add := 'morning'
                    end;
							end;
					'E':case upcase(s[Index + 2]) of
								'D':if (Expiration = 0) then
                      Add := 'Never'
										else
											Add := todate8(pd2date(Expiration));
                'S':Add := FormatNumber(emailsent);
                'W':Add := FormatNumber(waiting);
								'X':if (Expiration > 0) then
											Add := cstr((Expiration div 86400) - (GetPackDateTime div 86400))
										else
											Add:='Never';
							end;
					'F':case upcase(s[Index + 2]) of
								'#':Add := cstr(CFBase(FileBoard));
								'B':begin
											loadfileboard(fileboard);
											Add := memuboard.name;
										end;
                'D':Add := todate8(pd2date(firston));
                'K':Add := FormatNumber(diskfree(ExtractDriveNumber(memuboard.ulpath)) div 1024);
								'N':Add := copy(RealName, 1, pos(' ', RealName) - 1);
							end;
					'G':case upcase(s[Index + 2]) of
								'N':if (Sex = 'M') then
											Add := 'Mr.'
										else
											Add:='Ms.';
							end;
					'H':case upcase(s[Index + 2]) of
								'M':Add := cstr(HiMsg);
							end;
          'I':case upcase(s[Index + 2]) of
                'L':Add := cstr(illegal);
							end;
					'K':case upcase(s[Index + 2]) of
                'D':Add := FormatNumber(General.DLKOneday[SL]);
								'R':if (DK > 0) then
                      str((UK / DK):3:3, Add)
										else
											Add := '0';
							end;
					'L':case upcase(s[Index + 2]) of
                'C':Add := todate8(pd2date(LastOn));
								'F':Add := ^M^J;
								'N':begin
											I := length(Realname);
											while ((Realname[i] <> ' ') and (i > 1)) do
												dec(i);
                      Add := copy(Caps(Realname), i + 1, 255);
										end;
								'O':Add := CityState;
							end;
					'M':case upcase(s[Index + 2]) of
								'#':Add := cstr(CMBase(board));
								'B':begin
											i := readboard;
											if (i <> board) then
												loadboard(board);
											Add := memboard.name;
											if (i <> board) then
												loadboard(i);
										end;
								'L':Add := cstr(nsl div 60);
								'O':Add := cstr((GetPackDateTime - TimeOn) div 60);
								'R':Add := cstr(HiMsg - Msg_On);
							end;
					'N':case upcase(s[Index + 2]) of
								'D':Add := cstr(Node);
								'R':if (Downloads > 0) then
                      str((Uploads / Downloads):3:3, Add)
										else
											Add := '0';
							end;
					'O':case upcase(s[Index + 2]) of
								'1':if (RIP in sflags) then
											Add := 'RIP'
										else
											if (Avatar in flags) then
												Add := 'Avatar'
											else
												if (Ansi in flags) then
													Add := 'Ansi'
												else
													if (vt100 in flags) then
														Add := 'VT-100'
													else
														Add := 'None';
								'2':Add := cstr(LineLen) + 'x' + cstr(PageLen);
								'3':Add := OnOff(ClsMsg in Sflags);
								'4':Add := OnOff(FSEditor in Sflags);
								'5':Add := OnOff(Pause in Flags);
								'6':Add := OnOff(HotKey in Flags);
                '7':Add := OnOff(not (Novice in Flags));
                '8':if (Forusr > 0) then
                      Add := 'Forwarded - ' + cstr(Forusr)
                    else
                      if (Nomail in Flags) then
                        Add := 'Closed'
                      else
                        Add := 'Open';
                '9':Add := OnOff(Color in Flags);
							end;
					'P':case upcase(s[Index + 2]) of
								'C':if (LoggedOn > 0) then
											str((msgpost / loggedon) * 100:3:2, Add)
										else
											Add := '0';
								'N':Add := Ph;
								'O':begin
											if (printingfile) or (reading_a_msg) then
												TempPause := FALSE;
											Add := '';
										end;
                'S':Add := FormatNumber(MsgPost);
							end;
					'Q':case upcase(s[Index + 2]) of
								'D': Add := cstr(numbatchfiles);
								'U': Add := cstr(numubatchfiles);
							end;
					'R':case upcase(s[Index + 2]) of
								'N':Add := Caps(RealName);
							end;
					'S':case upcase(s[Index + 2]) of
								'1'..'3':Add := fString.UserDefEd[ord(s[Index + 2]) - 48];
                'C':Add := FormatNumber(General.CallerNum);
								'L':Add := cstr(SL);
								'N':Add := General.SysopName;
								'X':if (Sex = 'M') then
											Add := 'Male'
										else
											Add := 'Female';
							end;
					'T':case upcase(s[Index + 2]) of
                'A':Add := FormatNumber(timebankadd);
                'B':Add := FormatNumber(timebank);
                'C':Add := FormatNumber(LoggedOn);
                'D':Add := FormatNumber(DLToday);
								'I':Add := Time;
                'K':Add := FormatNumber(DLKToday);
								'L':Add := ctim(NSL);
                'O':Add := cstr(general.timeallow[sl] - tltoday);
                'T':Add := FormatNumber(ttimeon);
                'U':Add := cstr(General.NumUsers);
							end;
					'U':case upcase(s[Index + 2]) of
                'A':Add := cstr(Ageuser(Birthdate));
                'B':Add := todate8(pd2date(Birthdate));
								'C':Add := cstr(OnToday);
                'F':Add := FormatNumber(Feedback);
                'K':Add := FormatNumber(UK);
                'L':Add := FormatNumber(Uploads);
								'N':Add := Caps(Name);
								'U':Add := cstr(UserNum);
							end;
					'V':case upcase(s[Index + 2]) of
                'R':Add := Ver;
							end;
					'Z':case upcase(s[Index + 2]) of
								'P':Add := ZipCode;
							end;
				end;
				Temp := Temp + Add;
				inc(Index, 2);
			end
		else
      Temp := Temp + s[index];
	MCI := Temp;
end;

procedure BackErase(Len:byte);
var
	b:byte;
begin
	if (okansi) or (okvt100) then
		SerialOut(^[ + '[' + cstr(Len) + 'D' + ^[ + '[K')
	else if (okavatar) then
		begin
			for b := 1 to len do
				com_tx(^H);
			SerialOut(^V^G);
		end
	else
		for b := 1 to len do
			begin
				com_tx(^H); com_tx(' '); com_tx(^H);
			end;
	gotoxy(WhereX - len, WhereY); clreol;
end;

end.
|09Copyright (C)MM by Jeff Herrings. All Rights Reserved.

