home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / FAQ-S.ZIP / SUBS1.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-05-04  |  27.4 KB  |  1,044 lines
  1. {$R-,S-,I-,D-,F+,V-,B-,N-,L+ }
  2. {$M 65500,0,0 }
  3.  
  4. unit subs1;
  5.  
  6. interface
  7.  
  8. uses crt,dos,execswap,
  9.      gensubs,gentypes,statret,configrt,modem;
  10.  
  11. type cursor_array = array[0..31] of integer;
  12.  
  13. var firstvariable:byte;
  14.  
  15.     local,chatmode,disconnected:boolean;
  16.  
  17.     unum,ulvl:integer;
  18.     baudrate:longint;
  19.     nnu:integer;
  20.     unam:mstr;
  21.     baudstr:sstr;
  22.     parity,statusbar:boolean;
  23.     conn:byte;
  24.     urec:userrec;
  25.     logontime,logofftime,logonunum:integer;
  26.     laston:longint;
  27.     echodot,nochain,break,xpressed,
  28.     requestchat1,requestchat2,requestcom,requestbreak,reqspecial,{forcehangup,}
  29.     {modeminlock,modemoutlock,}timelock,tempsysop,splitmode,
  30.     fromdoor,texttrap,printerecho,uselinefeeds,usecapsonly,
  31.     dontstop,nobreak,wordwrap,beginwithspacesok,sysnext,ingetstr:boolean;
  32.     regularlevel,numusers,curboardnum,lasty,
  33.     linecount,curattrib,
  34.     firstfree,lockedtime,iocode,buflen:integer;
  35.     screenseg:word;
  36.     cursection:configtype;
  37.     curboardname:sstr;
  38.     input,chainstr:anystr;
  39.     chatreason,lastprompt,errorparam,errorproc:lstr;
  40.     curboard:boardrec;
  41.     mes:message;
  42.     syslogdat:array [0..maxsyslogdat] of syslogdatrec;
  43.     numsyslogdat:integer;
  44.     returnto:char;
  45.     lastvariable:byte;
  46.     usr,direct,directin:text;
  47.     reg:registerrec;
  48.  
  49. const numsysfiles=20;
  50. var tfile:file of buffer;
  51.     mapfile:file of integer;
  52.     ufile:file of userrec;
  53.     uhfile:file of mstr;
  54.     mfile:file of mailrec;
  55.     udfile:file of udrec;
  56.     batfile:file of udrec;
  57.     afile:file of arearec;
  58.     bfile:file of bulrec;
  59.     bdfile:file of boardrec;
  60.     bifile:file of sstr;
  61.     ffile:file of filerec;
  62.     tofile:file of topicrec;
  63.     chfile:file of choicerec;
  64.     ddfile:file of baserec;
  65.     efile:file of entryrec;
  66.     dofile:file of doorrec;
  67.     gfile:file of grouprec;
  68.     logfile:file of logrec;
  69.     abfile:file of abrec;
  70.     usfile:file of userspecsrec;
  71.     sysfiles:array [1..numsysfiles] of file absolute tfile;
  72.     ttfile:text;
  73.     blfile:file of bbsrec;
  74.     nmfile:file of netmailrec;
  75.     nlifile:file of netlistrec;
  76.     rfile:file of quoterec;
  77.     regsfile:file of registerrec;
  78.     sysfi:fib absolute logfile;
  79.  
  80. function button_pressed(button : integer) : boolean;
  81. procedure show_cursor;
  82. procedure hide_cursor;
  83. function mouse_installed : boolean;
  84. procedure get_cursor_position (var horizontal, vertical : integer);
  85. procedure set_cursor_position (horizontal, vertical : integer);
  86. procedure set_min_max_horiz(minimum, maximum : integer);
  87. procedure set_min_max_vert(minimum, maximum : integer);
  88. procedure set_graphics_cursor (hot_spot_x, hot_spot_y : integer; var cursor : cursor_array);
  89. procedure read_counters(var horizontal, vertical : integer);
  90. procedure user_subroutine(mask,subroutine_segment,subroutine_offset : integer);
  91. procedure light_pen_on;
  92. procedure light_pen_off;
  93. procedure set_pixel_ratio (horizontal_ratio, vertical_ratio : integer);
  94. function number_of_presses (button : integer) : integer;
  95. function number_of_releases (button : integer) : integer;
  96. procedure set_text_cursor (bottom_line, top_line : integer);
  97. function percent (var it,other:integer):integer;
  98. function ratio (var first,sec:longint):integer;
  99. procedure writelog(m,s:integer;prm:lstr);
  100. procedure files30;
  101. function ioerrorstr (num:integer):lstr;
  102. procedure error (errorstr,proc,param:lstr);
  103. procedure fileerror (procname,filename:lstr);
  104. procedure che;
  105. function timeleft:integer;
  106. function timetillevent:integer;
  107. function timenetworkevent:integer;
  108. procedure settimeleft (tl:integer);
  109. procedure tab (n:anystr; np:integer);
  110. function yes:boolean;
  111. function no:boolean;
  112. function yesno (b:boolean):sstr;
  113. function timeontoday:integer;
  114. function isopen (var ff):boolean;
  115. procedure textclose (var f:text);
  116. procedure close (var ff);
  117. function withintime (t1,t2:sstr):boolean;
  118. {}function hungupon:boolean;{}
  119. function sysopisavail:boolean;
  120. function sysopavailstr:sstr;
  121. function singularplural (n:integer; m1,m2:mstr):mstr;
  122. function s (n:integer):sstr;
  123. function numthings (n:integer; m1,m2:mstr):lstr;
  124. procedure thereisare (n:integer);
  125. procedure thereare (n:integer; m1,m2:mstr);
  126. procedure assignbdfile;
  127. procedure openbdfile;
  128. procedure formatbdfile;
  129. procedure closebdfile;
  130. procedure opentempbdfile;
  131. procedure closetempbdfile;
  132. function keyhit:boolean;
  133. function bioskey:char;
  134. procedure readline (var xx);
  135. procedure readline2 (var xx);
  136. procedure writereturnbat;
  137. procedure execcomcom;
  138. procedure soundblaster (fname:lstr);
  139. procedure ensureclosed;
  140. procedure clearbreak;
  141. procedure WVT52(t:anystr);
  142. procedure ansicolor (attrib:integer);
  143. procedure ansireset;
  144. procedure specialmsg (q:anystr);
  145. procedure writedataarea;
  146. procedure readdataarea;
  147. procedure ansimusic (m:lstr);
  148. procedure cursor (b:boolean);
  149.  
  150. implementation
  151.  
  152. function button_pressed(button : integer) : boolean;
  153.   { returns true if button is down.  Button = 0 for left button and 1 
  154.     for right button } 
  155. Begin
  156.   Inline
  157.     ($B8/$03/$00/         {     MOV AX,3                                      }
  158.      $CD/$33/             {     INT 33H                                       }
  159.      $8B/$4E/$04/         {     MOV CX,[BP+4]                                 }
  160.      $E3/$02/             {     JCXZ B0                                       }
  161.      $D1/$EB/             {     SHR BX,1                                      }
  162.      $89/$5E/$06);        { B0:MOV [BP+6],BX                                  }
  163. End;
  164.  
  165.  
  166. procedure show_cursor; 
  167.   { makes the cursor visible } 
  168. Begin
  169.   Inline
  170.     ($B8/$01/$00/         {     MOV AX,1                                      }
  171.      $CD/$33);            {     INT 33H                                       }
  172. End;
  173.  
  174.  
  175. procedure hide_cursor; 
  176.   { makes cursor invisible } 
  177. Begin
  178.   Inline
  179.     ($B8/$02/$00/         {     MOV AX,2                                      }
  180.      $CD/$33);            {     INT 33H                                       }
  181. End;
  182.  
  183.  
  184. function mouse_installed : boolean; 
  185.   { return true if the mouse driver and hardware are installed.  Also 
  186.     resets mouse to default settings. } 
  187. Begin
  188.   Inline
  189.     ($B8/$00/$00/         {     MOV AX,0                                      }
  190.      $CD/$33/             {     INT 33H                                       }
  191.      $89/$46/$04);        {     MOV [BP+4],AX                                 }
  192. End;
  193.  
  194.  
  195. procedure get_cursor_position (var horizontal, vertical : integer); 
  196.   { get the position of the cursor on the screen }
  197. Begin
  198.   Inline
  199.     ($B8/$03/$00/         {     MOV AX,3                                      }
  200.      $CD/$33/             {     INT 33H                                       }
  201.      $8B/$46/$0A/         {     MOV AX,[BP+10]                                }
  202.      $8E/$C0/             {     MOV ES,AX                                     }
  203.      $8B/$7E/$08/         {     MOV DI,[BP+8]                                 }
  204.      $26/$89/$0D/         {     MOV ES:[DI],CX                                }
  205.      $8B/$46/$06/         {     MOV AX,[BP+6]                                 }
  206.      $8E/$C0/             {     MOV ES,AX                                     }
  207.      $8B/$7E/$04/         {     MOV DI,[BP+4]                                 }
  208.      $26/$89/$15);        {     MOV ES:[DI],DX                                }
  209. End;
  210.  
  211.  
  212. procedure set_cursor_position (horizontal, vertical : integer); 
  213.   { move the cursor to the specified position }
  214. Begin
  215.   Inline
  216.     ($B8/$04/$00/         {     MOV AX,4                                      }
  217.      $8B/$4E/$06/         {     MOV CX,[BP+6]                                 }
  218.      $8B/$56/$04/         {     MOV DX,[BP+4]                                 }
  219.      $CD/$33);            {     INT 33H                                       }
  220. End;
  221.  
  222.  
  223. procedure set_min_max_horiz(minimum, maximum : integer);
  224.   { set the minimum and maximum horizontal position of the cursor }
  225. Begin
  226.   Inline
  227.     ($B8/$07/$00/         {     MOV AX,7                                      }
  228.      $8B/$4E/$06/         {     MOV CX,[BP+6]                                 }
  229.      $8B/$56/$04/         {     MOV DX,[BP+4]                                 }
  230.      $CD/$33);            {     INT 33H                                       }
  231. End;
  232.  
  233.  
  234. procedure set_min_max_vert(minimum, maximum : integer);
  235.   { set the minimum and maximum vertical position of the cursor }
  236. Begin
  237.   Inline
  238.     ($B8/$08/$00/         {     MOV AX,8                                      }
  239.      $8B/$4E/$06/         {     MOV CX,[BP+6]                                 }
  240.      $8B/$56/$04/         {     MOV DX,[BP+4]                                 }
  241.      $CD/$33);            {     INT 33H                                       }
  242. End;
  243.  
  244.  
  245. procedure set_graphics_cursor (hot_spot_x, hot_spot_y : integer; 
  246.                                var cursor : cursor_array); 
  247.   { Pass a custom cursor to the mouse hardware.  Cursor information contained 
  248.     in type cursor_array = array[0..31] of integer.  See examples in Microsoft
  249.     mouse manual.  Concatenate the two arrays shown in the manual into one 
  250.     array. } 
  251. Begin
  252.   Inline
  253.     ($8B/$5E/$0A/         {     MOV BX,[BP+10]                                }
  254.      $8B/$4E/$08/         {     MOV CX,[BP+8]                                 }
  255.      $8B/$56/$04/         {     MOV DX,[BP+4]                                 }
  256.      $8B/$46/$06/         {     MOV AX,[BP+6]                                 }
  257.      $8E/$C0/             {     MOV ES,AX                                     }
  258.      $B8/$09/$00/         {     MOV AX,9                                      }
  259.      $CD/$33);            {     INT 33H                                       }
  260. End;
  261.  
  262.  
  263. procedure read_counters(var horizontal, vertical : integer); 
  264.   { read the the horizontal and vertical mickey count since the last call to 
  265.     this procedure } 
  266. Begin
  267.   Inline
  268.     ($B8/$0B/$00/         {     MOV AX,11                                     }
  269.      $CD/$33/             {     INT 33H                                       }
  270.      $8B/$46/$0A/         {     MOV AX,[BP+10]                                }
  271.      $8E/$C0/             {     MOV ES,AX                                     }
  272.      $8B/$7E/$08/         {     MOV DI,[BP+8]                                 }
  273.      $26/$89/$0D/         {     MOV ES:[DI],CX                                }
  274.      $8B/$46/$06/         {     MOV AX,[BP+6]                                 }
  275.      $8E/$C0/             {     MOV ES,AX                                     }
  276.      $8B/$7E/$04/         {     MOV DI,[BP+4]                                 }
  277.      $26/$89/$15);        {     MOV ES:[DI],DX                                }
  278. End;
  279.  
  280.  
  281. procedure user_subroutine(mask,subroutine_segment,subroutine_offset : integer); 
  282.   { allows a branch to the specified subroutine according to the conditions
  283.     specified in the call mask.  See the Microsoft mouse manual for details } 
  284. Begin
  285.   Inline
  286.     ($8B/$4E/$08/         {     MOV CX,[BP+8]                                 }
  287.      $8B/$46/$06/         {     MOV AX,[BP+6]                                 }
  288.      $8E/$C0/             {     MOV ES,AX                                     }
  289.      $8B/$56/$04/         {     MOV DX,[BP+4]                                 }
  290.      $B8/$0C/$00/         {     MOV AX,12                                     }
  291.      $CD/$33);            {     INT 33H                                       }
  292. End;
  293.  
  294.  
  295. procedure light_pen_on; 
  296.   { enables light pen emulation by the mouse. }
  297. Begin
  298.   Inline
  299.     ($B8/$0D/$00/         {     MOV AX,13                                     }
  300.      $CD/$33);            {     INT 33H                                       }
  301. End;
  302.  
  303.  
  304. procedure light_pen_off; 
  305.   { disables light pen emulation by the mouse. }
  306. Begin
  307.   Inline
  308.     ($B8/$0E/$00/         {     MOV AX,14                                     }
  309.      $CD/$33);            {     INT 33H                                       }
  310. End;
  311.  
  312.  
  313. procedure set_pixel_ratio (horizontal_ratio, vertical_ratio : integer);
  314.   { Sets the sensitivity of the mouse.  The values entered for the ratios 
  315.     determine the number of mickeys per eight pixels.
  316.     for example: horizontal_ratio = 8, vertical_ratio = 16 -> 8 mickeys for 8
  317.     pixels horizontally and 16 mickeys for 8 pixels vertically. } 
  318. Begin
  319.   Inline
  320.     ($B8/$0F/$00/         {     MOV AX,15                                     }
  321.      $8B/$4E/$06/         {     MOV CX,[BP+6]                                 }
  322.      $8B/$56/$04/         {     MOV DX,[BP+4]                                 }
  323.      $CD/$33);            {     INT 33H                                       }
  324. End;
  325.  
  326.  
  327. function number_of_presses (button : integer) : integer; 
  328.   { returns number of times the button has been pressed since the last call 
  329.     to this function.  Button = 0 for left button and 1 for right button } 
  330. Begin
  331.   Inline
  332.     ($B8/$05/$00/         {     MOV AX,5                                      }
  333.      $8B/$5E/$04/         {     MOV BX,[BP+4]                                 }
  334.      $CD/$33/             {     INT 33H                                       }
  335.      $89/$5E/$06);        {     MOV [BP+6],BX                                 }
  336. End;
  337.  
  338.  
  339. function number_of_releases (button : integer) : integer; 
  340.   { returns number of times the button has been released since the last call 
  341.     to this function.  Button = 0 for left button and 1 for right button } 
  342. Begin
  343.   Inline
  344.     ($B8/$06/$00/         {     MOV AX,6                                      }
  345.      $8B/$5E/$04/         {     MOV BX,[BP+4]                                 }
  346.      $CD/$33/             {     INT 33H                                       }
  347.      $89/$5E/$06);        {     MOV [BP+6],BX                                 }
  348. End;
  349.  
  350.  
  351. procedure set_text_cursor (bottom_line, top_line : integer); 
  352.   { select the text cursor and the scan lines used.  On the CGA the cursor 
  353.     can be up to 8 scan lines high, numbered 0-7.  On the MDA, 0-11. } 
  354. Begin
  355.   Inline
  356.     ($B8/$0A/$00/         {     MOV AX,10                                     }
  357.      $BB/$01/$00/         {     MOV BX,1                                      }
  358.      $8B/$4E/$06/         {     MOV CX,[BP+6]                                 }
  359.      $8B/$56/$04/         {     MOV DX,[BP+4]                                 }
  360.      $CD/$33);            {     INT 33H                                       }
  361. End;
  362.  
  363.   function percent (var it,other:integer):integer;
  364.   var x1,x2,x3:integer;
  365.   var y1,y2,y3:real;
  366.  begin
  367.    x1:=it;
  368.    x2:=other;
  369.    if x1<1 then x1:=1;
  370.    if x2<1 then x2:=1;
  371.    y1:=int(x1);
  372.    y2:=int(x2);
  373.    y3:=y1/y2;
  374.    y3:=y3*100;
  375.    x3:=trunc(y3);
  376.   percent:=x3;
  377.    end;
  378.  
  379.  function ratio (var first,sec:longint):integer;
  380.    var y1,y2,y3:longint;
  381.        x3:integer;
  382.  begin
  383.   y1:=first;
  384.   y2:=sec;
  385.   if y1<1 then y1:=1;
  386.   if y2<1 then y2:=1;
  387.   if (y2>y1) then begin
  388.      y3:=y2;      { swap the numbers so that y1 <= y2 }
  389.      y2:=y1;
  390.      y1:=y3;
  391.   end;
  392.   y3:=y2 DIV y1;
  393.   y3:=y3*100;
  394.   x3:=trunc(y3);
  395.  ratio:=x3;
  396. end;
  397.  
  398.   procedure writelog(m,s:integer;prm:lstr);
  399.     Var n:Integer;
  400.       l:logrec;
  401.     begin
  402.       With l Do Begin
  403.         menu:=m;
  404.         subcommand:=s;
  405.         when:=now;
  406.         param:=Copy(prm,1,61)
  407.       End;
  408.       Seek(logfile,FileSize(logfile));
  409.       Write(logfile,l);
  410.     End;
  411.  
  412. procedure files30;
  413. begin
  414.   writeln (usr,'You MUST put "FILES=30" in your CONFIG.SYS!');
  415.   halt(4)
  416. end;
  417.  
  418. function ioerrorstr (num:integer):lstr;
  419. var tf:text;
  420.     tmp1,tmp2:lstr;
  421.     n,s:integer;
  422. begin
  423.   if num=243 then files30;
  424.   assign (tf,'Ioerror.Lst');
  425.   reset (tf);
  426.   if ioresult<>0 then begin
  427.     ioerrorstr:='[Can''t open IOERROR.LST]';
  428.     exit
  429.   end;
  430.   while not eof(tf) do begin
  431.     readln (tf,tmp1);
  432.     val (tmp1,n,s);
  433.     if n=num then begin
  434.       readln (tf,tmp2);
  435.       ioerrorstr:=tmp2;
  436.       close (tf);
  437.       exit
  438.     end
  439.   end;
  440.   close (tf);
  441.   ioerrorstr:='Unidentified I/O Error '+strr(num)
  442. end;
  443.  
  444. procedure error (errorstr,proc,param:lstr);
  445. var p,n:integer;
  446.     pk:char;
  447.     tf:text;
  448. begin
  449.   n:=ioresult;
  450.   repeat
  451.     p:=pos('%',errorstr);
  452.     if p<>0 then begin
  453.       pk:=errorstr[p+1];
  454.       delete (errorstr,p,2);
  455.       case upcase(pk) of
  456.         '1':insert (param,errorstr,p);
  457.         'P':insert (proc,errorstr,p);
  458.         'I':insert (ioerrorstr(iocode),errorstr,p)
  459.       end
  460.     end
  461.   until p=0;
  462.   assign (tf,bbsdatadir+'ErrLog.dat');
  463.   append (tf);
  464.   if ioresult<>0
  465.     then
  466.       begin
  467.         close (tf);
  468.         rewrite (tf);
  469.         writeln (tf,'                        FAQ '+ver+' Error Log                   ',datestr(now),' ',timestr(now));
  470.         writeln (tf,'──────────────────────────────────────────────────────────────────────────────');
  471.         writeln (tf);
  472.       end;
  473.   if unam='' then
  474.   writeln (tf,'Someone was logging in on ',datestr(now), ' at ',timestr(now),' when:')
  475.   else
  476.   writeln (tf,unam,' was On-Line on ',datestr(now),' at ',timestr(now),' when:');
  477.   writeln (tf,errorstr);
  478.   writeln (tf);
  479.   textclose (tf);
  480.   n:=ioresult;
  481.   writelog (0,4,errorstr);
  482.   writeln (errorstr)
  483. end;
  484.  
  485. procedure fileerror (procname,filename:lstr);
  486. begin
  487.   error ('%I accessing %1 in %P',procname,filename)
  488. end;
  489.  
  490. procedure che;
  491. var i:integer;
  492. begin
  493.   i:=ioresult;
  494.   case i of
  495.     0:;
  496.     4:files30;
  497.     else
  498.       begin
  499.         iocode:=i;
  500.         error ('Unexpected I/O Error %I','','')
  501.       end
  502.   end
  503. end;
  504.  
  505. function timeleft:integer;
  506. var timeon:integer;
  507. begin
  508.   timeon:=timer-logontime;
  509.   if timeon<0 then timeon:=timeon+1440;
  510.   timeleft:=urec.timetoday-timeon
  511. end;
  512.  
  513. function timetillevent:integer;
  514. var n:integer;
  515. begin
  516.   if (length(eventtime)=0) or (length(eventbatch)=0) or
  517.     (timedeventdate=datestr(now))
  518.     then n:=1440
  519.     else n:=timeval(eventtime)-timer;
  520.   if n<0 then n:=n+1440;
  521.   timetillevent:=n
  522. end;
  523.  
  524. function timenetworkevent:integer;
  525. var n:integer;
  526. begin
  527.   if (length(netstart)=0) then n:=1440
  528.     else n:=timeval(netstart)-timer;
  529.   if n<0 then n:=n+1440;
  530.   timenetworkevent:=n
  531. end;
  532.  
  533. procedure settimeleft (tl:integer);
  534. begin
  535.   urec.timetoday:=timer+tl-logontime
  536. end;
  537.  
  538. procedure tab (n:anystr; np:integer);
  539. var cnt:integer;
  540. begin
  541.   write (n);
  542.   for cnt:=length(n) to np-1 do begin
  543.    if periods then write ('.') else write (' ');
  544.   end;
  545.   periods:=false
  546. end;
  547.  
  548. function yes:boolean;
  549. begin
  550.   if length(input)=0
  551.     then yes:=false
  552.     else yes:=upcase(input[1])='Y'
  553. end;
  554.  
  555. function no:boolean;
  556. begin
  557.   if length(input)=0
  558.     then no:=false
  559.     else no:=upcase(input[1])='N'
  560. end;
  561.  
  562. function yesno (b:boolean):sstr;
  563. begin
  564.   if b
  565.     then yesno:='Yes'
  566.     else yesno:='No'
  567. end;
  568.  
  569. function timeontoday:integer;
  570. var timeon:integer;
  571. begin
  572.   timeon:=timer-logontime;
  573.   if timeon<0 then timeon:=timeon+1440;
  574.   timeontoday:=timeon
  575. end;
  576.  
  577. function isopen (var ff):boolean;
  578. var fi:fib absolute ff;
  579. begin
  580.   isopen:=fi.handle<>0
  581. end;
  582.  
  583. procedure textclose (var f:text);
  584. var n:integer;
  585.     fi:fib absolute f;
  586. begin
  587.   if isopen(f)
  588.     then system.close (f);
  589.   fi.handle:=0;
  590.   n:=ioresult
  591. end;
  592.  
  593. procedure close (var ff);
  594. var f:file absolute ff;
  595.     fi:fib absolute ff;
  596.     n:integer;
  597. begin
  598.   if isopen(f)
  599.     then system.close (f);
  600.   fi.handle:=0;
  601.   n:=ioresult;
  602. end;
  603.  
  604. function withintime (t1,t2:sstr):boolean;
  605. var nowt,time1,time2:integer;
  606. begin
  607.    nowt:=timeval(timestr(now));
  608.   time1:=timeval(t1);
  609.   time2:=timeval(t2);
  610.  
  611.   if time1<=time2 then withintime:=((nowt>=time1) and (nowt<=time2)) else
  612.                withintime:=((nowt>=time2) or (nowt<=time1));
  613. end;
  614.  
  615.  {}Function hungupon:Boolean;
  616.     Begin
  617.       hungupon:=forcehangup Or
  618.       (online And Not(carrier Or modeminlock Or modemoutlock))
  619.     End;{}
  620.  
  621. function sysopisavail:boolean;
  622. begin
  623.   case sysopavail of
  624.     available:sysopisavail:=true;
  625.     notavailable:sysopisavail:=false;
  626.     bytime:sysopisavail:=withintime (availtime,unavailtime)
  627.   end
  628. end;
  629.  
  630. function sysopavailstr:sstr;
  631. const strs:array [available..notavailable] of string[9]=
  632.     ('Yes','By time, ','No');
  633. var tstr:sstr;
  634.     tmp:availtype;
  635. begin
  636.   tstr:=strs[sysopavail];
  637.   if sysopavail=bytime
  638.     then
  639.       begin
  640.         if sysopisavail
  641.           then tmp:=available
  642.           else tmp:=notavailable;
  643.         tstr:=tstr+strs[tmp]
  644.       end;
  645.   sysopavailstr:=tstr
  646. end;
  647.  
  648. function singularplural (n:integer; m1,m2:mstr):mstr;
  649. begin
  650.   if n=1
  651.     then singularplural:=m1
  652.     else singularplural:=m2
  653. end;
  654.  
  655. function s (n:integer):sstr;
  656. begin
  657.   s:=singularplural (n,'','s')
  658. end;
  659.  
  660. function numthings (n:integer; m1,m2:mstr):lstr;
  661. begin
  662.   numthings:=strr(n)+' '+singularplural (n,m1,m2)
  663. end;
  664.  
  665. procedure thereisare (n:integer);
  666. var x:integer;
  667. begin
  668.   x:=curattrib;
  669.   write ('There ');
  670.   if n=1
  671.     then begin
  672.      write ('is ');
  673.      write (^S'1 ');
  674.      ansicolor (x);
  675.     end
  676.     else
  677.       begin
  678.         write ('are ');
  679.         if n=0
  680.           then begin
  681.             write (^S'no ');
  682.             ansicolor (x);
  683.           end
  684.           else begin
  685.            write (^S,n,' ');
  686.            ansicolor (x)
  687.           end;
  688.        end
  689. end;
  690.  
  691. procedure thereare (n:integer; m1,m2:mstr);
  692. begin
  693.   thereisare (n);
  694.   if n=1
  695.     then write (m1)
  696.     else write (m2);
  697.   writeln ('.')
  698. end;
  699.  
  700. procedure assignbdfile;
  701. begin
  702.   assign (bdfile,datadir+'boarddir.'+strr(conn));
  703.   assign (bifile,datadir+'bdindex.'+strr(conn))
  704. end;
  705.  
  706. procedure openbdfile;
  707. var i:integer;
  708. begin
  709.   closebdfile;
  710.   assignbdfile;
  711.   reset (bdfile);
  712.   i:=ioresult;
  713.   reset (bifile);
  714.   i:=i or ioresult;
  715.   if i<>0 then formatbdfile
  716. end;
  717.  
  718. procedure formatbdfile;
  719. begin
  720.   close (bdfile);
  721.   close (bifile);
  722.   assignbdfile;
  723.   rewrite (bdfile);
  724.   rewrite (bifile)
  725. end;
  726.  
  727. procedure closebdfile;
  728. begin
  729.   close (bdfile);
  730.   close (bifile)
  731. end;
  732.  
  733. var wasopen:boolean;
  734.  
  735. procedure opentempbdfile;
  736. begin
  737.   wasopen:=isopen(bdfile);
  738.   if not wasopen then openbdfile
  739. end;
  740.  
  741. procedure closetempbdfile;
  742. begin
  743.   if not wasopen then closebdfile
  744. end;
  745.  
  746. function keyhit:boolean;
  747. var r:registers;
  748. begin
  749.   r.ah:=1;
  750.   intr ($16,r);
  751.   keyhit:=(r.flags and 64)=0
  752. end;
  753.  
  754. function bioskey:char;
  755. var r:registers;
  756. begin
  757.   r.ah:=0;
  758.   intr ($16,r);
  759.   if r.al=0
  760.     then bioskey:=chr(r.ah+128)
  761.     else bioskey:=chr(r.al)
  762. end;
  763.  
  764. procedure readline (var xx);
  765. var a:anystr absolute xx;
  766.     l:byte absolute xx;
  767.     k:char;
  768.  
  769.   procedure backspace;
  770.   begin
  771.     if l>0 then begin
  772.       write (usr,^H,' ',^H);
  773.       l:=l-1
  774.     end
  775.   end;
  776.  
  777.   procedure eraseall;
  778.   begin
  779.     while l>0 do backspace
  780.   end;
  781.  
  782.   procedure addchar (k:char);
  783.   begin
  784.     if l<buflen then begin
  785.       l:=l+1;
  786.       a[l]:=k;
  787.       write (usr,k)
  788.     end
  789.   end;
  790.  
  791. begin
  792.   l:=0;
  793.   repeat
  794.     k:=bioskey;
  795.     case k of
  796.       #8:backspace;
  797.       #27:eraseall;
  798.       #32..#126:addchar(k)
  799.     end
  800.   until k=#13;
  801.   writeln (usr);
  802.   buflen:=80;
  803. end;
  804.  
  805. procedure readline2 (var xx);
  806. var a:anystr absolute xx;
  807.     l:byte absolute xx;
  808.     k:char;
  809.  
  810.   procedure backspace;
  811.   begin
  812.     if l>0 then begin
  813.       write (^H,' ',^H);
  814.       l:=l-1
  815.     end
  816.   end;
  817.  
  818.   procedure eraseall;
  819.   begin
  820.     while l>0 do backspace
  821.   end;
  822.  
  823.   procedure addchar (k:char);
  824.   begin
  825.     if l<buflen then begin
  826.       l:=l+1;
  827.       a[l]:=k;
  828.       write (k)
  829.     end
  830.   end;
  831.  
  832. begin
  833.   l:=0;
  834.   k:=#0;
  835.   repeat
  836.     k:=bioskey;
  837.     case k of
  838.       #8:backspace;
  839.       #27:eraseall;
  840.       #32..#126:addchar(k);
  841.     end;
  842.   until k=#13;
  843.   writeln;
  844.   buflen:=80;
  845. end;
  846.  
  847. procedure writereturnbat;
  848. var tf:text;
  849.     bd:integer;
  850.     tmp:lstr;
  851. begin
  852.   assign (tf,'return.bat');
  853.   rewrite (tf);
  854.   getdir (0,tmp);
  855.   writeln (tf,copy(tmp,1,2));
  856.   writeln (tf,'cd '+tmp);
  857.   if unum=0
  858.     then begin
  859.       writeln (tf,'[Pause] No one was logged in!');
  860.       writeln (tf,'main.bat')
  861.     end else begin
  862.       if online then bd:=baudrate else bd:=0;
  863.       writeln (tf,'main.bat ',unum,' ',bd,' ',ord(parity),' M')
  864.     end;
  865.   textclose (tf);
  866.     textcolor(11);
  867.     write  (usr,'Type');
  868.     textcolor(9);
  869.     write  (usr,' [');
  870.     textcolor(15);
  871.     write  (usr,'RETURN');
  872.     textcolor(9);
  873.     write  (usr,'] ');
  874.     textcolor(11);
  875.     writeln(usr,'to return to FAQ');
  876.     textcolor (7);
  877. end;
  878.  
  879. procedure execcomcom;
  880.  
  881. var prompt:anystr;
  882.     timeleft1:integer;
  883. begin
  884.  timeleft1:=timeleft;
  885.  textbackground (0);
  886.  clrscr;
  887.  gotoxy (1,1);
  888.     textcolor(11);
  889.     write  (usr,'Type');
  890.     textcolor(9);
  891.     write  (usr,' [');
  892.     textcolor(15);
  893.     write  (usr,'EXIT');
  894.     textcolor(9);
  895.     write  (usr,'] ');
  896.     textcolor(11);
  897.     writeln(usr,'to return to FAQ');
  898.     ansicolor(7);
  899.     SwapVectors;
  900.     Exec(getenv('COMSPEC'),'/C '+getenv('COMSPEC'));
  901.     SwapVectors;
  902.     settimeleft (timeleft1);
  903.     chdir (copy(faqdir,1,length(faqdir)-1));
  904. end;
  905.  
  906. procedure soundblaster (fname:lstr);
  907. var prompt:anystr;
  908. begin
  909.  if sblaster then begin
  910.  prompt:=fname+' >NUL';
  911.     if (exist (faqdir+fname)) and (exist (faqdir+'VPLAY.EXE')) then begin
  912.     SwapVectors;
  913.     Exec(GetEnv ('COMSPEC'),'/C '+faqdir+'VPLAY.EXE '+prompt);
  914.     SwapVectors; end;
  915.  end;
  916. end;
  917.  
  918. procedure ensureclosed;
  919. var cnt,i:integer;
  920. begin
  921.   stoptimer (numminsidle);
  922.   stoptimer (numminsused);
  923.   writestatus;
  924.   textclose (ttfile);
  925.   i:=ioresult;
  926.   for cnt:=1 to numsysfiles do begin
  927.     close (sysfiles[cnt]);
  928.     i:=ioresult
  929.   end
  930. end;
  931.  
  932. procedure clearbreak;
  933. begin
  934.   break:=false;
  935.   xpressed:=false;
  936.   dontstop:=false;
  937.   nobreak:=false
  938. end;
  939.  
  940.   procedure WVT52(t:anystr);
  941.   var cnt:integer;
  942.   begin
  943.   if modemoutlock then exit;
  944.    if t[2]=#234 then delete (t,1,1);
  945.    for cnt:=1 to length(t) do sendchar (t[cnt]);
  946.   end;
  947.  
  948. procedure ansicolor (attrib:integer);
  949. var tc:integer;
  950. const colorid:array [0..7] of byte=(30,34,32,36,31,35,33,37);
  951. begin
  952.   if attrib=0 then begin
  953.     textcolor (7);
  954.     textbackground (0)
  955.   end else begin
  956.     textcolor (attrib and $8f);
  957.     textbackground ((attrib shr 4) and 7)
  958.   end;
  959.   if not (ansigraphics in urec.config) or (attrib=0) or (usecapsonly)
  960.      or (attrib=curattrib) or break then exit;
  961.   curattrib:=attrib;
  962.   write (direct,#27'[0');
  963.   tc:=attrib and 7;
  964.   if tc<>7 then write (direct,';',colorid[tc]);
  965.   tc:=(attrib shr 4) and 7;
  966.   if tc<>0 then write (direct,';',colorid[tc]+10);
  967.   if (attrib and 8)=8 then write (direct,';1');
  968.   if (attrib and 128)=128 then write (direct,';5');
  969.   write (direct,'m')
  970. end;
  971.  
  972. procedure ansireset;
  973. begin
  974.   textcolor (7);
  975.   textbackground (0);
  976.   if usecapsonly then exit;
  977.   if urec.regularcolor<>0 then begin
  978.     ansicolor (urec.regularcolor);
  979.     exit
  980.   end;
  981.   if (not (ansigraphics in urec.config)) or (curattrib=0) or break then exit;
  982.   write (direct,#27'[0m');
  983.   curattrib:=0
  984. end;
  985.  
  986. procedure specialmsg (q:anystr);
  987. begin
  988.   textcolor (outlockcolor);
  989.   textbackground (0);
  990.   writeln (usr,q);
  991.   if not modemoutlock then textcolor (normbotcolor)
  992. end;
  993.  
  994. procedure readdataarea;
  995. var f:file of byte;
  996. begin
  997.   assign (f,bbsdatadir+'FAQ.Dat');
  998.   reset (f);
  999.   if ioresult<>0
  1000.     then unum:=-1
  1001.     else begin
  1002.       dos.filerec(f).recsize:=ofs(lastvariable)-ofs(firstvariable);
  1003.       read (f,firstvariable);
  1004.       close (f)
  1005.     end
  1006. end;
  1007.  
  1008. procedure writedataarea;
  1009. var f:file of byte;
  1010. begin
  1011.   assign (f,bbsdatadir+'FAQ.Dat');
  1012.   rewrite (f);
  1013.   dos.filerec(f).recsize:=ofs(lastvariable)-ofs(firstvariable);
  1014.   write (f,firstvariable);
  1015.   close (f)
  1016. end;
  1017.  
  1018. procedure ansimusic (m:lstr);
  1019. var a,b,c:string;
  1020. begin
  1021.  a:=m;
  1022.  if length(a)<1 then exit;
  1023.  write (direct,#27'[M',a,#14);
  1024. end;
  1025.  
  1026. procedure cursor (b:boolean);
  1027. var r:registers;
  1028. begin
  1029.   with r do begin
  1030.   ah:=$01;
  1031.   if not b then begin
  1032.   ch:=$20; cl:=$20
  1033.   end else begin
  1034.   ch:=5; cl:=7
  1035.   end
  1036.  end;
  1037.  intr ($10,r)
  1038. end;
  1039.  
  1040.  
  1041.  
  1042. begin
  1043. end.
  1044.