home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
World_Of_Computer_Software-02-385-Vol-1of3.iso
/
f
/
faq-s.zip
/
SUBS1.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-05-04
|
28KB
|
1,044 lines
{$R-,S-,I-,D-,F+,V-,B-,N-,L+ }
{$M 65500,0,0 }
unit subs1;
interface
uses crt,dos,execswap,
gensubs,gentypes,statret,configrt,modem;
type cursor_array = array[0..31] of integer;
var firstvariable:byte;
local,chatmode,disconnected:boolean;
unum,ulvl:integer;
baudrate:longint;
nnu:integer;
unam:mstr;
baudstr:sstr;
parity,statusbar:boolean;
conn:byte;
urec:userrec;
logontime,logofftime,logonunum:integer;
laston:longint;
echodot,nochain,break,xpressed,
requestchat1,requestchat2,requestcom,requestbreak,reqspecial,{forcehangup,}
{modeminlock,modemoutlock,}timelock,tempsysop,splitmode,
fromdoor,texttrap,printerecho,uselinefeeds,usecapsonly,
dontstop,nobreak,wordwrap,beginwithspacesok,sysnext,ingetstr:boolean;
regularlevel,numusers,curboardnum,lasty,
linecount,curattrib,
firstfree,lockedtime,iocode,buflen:integer;
screenseg:word;
cursection:configtype;
curboardname:sstr;
input,chainstr:anystr;
chatreason,lastprompt,errorparam,errorproc:lstr;
curboard:boardrec;
mes:message;
syslogdat:array [0..maxsyslogdat] of syslogdatrec;
numsyslogdat:integer;
returnto:char;
lastvariable:byte;
usr,direct,directin:text;
reg:registerrec;
const numsysfiles=20;
var tfile:file of buffer;
mapfile:file of integer;
ufile:file of userrec;
uhfile:file of mstr;
mfile:file of mailrec;
udfile:file of udrec;
batfile:file of udrec;
afile:file of arearec;
bfile:file of bulrec;
bdfile:file of boardrec;
bifile:file of sstr;
ffile:file of filerec;
tofile:file of topicrec;
chfile:file of choicerec;
ddfile:file of baserec;
efile:file of entryrec;
dofile:file of doorrec;
gfile:file of grouprec;
logfile:file of logrec;
abfile:file of abrec;
usfile:file of userspecsrec;
sysfiles:array [1..numsysfiles] of file absolute tfile;
ttfile:text;
blfile:file of bbsrec;
nmfile:file of netmailrec;
nlifile:file of netlistrec;
rfile:file of quoterec;
regsfile:file of registerrec;
sysfi:fib absolute logfile;
function button_pressed(button : integer) : boolean;
procedure show_cursor;
procedure hide_cursor;
function mouse_installed : boolean;
procedure get_cursor_position (var horizontal, vertical : integer);
procedure set_cursor_position (horizontal, vertical : integer);
procedure set_min_max_horiz(minimum, maximum : integer);
procedure set_min_max_vert(minimum, maximum : integer);
procedure set_graphics_cursor (hot_spot_x, hot_spot_y : integer; var cursor : cursor_array);
procedure read_counters(var horizontal, vertical : integer);
procedure user_subroutine(mask,subroutine_segment,subroutine_offset : integer);
procedure light_pen_on;
procedure light_pen_off;
procedure set_pixel_ratio (horizontal_ratio, vertical_ratio : integer);
function number_of_presses (button : integer) : integer;
function number_of_releases (button : integer) : integer;
procedure set_text_cursor (bottom_line, top_line : integer);
function percent (var it,other:integer):integer;
function ratio (var first,sec:longint):integer;
procedure writelog(m,s:integer;prm:lstr);
procedure files30;
function ioerrorstr (num:integer):lstr;
procedure error (errorstr,proc,param:lstr);
procedure fileerror (procname,filename:lstr);
procedure che;
function timeleft:integer;
function timetillevent:integer;
function timenetworkevent:integer;
procedure settimeleft (tl:integer);
procedure tab (n:anystr; np:integer);
function yes:boolean;
function no:boolean;
function yesno (b:boolean):sstr;
function timeontoday:integer;
function isopen (var ff):boolean;
procedure textclose (var f:text);
procedure close (var ff);
function withintime (t1,t2:sstr):boolean;
{}function hungupon:boolean;{}
function sysopisavail:boolean;
function sysopavailstr:sstr;
function singularplural (n:integer; m1,m2:mstr):mstr;
function s (n:integer):sstr;
function numthings (n:integer; m1,m2:mstr):lstr;
procedure thereisare (n:integer);
procedure thereare (n:integer; m1,m2:mstr);
procedure assignbdfile;
procedure openbdfile;
procedure formatbdfile;
procedure closebdfile;
procedure opentempbdfile;
procedure closetempbdfile;
function keyhit:boolean;
function bioskey:char;
procedure readline (var xx);
procedure readline2 (var xx);
procedure writereturnbat;
procedure execcomcom;
procedure soundblaster (fname:lstr);
procedure ensureclosed;
procedure clearbreak;
procedure WVT52(t:anystr);
procedure ansicolor (attrib:integer);
procedure ansireset;
procedure specialmsg (q:anystr);
procedure writedataarea;
procedure readdataarea;
procedure ansimusic (m:lstr);
procedure cursor (b:boolean);
implementation
function button_pressed(button : integer) : boolean;
{ returns true if button is down. Button = 0 for left button and 1
for right button }
Begin
Inline
($B8/$03/$00/ { MOV AX,3 }
$CD/$33/ { INT 33H }
$8B/$4E/$04/ { MOV CX,[BP+4] }
$E3/$02/ { JCXZ B0 }
$D1/$EB/ { SHR BX,1 }
$89/$5E/$06); { B0:MOV [BP+6],BX }
End;
procedure show_cursor;
{ makes the cursor visible }
Begin
Inline
($B8/$01/$00/ { MOV AX,1 }
$CD/$33); { INT 33H }
End;
procedure hide_cursor;
{ makes cursor invisible }
Begin
Inline
($B8/$02/$00/ { MOV AX,2 }
$CD/$33); { INT 33H }
End;
function mouse_installed : boolean;
{ return true if the mouse driver and hardware are installed. Also
resets mouse to default settings. }
Begin
Inline
($B8/$00/$00/ { MOV AX,0 }
$CD/$33/ { INT 33H }
$89/$46/$04); { MOV [BP+4],AX }
End;
procedure get_cursor_position (var horizontal, vertical : integer);
{ get the position of the cursor on the screen }
Begin
Inline
($B8/$03/$00/ { MOV AX,3 }
$CD/$33/ { INT 33H }
$8B/$46/$0A/ { MOV AX,[BP+10] }
$8E/$C0/ { MOV ES,AX }
$8B/$7E/$08/ { MOV DI,[BP+8] }
$26/$89/$0D/ { MOV ES:[DI],CX }
$8B/$46/$06/ { MOV AX,[BP+6] }
$8E/$C0/ { MOV ES,AX }
$8B/$7E/$04/ { MOV DI,[BP+4] }
$26/$89/$15); { MOV ES:[DI],DX }
End;
procedure set_cursor_position (horizontal, vertical : integer);
{ move the cursor to the specified position }
Begin
Inline
($B8/$04/$00/ { MOV AX,4 }
$8B/$4E/$06/ { MOV CX,[BP+6] }
$8B/$56/$04/ { MOV DX,[BP+4] }
$CD/$33); { INT 33H }
End;
procedure set_min_max_horiz(minimum, maximum : integer);
{ set the minimum and maximum horizontal position of the cursor }
Begin
Inline
($B8/$07/$00/ { MOV AX,7 }
$8B/$4E/$06/ { MOV CX,[BP+6] }
$8B/$56/$04/ { MOV DX,[BP+4] }
$CD/$33); { INT 33H }
End;
procedure set_min_max_vert(minimum, maximum : integer);
{ set the minimum and maximum vertical position of the cursor }
Begin
Inline
($B8/$08/$00/ { MOV AX,8 }
$8B/$4E/$06/ { MOV CX,[BP+6] }
$8B/$56/$04/ { MOV DX,[BP+4] }
$CD/$33); { INT 33H }
End;
procedure set_graphics_cursor (hot_spot_x, hot_spot_y : integer;
var cursor : cursor_array);
{ Pass a custom cursor to the mouse hardware. Cursor information contained
in type cursor_array = array[0..31] of integer. See examples in Microsoft
mouse manual. Concatenate the two arrays shown in the manual into one
array. }
Begin
Inline
($8B/$5E/$0A/ { MOV BX,[BP+10] }
$8B/$4E/$08/ { MOV CX,[BP+8] }
$8B/$56/$04/ { MOV DX,[BP+4] }
$8B/$46/$06/ { MOV AX,[BP+6] }
$8E/$C0/ { MOV ES,AX }
$B8/$09/$00/ { MOV AX,9 }
$CD/$33); { INT 33H }
End;
procedure read_counters(var horizontal, vertical : integer);
{ read the the horizontal and vertical mickey count since the last call to
this procedure }
Begin
Inline
($B8/$0B/$00/ { MOV AX,11 }
$CD/$33/ { INT 33H }
$8B/$46/$0A/ { MOV AX,[BP+10] }
$8E/$C0/ { MOV ES,AX }
$8B/$7E/$08/ { MOV DI,[BP+8] }
$26/$89/$0D/ { MOV ES:[DI],CX }
$8B/$46/$06/ { MOV AX,[BP+6] }
$8E/$C0/ { MOV ES,AX }
$8B/$7E/$04/ { MOV DI,[BP+4] }
$26/$89/$15); { MOV ES:[DI],DX }
End;
procedure user_subroutine(mask,subroutine_segment,subroutine_offset : integer);
{ allows a branch to the specified subroutine according to the conditions
specified in the call mask. See the Microsoft mouse manual for details }
Begin
Inline
($8B/$4E/$08/ { MOV CX,[BP+8] }
$8B/$46/$06/ { MOV AX,[BP+6] }
$8E/$C0/ { MOV ES,AX }
$8B/$56/$04/ { MOV DX,[BP+4] }
$B8/$0C/$00/ { MOV AX,12 }
$CD/$33); { INT 33H }
End;
procedure light_pen_on;
{ enables light pen emulation by the mouse. }
Begin
Inline
($B8/$0D/$00/ { MOV AX,13 }
$CD/$33); { INT 33H }
End;
procedure light_pen_off;
{ disables light pen emulation by the mouse. }
Begin
Inline
($B8/$0E/$00/ { MOV AX,14 }
$CD/$33); { INT 33H }
End;
procedure set_pixel_ratio (horizontal_ratio, vertical_ratio : integer);
{ Sets the sensitivity of the mouse. The values entered for the ratios
determine the number of mickeys per eight pixels.
for example: horizontal_ratio = 8, vertical_ratio = 16 -> 8 mickeys for 8
pixels horizontally and 16 mickeys for 8 pixels vertically. }
Begin
Inline
($B8/$0F/$00/ { MOV AX,15 }
$8B/$4E/$06/ { MOV CX,[BP+6] }
$8B/$56/$04/ { MOV DX,[BP+4] }
$CD/$33); { INT 33H }
End;
function number_of_presses (button : integer) : integer;
{ returns number of times the button has been pressed since the last call
to this function. Button = 0 for left button and 1 for right button }
Begin
Inline
($B8/$05/$00/ { MOV AX,5 }
$8B/$5E/$04/ { MOV BX,[BP+4] }
$CD/$33/ { INT 33H }
$89/$5E/$06); { MOV [BP+6],BX }
End;
function number_of_releases (button : integer) : integer;
{ returns number of times the button has been released since the last call
to this function. Button = 0 for left button and 1 for right button }
Begin
Inline
($B8/$06/$00/ { MOV AX,6 }
$8B/$5E/$04/ { MOV BX,[BP+4] }
$CD/$33/ { INT 33H }
$89/$5E/$06); { MOV [BP+6],BX }
End;
procedure set_text_cursor (bottom_line, top_line : integer);
{ select the text cursor and the scan lines used. On the CGA the cursor
can be up to 8 scan lines high, numbered 0-7. On the MDA, 0-11. }
Begin
Inline
($B8/$0A/$00/ { MOV AX,10 }
$BB/$01/$00/ { MOV BX,1 }
$8B/$4E/$06/ { MOV CX,[BP+6] }
$8B/$56/$04/ { MOV DX,[BP+4] }
$CD/$33); { INT 33H }
End;
function percent (var it,other:integer):integer;
var x1,x2,x3:integer;
var y1,y2,y3:real;
begin
x1:=it;
x2:=other;
if x1<1 then x1:=1;
if x2<1 then x2:=1;
y1:=int(x1);
y2:=int(x2);
y3:=y1/y2;
y3:=y3*100;
x3:=trunc(y3);
percent:=x3;
end;
function ratio (var first,sec:longint):integer;
var y1,y2,y3:longint;
x3:integer;
begin
y1:=first;
y2:=sec;
if y1<1 then y1:=1;
if y2<1 then y2:=1;
if (y2>y1) then begin
y3:=y2; { swap the numbers so that y1 <= y2 }
y2:=y1;
y1:=y3;
end;
y3:=y2 DIV y1;
y3:=y3*100;
x3:=trunc(y3);
ratio:=x3;
end;
procedure writelog(m,s:integer;prm:lstr);
Var n:Integer;
l:logrec;
begin
With l Do Begin
menu:=m;
subcommand:=s;
when:=now;
param:=Copy(prm,1,61)
End;
Seek(logfile,FileSize(logfile));
Write(logfile,l);
End;
procedure files30;
begin
writeln (usr,'You MUST put "FILES=30" in your CONFIG.SYS!');
halt(4)
end;
function ioerrorstr (num:integer):lstr;
var tf:text;
tmp1,tmp2:lstr;
n,s:integer;
begin
if num=243 then files30;
assign (tf,'Ioerror.Lst');
reset (tf);
if ioresult<>0 then begin
ioerrorstr:='[Can''t open IOERROR.LST]';
exit
end;
while not eof(tf) do begin
readln (tf,tmp1);
val (tmp1,n,s);
if n=num then begin
readln (tf,tmp2);
ioerrorstr:=tmp2;
close (tf);
exit
end
end;
close (tf);
ioerrorstr:='Unidentified I/O Error '+strr(num)
end;
procedure error (errorstr,proc,param:lstr);
var p,n:integer;
pk:char;
tf:text;
begin
n:=ioresult;
repeat
p:=pos('%',errorstr);
if p<>0 then begin
pk:=errorstr[p+1];
delete (errorstr,p,2);
case upcase(pk) of
'1':insert (param,errorstr,p);
'P':insert (proc,errorstr,p);
'I':insert (ioerrorstr(iocode),errorstr,p)
end
end
until p=0;
assign (tf,bbsdatadir+'ErrLog.dat');
append (tf);
if ioresult<>0
then
begin
close (tf);
rewrite (tf);
writeln (tf,' FAQ '+ver+' Error Log ',datestr(now),' ',timestr(now));
writeln (tf,'──────────────────────────────────────────────────────────────────────────────');
writeln (tf);
end;
if unam='' then
writeln (tf,'Someone was logging in on ',datestr(now), ' at ',timestr(now),' when:')
else
writeln (tf,unam,' was On-Line on ',datestr(now),' at ',timestr(now),' when:');
writeln (tf,errorstr);
writeln (tf);
textclose (tf);
n:=ioresult;
writelog (0,4,errorstr);
writeln (errorstr)
end;
procedure fileerror (procname,filename:lstr);
begin
error ('%I accessing %1 in %P',procname,filename)
end;
procedure che;
var i:integer;
begin
i:=ioresult;
case i of
0:;
4:files30;
else
begin
iocode:=i;
error ('Unexpected I/O Error %I','','')
end
end
end;
function timeleft:integer;
var timeon:integer;
begin
timeon:=timer-logontime;
if timeon<0 then timeon:=timeon+1440;
timeleft:=urec.timetoday-timeon
end;
function timetillevent:integer;
var n:integer;
begin
if (length(eventtime)=0) or (length(eventbatch)=0) or
(timedeventdate=datestr(now))
then n:=1440
else n:=timeval(eventtime)-timer;
if n<0 then n:=n+1440;
timetillevent:=n
end;
function timenetworkevent:integer;
var n:integer;
begin
if (length(netstart)=0) then n:=1440
else n:=timeval(netstart)-timer;
if n<0 then n:=n+1440;
timenetworkevent:=n
end;
procedure settimeleft (tl:integer);
begin
urec.timetoday:=timer+tl-logontime
end;
procedure tab (n:anystr; np:integer);
var cnt:integer;
begin
write (n);
for cnt:=length(n) to np-1 do begin
if periods then write ('.') else write (' ');
end;
periods:=false
end;
function yes:boolean;
begin
if length(input)=0
then yes:=false
else yes:=upcase(input[1])='Y'
end;
function no:boolean;
begin
if length(input)=0
then no:=false
else no:=upcase(input[1])='N'
end;
function yesno (b:boolean):sstr;
begin
if b
then yesno:='Yes'
else yesno:='No'
end;
function timeontoday:integer;
var timeon:integer;
begin
timeon:=timer-logontime;
if timeon<0 then timeon:=timeon+1440;
timeontoday:=timeon
end;
function isopen (var ff):boolean;
var fi:fib absolute ff;
begin
isopen:=fi.handle<>0
end;
procedure textclose (var f:text);
var n:integer;
fi:fib absolute f;
begin
if isopen(f)
then system.close (f);
fi.handle:=0;
n:=ioresult
end;
procedure close (var ff);
var f:file absolute ff;
fi:fib absolute ff;
n:integer;
begin
if isopen(f)
then system.close (f);
fi.handle:=0;
n:=ioresult;
end;
function withintime (t1,t2:sstr):boolean;
var nowt,time1,time2:integer;
begin
nowt:=timeval(timestr(now));
time1:=timeval(t1);
time2:=timeval(t2);
if time1<=time2 then withintime:=((nowt>=time1) and (nowt<=time2)) else
withintime:=((nowt>=time2) or (nowt<=time1));
end;
{}Function hungupon:Boolean;
Begin
hungupon:=forcehangup Or
(online And Not(carrier Or modeminlock Or modemoutlock))
End;{}
function sysopisavail:boolean;
begin
case sysopavail of
available:sysopisavail:=true;
notavailable:sysopisavail:=false;
bytime:sysopisavail:=withintime (availtime,unavailtime)
end
end;
function sysopavailstr:sstr;
const strs:array [available..notavailable] of string[9]=
('Yes','By time, ','No');
var tstr:sstr;
tmp:availtype;
begin
tstr:=strs[sysopavail];
if sysopavail=bytime
then
begin
if sysopisavail
then tmp:=available
else tmp:=notavailable;
tstr:=tstr+strs[tmp]
end;
sysopavailstr:=tstr
end;
function singularplural (n:integer; m1,m2:mstr):mstr;
begin
if n=1
then singularplural:=m1
else singularplural:=m2
end;
function s (n:integer):sstr;
begin
s:=singularplural (n,'','s')
end;
function numthings (n:integer; m1,m2:mstr):lstr;
begin
numthings:=strr(n)+' '+singularplural (n,m1,m2)
end;
procedure thereisare (n:integer);
var x:integer;
begin
x:=curattrib;
write ('There ');
if n=1
then begin
write ('is ');
write (^S'1 ');
ansicolor (x);
end
else
begin
write ('are ');
if n=0
then begin
write (^S'no ');
ansicolor (x);
end
else begin
write (^S,n,' ');
ansicolor (x)
end;
end
end;
procedure thereare (n:integer; m1,m2:mstr);
begin
thereisare (n);
if n=1
then write (m1)
else write (m2);
writeln ('.')
end;
procedure assignbdfile;
begin
assign (bdfile,datadir+'boarddir.'+strr(conn));
assign (bifile,datadir+'bdindex.'+strr(conn))
end;
procedure openbdfile;
var i:integer;
begin
closebdfile;
assignbdfile;
reset (bdfile);
i:=ioresult;
reset (bifile);
i:=i or ioresult;
if i<>0 then formatbdfile
end;
procedure formatbdfile;
begin
close (bdfile);
close (bifile);
assignbdfile;
rewrite (bdfile);
rewrite (bifile)
end;
procedure closebdfile;
begin
close (bdfile);
close (bifile)
end;
var wasopen:boolean;
procedure opentempbdfile;
begin
wasopen:=isopen(bdfile);
if not wasopen then openbdfile
end;
procedure closetempbdfile;
begin
if not wasopen then closebdfile
end;
function keyhit:boolean;
var r:registers;
begin
r.ah:=1;
intr ($16,r);
keyhit:=(r.flags and 64)=0
end;
function bioskey:char;
var r:registers;
begin
r.ah:=0;
intr ($16,r);
if r.al=0
then bioskey:=chr(r.ah+128)
else bioskey:=chr(r.al)
end;
procedure readline (var xx);
var a:anystr absolute xx;
l:byte absolute xx;
k:char;
procedure backspace;
begin
if l>0 then begin
write (usr,^H,' ',^H);
l:=l-1
end
end;
procedure eraseall;
begin
while l>0 do backspace
end;
procedure addchar (k:char);
begin
if l<buflen then begin
l:=l+1;
a[l]:=k;
write (usr,k)
end
end;
begin
l:=0;
repeat
k:=bioskey;
case k of
#8:backspace;
#27:eraseall;
#32..#126:addchar(k)
end
until k=#13;
writeln (usr);
buflen:=80;
end;
procedure readline2 (var xx);
var a:anystr absolute xx;
l:byte absolute xx;
k:char;
procedure backspace;
begin
if l>0 then begin
write (^H,' ',^H);
l:=l-1
end
end;
procedure eraseall;
begin
while l>0 do backspace
end;
procedure addchar (k:char);
begin
if l<buflen then begin
l:=l+1;
a[l]:=k;
write (k)
end
end;
begin
l:=0;
k:=#0;
repeat
k:=bioskey;
case k of
#8:backspace;
#27:eraseall;
#32..#126:addchar(k);
end;
until k=#13;
writeln;
buflen:=80;
end;
procedure writereturnbat;
var tf:text;
bd:integer;
tmp:lstr;
begin
assign (tf,'return.bat');
rewrite (tf);
getdir (0,tmp);
writeln (tf,copy(tmp,1,2));
writeln (tf,'cd '+tmp);
if unum=0
then begin
writeln (tf,'[Pause] No one was logged in!');
writeln (tf,'main.bat')
end else begin
if online then bd:=baudrate else bd:=0;
writeln (tf,'main.bat ',unum,' ',bd,' ',ord(parity),' M')
end;
textclose (tf);
textcolor(11);
write (usr,'Type');
textcolor(9);
write (usr,' [');
textcolor(15);
write (usr,'RETURN');
textcolor(9);
write (usr,'] ');
textcolor(11);
writeln(usr,'to return to FAQ');
textcolor (7);
end;
procedure execcomcom;
var prompt:anystr;
timeleft1:integer;
begin
timeleft1:=timeleft;
textbackground (0);
clrscr;
gotoxy (1,1);
textcolor(11);
write (usr,'Type');
textcolor(9);
write (usr,' [');
textcolor(15);
write (usr,'EXIT');
textcolor(9);
write (usr,'] ');
textcolor(11);
writeln(usr,'to return to FAQ');
ansicolor(7);
SwapVectors;
Exec(getenv('COMSPEC'),'/C '+getenv('COMSPEC'));
SwapVectors;
settimeleft (timeleft1);
chdir (copy(faqdir,1,length(faqdir)-1));
end;
procedure soundblaster (fname:lstr);
var prompt:anystr;
begin
if sblaster then begin
prompt:=fname+' >NUL';
if (exist (faqdir+fname)) and (exist (faqdir+'VPLAY.EXE')) then begin
SwapVectors;
Exec(GetEnv ('COMSPEC'),'/C '+faqdir+'VPLAY.EXE '+prompt);
SwapVectors; end;
end;
end;
procedure ensureclosed;
var cnt,i:integer;
begin
stoptimer (numminsidle);
stoptimer (numminsused);
writestatus;
textclose (ttfile);
i:=ioresult;
for cnt:=1 to numsysfiles do begin
close (sysfiles[cnt]);
i:=ioresult
end
end;
procedure clearbreak;
begin
break:=false;
xpressed:=false;
dontstop:=false;
nobreak:=false
end;
procedure WVT52(t:anystr);
var cnt:integer;
begin
if modemoutlock then exit;
if t[2]=#234 then delete (t,1,1);
for cnt:=1 to length(t) do sendchar (t[cnt]);
end;
procedure ansicolor (attrib:integer);
var tc:integer;
const colorid:array [0..7] of byte=(30,34,32,36,31,35,33,37);
begin
if attrib=0 then begin
textcolor (7);
textbackground (0)
end else begin
textcolor (attrib and $8f);
textbackground ((attrib shr 4) and 7)
end;
if not (ansigraphics in urec.config) or (attrib=0) or (usecapsonly)
or (attrib=curattrib) or break then exit;
curattrib:=attrib;
write (direct,#27'[0');
tc:=attrib and 7;
if tc<>7 then write (direct,';',colorid[tc]);
tc:=(attrib shr 4) and 7;
if tc<>0 then write (direct,';',colorid[tc]+10);
if (attrib and 8)=8 then write (direct,';1');
if (attrib and 128)=128 then write (direct,';5');
write (direct,'m')
end;
procedure ansireset;
begin
textcolor (7);
textbackground (0);
if usecapsonly then exit;
if urec.regularcolor<>0 then begin
ansicolor (urec.regularcolor);
exit
end;
if (not (ansigraphics in urec.config)) or (curattrib=0) or break then exit;
write (direct,#27'[0m');
curattrib:=0
end;
procedure specialmsg (q:anystr);
begin
textcolor (outlockcolor);
textbackground (0);
writeln (usr,q);
if not modemoutlock then textcolor (normbotcolor)
end;
procedure readdataarea;
var f:file of byte;
begin
assign (f,bbsdatadir+'FAQ.Dat');
reset (f);
if ioresult<>0
then unum:=-1
else begin
dos.filerec(f).recsize:=ofs(lastvariable)-ofs(firstvariable);
read (f,firstvariable);
close (f)
end
end;
procedure writedataarea;
var f:file of byte;
begin
assign (f,bbsdatadir+'FAQ.Dat');
rewrite (f);
dos.filerec(f).recsize:=ofs(lastvariable)-ofs(firstvariable);
write (f,firstvariable);
close (f)
end;
procedure ansimusic (m:lstr);
var a,b,c:string;
begin
a:=m;
if length(a)<1 then exit;
write (direct,#27'[M',a,#14);
end;
procedure cursor (b:boolean);
var r:registers;
begin
with r do begin
ah:=$01;
if not b then begin
ch:=$20; cl:=$20
end else begin
ch:=5; cl:=7
end
end;
intr ($10,r)
end;
begin
end.