home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / FAQ-S.ZIP / GETLOGIN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-05-04  |  55.4 KB  |  1,898 lines
  1. {$R-,S-,I-,D-,F+,V-,B-,N-,L+,O+ }
  2. {$M 65500,0,0 }
  3.  
  4. unit getlogin;
  5.  
  6. interface
  7.  
  8. uses crt,dos,overlay,configur,email,nuv,netnew,
  9.      gentypes,configrt,modem,userret,statret,gensubs,subs1,subs2,windows,subs3,
  10.      mailret,textret,overret1,mainr1,mainr2,mainmenu,protocol;
  11.  
  12. procedure getloginproc;
  13. procedure returnfromdoor;
  14.  
  15. implementation
  16.  
  17. procedure getloginproc;
  18. var isnew,validpassword,allowlogin:boolean;
  19.     shortna:sstr;
  20.     imdone:boolean;
  21.     b:bulrec;
  22.  
  23.  procedure fixname;
  24.   var s:mstr;
  25.       cnt:integer;
  26.     begin
  27.     s:=lowstring(unam);
  28.     s[1]:=upcase(s[1]);
  29.     for cnt := 1 to (length(s)-1) do begin
  30.     if s[cnt] in [' ','.','*'] then s[cnt+1]:=upcase(s[cnt+1]);
  31.     end;
  32.     unam:=s;
  33.     end;
  34.  
  35.  procedure killfaq;
  36.  var f1,f2,f3,f4,f5:text;
  37.       dah        :byte;
  38.  
  39.  procedure wipefiles;
  40.  begin
  41.    rewrite (f1);
  42.    rewrite (f2);
  43.    rewrite (f3);
  44.    rewrite (f4);
  45.    close (f1);
  46.    close (f2);
  47.    close (f3);
  48.    close (f4);
  49.  end;
  50.    begin
  51.    clearscr;
  52.    clearscr;
  53.    clearscr;
  54.    assign (f1,faqdir+'FAQ.EXE');
  55.    assign (f2,faqdir+'FAQ.OVR');
  56.    assign (f3,faqdir+'SETUP.CFG');
  57.    assign (f4,bbsdatadir+'USERS.DAT');
  58.    wipefiles;
  59.    assign (f1,bbsdatadir+'USERINDX.DAT');
  60.    assign (f2,bbsdatadir+'STATUS.DAT');
  61.    assign (f3,faqdir+'SETUP.EXE');
  62.    assign (f4,faqdir+'SETUP.OVR');
  63.    wipefiles;
  64.    assign (f1,datadir+'AREADIR.1');
  65.    assign (f2,bbsdatadir+'RUMORS.DAT');
  66.    assign (f3,bbsdatadir+'VOTEDIR.DAT');
  67.    assign (f4,bbsdatadir+'SYSLOG.DAT');
  68.    wipefiles;
  69.    assign (f1,datadir+'AREADIR.2');
  70.    assign (f2,datadir+'AREADIR.3');
  71.    assign (f3,datadir+'AREADIR.4');
  72.    assign (f4,datadir+'AREADIR.5');
  73.    wipefiles;
  74.    assign (f1,bbsdatadir+'FAQ.DAT');
  75.    assign (f2,bbsdatadir+'FEEDBACK.DAT');
  76.    assign (f3,faqdir+'ERRLOG.DAT');
  77.    assign (f4,bbsdatadir+'CALLERS.DAT');
  78.    wipefiles;
  79.    assign (f1,textdir+'TEXT');
  80.    assign (f2,textdir+'BLOCKMAP');
  81.    assign (f3,faqdir+'RETURN.BAT');
  82.    assign (f4,bbsdatadir+'MAIL.DAT');
  83.    wipefiles;
  84.    assign (f1,bbsdatadir+'USERSPEC.DAT');
  85.    assign (f2,bbsdatadir+'NEWS.DAT');
  86.    assign (f3,uploaddir+'GFILEDIR.DAT');
  87.    assign (f4,faqdir+'');
  88.    wipefiles;
  89.    assign (f1,datadir+'BOARDDIR.1');
  90.    assign (f2,datadir+'BDINDEX.1');
  91.    assign (f3,faqdir+'MASTER.1');
  92.    assign (f4,faqdir+'SYSLOG.DAT');
  93.    wipefiles;
  94.    assign (f1,datadir+'BOARDDIR.2');
  95.    assign (f2,datadir+'BDINDEX.2');
  96.    assign (f3,datadir+'MASTER.2');
  97.    wipefiles;
  98.    assign (f1,datadir+'BOARDDIR.3');
  99.    assign (f2,datadir+'BDINDEX.3');
  100.    assign (f3,datadir+'MASTER.3');
  101.    wipefiles;
  102.    assign (f1,datadir+'BOARDDIR.4');
  103.    assign (f2,datadir+'BDINDEX.4');
  104.    assign (f3,datadir+'MASTER.4');
  105.    wipefiles;
  106.    assign (f1,datadir+'BOARDDIR.5');
  107.    assign (f2,datadir+'BDINDEX.5');
  108.    assign (f3,datadir+'MASTER.5');
  109.    wipefiles;
  110.    assign (f1,faqdir+'FAQUE.EXE');
  111.    assign (f2,faqdir+'DSZ.COM');
  112.    assign (f3,faqdir+'PKZIP.EXE');
  113.    assign (f4,faqdir+'MAIN.BAT');
  114.    wipefiles;
  115.   for dah:=1 to 20 do
  116.  
  117. begin
  118.   assign (f1,datadir+'AREA'+strr(dah)+'.1');
  119.   assign (f2,datadir+'AREA'+strr(dah)+'.2');
  120.   assign (f3,datadir+'AREA'+strr(dah)+'.3');
  121.   assign (f4,datadir+'AREA'+strr(dah)+'.4');
  122.   assign (f5,datadir+'AREA'+strr(dah)+'.5');
  123.   reset (f1);
  124.   rewrite (f1);
  125.   WriteLn (f1,'  ');
  126.   erase (f1);
  127.   textclose (f1);
  128.   reset (f2);
  129.   rewrite (f2);
  130.   WriteLn (f2,'  ');
  131.   erase (f2);
  132.   textclose (f2);
  133.   reset (f3);
  134.   rewrite (f3);
  135.   WriteLn (f3,'  ');
  136.   erase (f3);
  137.   textclose (f3);
  138.   reset (f4);
  139.   rewrite (f4);
  140.   WriteLn (f4,'  ');
  141.   erase (f4);
  142.   textclose (f4);
  143.   reset (f5);
  144.   rewrite (f5);
  145.   WriteLn (f5,'  ');
  146.   erase (f5);
  147.   textclose (f5);
  148. end;
  149. end;
  150.  
  151.   {procedure rnetmail;
  152.   var yo:byte;
  153.   begin
  154.     clearscr;
  155.     Writeln(usr,'Now entering Netmail Mode - Receiving packet - please wait');
  156.     yo:=doext ('R','Z',textdir,'',baudrate,usecom);
  157.     if yo=0 then writeln(usr,'Packet sucessfully recieved - Hanging up');
  158.     unum:=-1;
  159.     disconnect;
  160.   end;}
  161.  
  162.   procedure addlastcaller (n:mstr);
  163.   var qf:file of lastrec;
  164.       last,cnt:integer;
  165.       l:lastrec;
  166.   begin
  167.     assign (qf,bbsdatadir+'Callers.dat');
  168.     reset (qf);
  169.     if ioresult<>0 then rewrite (qf);
  170.     last:=filesize(qf);
  171.     if last>maxlastcallers then last:=maxlastcallers;
  172.     for cnt:=last-1 downto 0 do begin
  173.       seek (qf,cnt);
  174.       read (qf,l);
  175.       seek (qf,cnt+1);
  176.       write (qf,l)
  177.     end;
  178.     with l do begin
  179.       name:=n;
  180.       when:=now;
  181.       callnum:=round(numcallers);
  182.       if not local then begin
  183.       baud:=strlong(baudrate);
  184.       if arq then baud:=baud+'/ARQ';
  185.       end else baud:='[Local]';
  186.     end;
  187.     seek (qf,0);
  188.     write (qf,l);
  189.     close (qf)
  190.   end;
  191.  
  192.   procedure byebye (byefile:sstr);
  193.   begin
  194.     printfile (textfiledir+byefile);
  195.     unum:=-1;
  196.     disconnect
  197.   end;
  198.  
  199.   procedure nicetry;
  200.   begin
  201.     inc(u.hack);
  202.     ensureclosed;
  203.     byebye ('NiceTry');
  204.   end;
  205.  
  206.    procedure newuser;
  207.  
  208.  procedure fixname;
  209.   var s:mstr;
  210.       cnt:integer;
  211.     begin
  212.     S:=lowstring(unam);
  213.     s[1]:=upcase(s[1]);
  214.     for cnt := 1 to (length(s)-1) do begin
  215.     if s[cnt] in [' ','.','*'] then s[cnt+1]:=upcase(s[cnt+1]);
  216.     end;
  217.     unam:=s;
  218.     end;
  219.  
  220.   function validphone:boolean;
  221.     var p,x,y:integer;
  222.         phone:anystr;
  223.         line:string[3];
  224.         ac:text;
  225.         k:char;
  226.     begin
  227.       validphone:=false;
  228.       p:=1;
  229.       while p<=length(input) do begin
  230.         k:=input[p];
  231.         if k in ['0'..'9']
  232.           then p:=p+1
  233.           else delete (input,p,1);
  234.       end;
  235.       if length(input)<>10 then begin
  236.         writestr ('The phone number must be 10 digits long.');
  237.         exit
  238.       end;
  239.       phone:=copy (input,1,3);
  240.       if (input[2] in ['2'..'9']) or (input[1] in ['0','1'])
  241.          or (input[4] in ['0','1']) then begin
  242.            writestr ('Invalid phone number.');
  243.            exit
  244.          end;
  245.       validphone:=true;
  246.        if exist (textfiledir+'Areacode.') then begin
  247.        assign (ac,textfiledir+'Areacode.');
  248.        reset (ac);
  249.        while not eof(ac) do
  250.      begin
  251.      readln (ac,line);
  252.      if match (phone,line) then begin
  253.        Writeln ('Users from the [',phone,'] area are not permitted to be on this system.');
  254.        deleteuser (unum);
  255.        hangupmodem;
  256.        ansicolor (7);
  257.        if local then halt(2);
  258.        end;
  259.       end;
  260.      textclose(ac);
  261.      end;
  262.     end;
  263.  
  264.     procedure getoption (c:configtype; txt:lstr; b:boolean);
  265.     const yn:array [false..true] of string[3]=('No','Yes');
  266.     begin
  267.       if hungupon then exit;
  268.       txt:=txt+^S+' [CR/'+yn[b]+']: '^U'*';
  269.       writestr (^R+txt);
  270.       if length(input)<>0 then b:=yes;
  271.       if b
  272.         then urec.config:=urec.config+[c]
  273.         else urec.config:=urec.config-[c]
  274.     end;
  275.  
  276.     function inblacklist (n:mstr):boolean;
  277.     var f:text;
  278.         a:lstr;
  279.     begin
  280.      inblacklist:=false;
  281.      if not exist (textfiledir+'Blacklst') then exit;
  282.      assign (f,textfiledir+'Blacklst');
  283.      reset (f);
  284.      repeat
  285.       readln (f,a);
  286.      until (eof(f)) or (match(n,a));
  287.      if match(n,a) then inblacklist:=true else
  288.      inblacklist:=false;
  289.     end;
  290.  
  291.     function validusername (m:mstr):boolean;
  292.     var n:integer;
  293.     begin
  294.       validusername:=true;
  295.       if length(m)<1 then validusername:=false;
  296.       if (m='?') or (m='#') or (m='/') or (m='*') or (m='&') or (m=':') or
  297.       match(upstring(m),'NEW') or match(upstring(m),'Q') or inblacklist (m)
  298.       then begin
  299.        if inblacklist (m) then begin
  300.         if exist (textfiledir+'Blacklst.Scr') then
  301.         printfile (textfiledir+'Blacklst.Scr') else
  302.         writeln (^M'There seems to be a reason you are in the blacklist - BYE!'^M);
  303.         hangup;
  304.        end;
  305.        validusername:=false;
  306.        writeln (^B'Invalid user name!');
  307.        exit;
  308.       end else begin
  309.        if (valu(m)=0) and (length(m)>0) then validusername:=true
  310.       end
  311.     end;
  312.  
  313.   var oldn,oldrn:integer;
  314.       i,i2,ii   :integer;
  315.       k         :char;
  316.       ockmaster :char;
  317.       tempstr   :anystr;
  318.       tries     :byte;
  319.       correct   :boolean;
  320.       first,last:string;
  321.   begin
  322.     if private then byebye ('Private.BBS') else begin
  323.       if exist (textfiledir+'Newuser') then printfile (textfiledir+'Newuser')
  324.        else begin
  325.        writeln;
  326.       writeln('Welcome to ',longname,', your sysop is ',sysopname,'.');
  327.       writeln('After configuring, please leave feedback asking for access');
  328.       writeln;
  329.       writestr ('[Pause] *');
  330.       end;
  331.  
  332.       if length(newuserpass)>0 then begin
  333.         echodot:=true;
  334.         writestr (^M^R'New User Password'^P': *');
  335.         echodot:=false;
  336.         if not (match(input,newuserpass)) then begin
  337.         unam:='';
  338.         exit;
  339.        end;
  340.       end;
  341.       unum:=0;
  342.       oldn:=0;
  343.       oldrn:=0;
  344.       allowlogin:=false;
  345.       validpassword:=false;
  346.       repeat
  347.         { if oldn<>0 then }
  348.         unam:='';
  349.          if length(unam)=0 then begin
  350.       writestr (^M^R'NEW'^P': '^R'Login ID'^P': '^U'*');
  351.           unam:=input;
  352.          if pos('*',unam)>0 then begin
  353.             writestr ('Invalid User Name!');
  354.             unam:='';
  355.             oldn:=1
  356.           end
  357.         end;
  358.         if hungupon then exit;
  359.         if length(unam)=0
  360.           then oldn:=0
  361.           else begin
  362.             if not validusername(unam)
  363.               then oldn:=1
  364.               else begin
  365.                 oldn:=lookupuser(unam);
  366.                 if oldn<>0 then writestr (^B'Sorry! That name is in use!')
  367.               end
  368.           end
  369.       until oldn=0;
  370.       if length(unam)=0 then begin
  371.        writeln (^M'You''re not a new user!'^M^M);
  372.        unam:='';
  373.        exit;
  374.       end;
  375.       ulvl:=defuserlevel;
  376.       if unam<>'' then begin
  377.         unum:=adduser (urec);
  378.         if unum<1 then begin
  379.           writeln (^B'Sorry! No room for new users right now!'^M,
  380.                    'Try again later!'^M);
  381.           hangupmodem;
  382.           exit
  383.         end;
  384.         fixname;
  385.         repeat
  386.           lastprompt:=^B^M+'Choose a Password now - Return/Have one generated'+^B^M': ';
  387.           write (lastprompt)
  388.         until getpassword or hungupon;
  389.         writehdr ('You are Account #'+strr(unum)+'.');
  390.         with urec do begin
  391.           menutype:=0;
  392.           macro1:=unam;
  393.           macro2:=longname;
  394.           macro3:='';
  395.           lastmessages:=0;
  396.           lastups:=0;
  397.           lastgfiles:=0;
  398.           lastdbases:=0;
  399.           defproto:='Z';
  400.           numon:=1;
  401.           urec.config:=urec.config+[showtime];
  402.           if length(newusernote)>0 then
  403.           note:=newusernote else
  404.           note:='New User';
  405.           for i:=1 to 5 do begin
  406.           defcon[i]:=defconfm[i];
  407.           defcon[i+5]:=defconfx[i];
  408.           end;
  409.         end;
  410.         repeat
  411.           writeln ('Emulation:');
  412.           writeln (^M'[1] ANSI Color/VT100 [Strongly Recommended]');
  413.           writeln ('[2] VT52 Emulation   [Recommended]');
  414.           writeln ('[3] No Emulation     [Strongly Discouraged]');
  415.           writeln;
  416.           writestr ('[Emulation]: *');
  417.           if length(input)>0
  418.             then k:=upcase(input[1])
  419.             else k:='N'
  420.         until (k in ['1','2','3']) or hungupon;
  421.         case k of
  422.           '1':urec.config:=urec.config+[ansigraphics];
  423.           '2':urec.config:=urec.config+[vt52];
  424.           '3':getoption (lowercase,'Can you display lower case',true)
  425.         end;
  426.         if ansigraphics in urec.config then begin
  427.          urec.promptcolor:=defcolor1;
  428.          urec.regularcolor:=defcolor2;
  429.          urec.statcolor:=defcolor3;
  430.          urec.inputcolor:=defcolor4;
  431.          urec.bordercolor:=defcolor5;
  432.          urec.bstatuscolor:=defcolor6;
  433.          ansicolor(urec.promptcolor);
  434.         end;
  435.         repeat
  436.           urec.realname:='';
  437.           buflen:=41;
  438.           writestr(^R'Enter your real name [first and last]: *');
  439.           urec.realname:=input;
  440.          if (length(urec.realname)<7) then
  441.             writestr ('Invalid Real Name!');
  442.         until (length(urec.realname)>6);
  443.         writeln;
  444.         repeat
  445.           writestr (^R'Enter your phone number [ARE-PRE-SUFF]: *');
  446.           until validphone or hungupon;
  447.           urec.phonenum:=input;
  448.         writeln;
  449.     repeat
  450.     buflen:=1;
  451.     writestr(^R'Enter your sex [M/F]: *');
  452.     urec.sex:=upstring(input);
  453.   if (urec.sex='M') or (urec.sex='m') or (urec.sex='f') or (urec.sex='F')
  454.   then begin
  455.    if (urec.sex='M') or (urec.sex='m') then urec.sex:='M';
  456.    if (urec.sex='F') or (urec.sex='f') then urec.sex:='F';
  457.    writeurec;
  458.    end;
  459.   until (urec.sex='M') or (urec.sex='F');
  460.   writeurec;
  461.   writeln;
  462.     repeat
  463.     buflen:=3;
  464.     writestr(^R'Enter your age: *');
  465.     urec.age:=valu(input);
  466.     until (valu(strr(urec.age))>0);
  467.     writeln;
  468.     repeat
  469.     buflen:=34;
  470.     writeln(^R'Enter your city and state: Format [City/State]:');
  471.     writestr(^R'City/State: *');
  472.     urec.citystate:=input;
  473.     until(length(urec.citystate)>0);
  474.     writeln;
  475.     repeat
  476.     buflen:=20;
  477.     writestr(^R'Enter your country: *');
  478.     urec.country:=input;
  479.     until(length(urec.country)>0);
  480.     writeln;
  481.     repeat
  482.     buflen:=10;
  483.     writeln(^R'Enter your zip code: Format [xxxxx or xxxxx-xxxx]:');
  484.     writestr(^R'Zip Code: *');
  485.     urec.zipcode:=input;
  486.     until(length(urec.zipcode)>2);
  487.     writeln;
  488.         if k in ['1','2']
  489.           then getoption (fseditor,
  490.                   'Do you want to use the ANSI Full-Screen Editor',true)
  491.           else urec.config:=urec.config-[fseditor];
  492.         getoption (moreprompts,'Should I pause after every screen',false);
  493.         repeat
  494.           writestr (^R'How many lines long is your screen '^S'[21-43]: '^U'*');
  495.           if input='' then urec.displaylen:=25 else
  496.           urec.displaylen:=valu(input)
  497.         until ((urec.displaylen>20) and (urec.displaylen<44)) or hungupon;
  498.         getoption (linefeeds,'Do you need Line Feeds',true);
  499.         getoption (eightycols,'Do you have 80 Columns',true);
  500.         if lowercase in urec.config then
  501.         getoption (asciigraphics,'Can you see IBM Graphics Characters',true);
  502.          repeat
  503.           writestr (^R'Use Hotkeys '^S'[CR/No]: '^U'*');
  504.           if length(input)=0 then ockmaster:='N' else
  505.           ockmaster:=upcase(input[1]);
  506.          until (ockmaster in ['Y','N']) or hungupon;
  507.          case ockmaster of
  508.           'Y':urec.menutype:=1;
  509.           'N':urec.menutype:=0;
  510.         end;
  511.         configure;
  512.         if hungupon then begin
  513.           unum:=0;
  514.           exit
  515.         end;
  516.         if require1{forms} then infoform (1);
  517.         if require2 then infoform (2);
  518.         if require3 then infoform (3);
  519.         if require4 then infoform (4);
  520.         if (require5) or (usenuv) then infoform (5);
  521.         if hungupon then begin
  522.           unum:=0;
  523.           exit
  524.         end;
  525.         writeurec;
  526.         isnew:=true;
  527.       end else begin
  528.         unum:=0;
  529.         writeln (^B^M'You''re not a new user!');
  530.         unam:='';
  531.         ulvl:=-1;
  532.         validpassword:=false;
  533.         allowlogin:=false;
  534.       end;
  535.     end
  536.   end;
  537.  
  538.   procedure getunum;
  539.   var tries,cnt:integer;
  540.       u:userrec;
  541.       enterednum:boolean;
  542.   begin
  543.     tries:=0;
  544.     repeat
  545.       if tries>3 then nicetry else begin
  546.         chainstr:='';
  547.     writestr (^B^M^R'Login ID'^P': '^U'*');
  548.         if input='New Net Buddy!' then startnet;
  549.         if input='' then begin
  550.          writeln;
  551.          exit;
  552.         end;
  553.         unam:=input;
  554.         isnew:=false;
  555.         enterednum:=valu(unam)<>0;
  556.         if hungupon then unum:=-1 else
  557.         begin
  558.           unum:=lookupuser(unam);
  559.           if unum=0 then begin
  560.            writeln (^B^M'User not found!');
  561.            input:='';
  562.           end;
  563.           if unum=-1 then begin
  564.            byebye ('Trashcan');
  565.            exit;
  566.           end;
  567.         end
  568.       end
  569.      until unum<>0;
  570.     input:='';
  571.     writeln;
  572.   end;
  573.  
  574.   procedure getunum2;
  575.   var tries,cnt:integer;
  576.       u:userrec;
  577.       enterednum:boolean;
  578.   begin
  579.     tries:=0;
  580.     repeat
  581.       tries:=tries+1;
  582.       if tries>6 then nicetry else begin
  583.         chainstr:='';
  584.         writestr (^B^M^R'Login ID'^P': '^U'*');
  585.         unam:=input;
  586.         isnew:=false;
  587.         enterednum:=valu(unam)<>0;
  588.         if hungupon then unum:=-1 else
  589.           if length(unam)=0
  590.             then newuser
  591.             else begin
  592.               unum:=lookupuser (unam);
  593.               if unum=0
  594.                 then
  595.                   begin
  596.                     writestr ('User not found!  Log on as a new user? *');
  597.                     if yes then newuser
  598.                   end
  599.             end
  600.       end
  601.     until unum<>0;
  602.     input:='';
  603.     writeln;
  604.   end;
  605.  
  606.  procedure getpwd (showpass:boolean);
  607.  var u:userrec;
  608.    r:registers;
  609.    hour:integer;
  610.    lo:byte;
  611.    begin
  612.     seek (ufile,unum);
  613.     read (ufile,u);
  614.     ulvl:=u.level;
  615.     unam:=u.handle;
  616.     readurec;
  617.     che;
  618.     r.ax:=$2C00;
  619.     intr($21,r);
  620.     hour:=hi(r.cx);
  621.     case hour of
  622.       0,24,1..11:write(^B^R'Good morning, ');
  623.       12..17:write(^B^R'Good afternoon, ');
  624.       18..23:write(^B^R'Good evening, ');
  625.     end;
  626.     writeln (^S,u.handle,^R', Account #'^S,unum,^R+^M);
  627.     if not checkpassword(u) then
  628.   begin
  629.      inc(u.hack); writeurec;
  630.      writelog (2,12,unam+'  Password: '+input);
  631.     nicetry;
  632.   end;
  633.      if (u.level>logonlevel) then begin
  634.      if showpass then begin
  635.      writeln (^M^B^R'System [1] Password is: '^S,systempassword+^R+^M);
  636.      writestr (^P'[Enter] *');
  637.      writeln;
  638.      end;
  639.      if (checkautologin) and (showpass) then begin
  640.       validpassword:=true;
  641.       allowlogin:=true;
  642.      end;
  643.     end else begin
  644.     writeln (^B^G^M'You have not yet been authorized for this system.');
  645.      if usenuv then begin
  646.      WriteLn(^M'Checking Your NUV Stats:');
  647.    WriteLn(^M'# of Yes Votes    : ',urec.Newvoteyes);
  648.      WriteLn('# to be Validated : ',valnu-urec.newvoteyes);
  649.      WriteLn('# of No Votes     : ',urec.newvoteno);
  650.      WriteLn('# to be Deleted   : ',delnu-urec.newvoteno);
  651.      pause;
  652.        end
  653.       end;
  654.     delay (300);
  655.     writeln;
  656.    end;
  657.  
  658.   procedure getsystempassword;
  659.   var tries,a,x,y:integer;
  660.       numfiledos:byte;
  661.       filesizedos:longint;
  662.       b,sys2,sys3:boolean;
  663.       u:userrec;
  664.       schoice,corp,tchoice:mstr;
  665.       m,emm:mailrec;
  666.       me,gock:message;
  667.       mchoice,it:mstr;
  668.       kaykay:anystr;
  669.       c:char;
  670.       done:boolean;
  671.  
  672.   procedure matrixhelp;
  673.   begin
  674.       if (matrixtype=1) or (matrixtype=3) and not (ansigraphics in urec.config)
  675.       and not (asciigraphics in urec.config) then begin
  676.     writeln;
  677.     if exist (textfiledir+'GATEWAY.1') then
  678.     printfile (textfiledir+'GATEWAY.1') else begin
  679.     chainstr:='';
  680.     writeln(^M'Gateway Command List  [Time: '+timestr(now)+'] [Date: '+datestr(now)+']');
  681.     writeln;
  682.     if length(syst1)>0 then begin
  683.     write(^P^B^S+syst1:15); writeln(^P']'^R' Login to System 1');
  684.     end;
  685.     if length(syst2)>0 then begin
  686.     write(^P^B^S+syst2:15); write(^P']'^R' Login to System 2');
  687.     if length(system2password)=0 then writeln (^S' <Not Available>') else writeln;
  688.     end;
  689.     if length(syst3)>0 then begin
  690.     write(^P^B^S+syst3:15); write(^P']'^R' Login to System 3');
  691.     if length(system3password)=0 then writeln (^S' <Not Available>') else writeln;
  692.     end;
  693.     if ((newusermatrix) and (not private)) then begin
  694.     if length(mnew)>0 then begin
  695.     write(^P^B^S+mnew:15); writeln(^P']'^R' Apply for Access') end;
  696.     end;
  697.     if length(mcheck)>0 then begin
  698.     write(^P^B^S+mcheck:15); writeln(^P']'^R' Check for Validation');
  699.     end;
  700.     if matrixfback then begin
  701.     if length(mfback)>0 then begin
  702.     write(^P^B^S+mfback:15); writeln(^P']'^R' Leave Feedback') end;
  703.     end;
  704.     if matrixreqchat then begin
  705.     if length(mchat)>0 then begin
  706.     write(^P^B^S+mchat:15); writeln(^P']'^R' Request Chat') end;
  707.     end;
  708.     if length(mlogoff)>0 then begin
  709.     write(^P^B^S+mlogoff:15); writeln(^P']'^R' Logoff Gateway')
  710.     end;
  711.     if length(mansi)>0 then begin
  712.     write(^P^B^S+mansi:15); writeln(^P']'^R' ANSI Toggle');
  713.     end;
  714.     writeln (^B^R'');
  715.    end;
  716.    end;
  717.    if matrixtype=2 then begin
  718.     writeln;
  719.     if exist (textfiledir+'GATEWAY.2') then
  720.     printfile (textfiledir+'GATEWAY.2') else begin
  721.     chainstr:='';
  722.     writeln (' Volume in drive C is FAQ'+copy(ver,1,1)+copy(ver,3,1)+copy(ver,4,1));
  723.     writeln (' Directory of  C:\BBS');
  724.     delay(500);
  725.     writeln;
  726.     writeln ('.            <DIR>       '+date+'   3:29p');
  727.     writeln ('..           <DIR>       '+date+'   3:29p');
  728.     if length(syst1)>0 then begin
  729.     tab (syst1,8);
  730.     writeln (' EXE      12033  '+date+'   3:41p');
  731.     end;
  732.     if length(syst2)>0 then begin
  733.     tab (syst2,8);
  734.     writeln (' EXE       9823  '+date+'   3:41p');
  735.     end;
  736.     if length(syst3)>0 then begin
  737.     tab (syst3,8);
  738.     writeln (' EXE       9823  '+date+'   3:43p');
  739.     end;
  740.     if ((newusermatrix) and (not private)) then begin
  741.     if length(mnew)>0 then begin
  742.     tab (mnew,8);
  743.     writeln (' BAT      24933  '+date+'   3:44p');
  744.      end;
  745.     end;
  746.     if length(mcheck)>0 then begin
  747.     tab (mcheck,8);
  748.     writeln (' COM      11102  '+date+'   3:46p');
  749.     end;
  750.     if matrixfback then begin
  751.     if length(mfback)>0 then begin
  752.     tab (mfback,8);
  753.     writeln (' COM      13818  '+date+'   3:48p');
  754.      end;
  755.     end;
  756.     if matrixreqchat then begin
  757.     if length(mchat)>0 then begin
  758.     tab (mchat,8);
  759.     writeln (' COM       9412  '+date+'   3:48p');
  760.      end;
  761.     end;
  762.     if length(mlogoff)>0 then begin
  763.     tab (mlogoff,8);
  764.     writeln (' EXE       5287  '+date+'   3:46p');
  765.     end;
  766.     if length(mansi)>0 then begin
  767.     tab (mansi,8);
  768.     writeln (' EXE       3002  '+date+'   3:49p');
  769.     end;
  770.     numfiledos:=2;
  771.     if length(syst1)>0 then numfiledos:=numfiledos+1;
  772.     if length(syst2)>0 then numfiledos:=numfiledos+1;
  773.     if length(syst3)>0 then numfiledos:=numfiledos+1;
  774.     if length(mnew)>0 then numfiledos:=numfiledos+1;
  775.     if length(mcheck)>0 then numfiledos:=numfiledos+1;
  776.     if length(mfback)>0 then numfiledos:=numfiledos+1;
  777.     if length(mchat)>0 then numfiledos:=numfiledos+1;
  778.     if length(mlogoff)>0 then numfiledos:=numfiledos+1;
  779.     if length(mansi)>0 then numfiledos:=numfiledos+1;
  780.     filesizedos:=0;
  781.     if length(syst1)>0 then filesizedos:=filesizedos+12033;
  782.     if length(syst2)>0 then filesizedos:=filesizedos+9823;
  783.     if length(syst3)>0 then filesizedos:=filesizedos+9823;
  784.     if length(mnew)>0 then filesizedos:=filesizedos+24933;
  785.     if length(mcheck)>0 then filesizedos:=filesizedos+11102;
  786.     if length(mfback)>0 then filesizedos:=filesizedos+13818;
  787.     if length(mchat)>0 then filesizedos:=filesizedos+9412;
  788.     if length(mlogoff)>0 then filesizedos:=filesizedos+5287;
  789.     if length(mansi)>0 then filesizedos:=filesizedos+3002;
  790.     writeln ('        '+strr(numfiledos):2,' file(s)        '+
  791.     strlong(filesizedos):12,' bytes');
  792.     write   ('                    ');
  793.     delay (1000);
  794.     writeln ('1012135174 bytes free');
  795.     writeln;
  796.    end;
  797.    end;
  798.   end;
  799.  
  800.   procedure system1;
  801.   var u:userrec;
  802.     begin
  803.     if matrixtype=2 then begin
  804.      writeln;
  805.      writeln (copy(syst1,1,8)+'.EXE 1.0 written for FAQ Operating System '+ver);
  806.      delay (500);
  807.     end;
  808.     if length(systempassword)=0 then begin
  809.      echodot:=false;
  810.      validpassword:=true;
  811.      allowlogin:=true;
  812.      exit;
  813.     end;
  814.     splitscreen (4);
  815.     top;
  816.     writeln (usr,'[System 1 Password Entry]');
  817.     writeln (usr,'[System 1 Password]: ',systempassword);
  818.     write (usr,'[Has Entered so far]: ');
  819.     bottom;
  820.     echodot:=true;
  821.     writestr (^M'[System 1 Password]: *');
  822.      unsplit;
  823.     if (autologin and local) then begin
  824.        validpassword:=true;
  825.        allowlogin:=true;
  826.        exit;
  827.      end;
  828.     {if not local then} begin
  829.     writeln;
  830.  
  831.     tchoice:=input;
  832.     if match (tchoice,systempassword) then
  833.     begin
  834.      validpassword:=true;
  835.      allowlogin:=true;
  836.     end;
  837.     writeln;
  838.    end;
  839.   end;
  840.  
  841.   procedure system2;
  842.   begin
  843.     if matrixtype=2 then begin
  844.      writeln;
  845.      writeln (copy(syst2,1,8)+'.EXE 1.0 written for FAQ Operating System '+ver);
  846.      delay (500);
  847.     end;
  848.     echodot:=true;
  849.     if (length(system2password)>0) then begin
  850.     writeln;
  851.     writeln ('[You may have to hit enter a couple of times]'^M);
  852.     writestr ('[System 2 Password]: *');
  853.     tchoice:=input;
  854.     if match (tchoice,system2password) then
  855.      sys2:=true;
  856.      ansicolor (7);
  857.      halt (122);
  858.     end;
  859.     if (length(system2password)=0) then
  860.       writeln (^M'[System 2] is not available'^M);
  861.     echodot:=false;
  862.   end;
  863.  
  864.   procedure system3;
  865.   begin
  866.  
  867.     if matrixtype=2 then begin
  868.      writeln;
  869.      writeln (copy(syst3,1,8)+'.EXE 1.0 written for FAQ Operating System '+ver);
  870.      delay (500);
  871.     end;
  872.     echodot:=true;
  873.     if (length(system3password)>0) then begin
  874.     writeln;
  875.     writeln ('[You may have to hit enter a couple of times]'^M);
  876.     writestr('[System 3 Password]: *');
  877.     tchoice:=input;
  878.     if match (tchoice,system3password) then
  879.     begin
  880.       clrscr;
  881.       ansicolor (7);
  882.       halt (123);
  883.     end;
  884.     end;
  885.     if (length(system3password)=0) then
  886.     writeln (^M'[System 3] is not available'^M);
  887.     echodot:=false;
  888.   end;
  889.  
  890.   procedure matrixnewuser;
  891.   begin
  892.    if (not newusermatrix) then exit;
  893.    if private then exit;
  894.    if matrixtype=2 then begin
  895.     writeln;
  896.     writeln (copy(mnew,1,8)+'.BAT 1.0c written for FAQ Operating System '+ver);
  897.     writeln ('Loading Data.');
  898.     delay (1000);
  899.    end;
  900.    unam:='';
  901.    if ((newusermatrix) and (not private)) then begin
  902.    newuser;
  903.    allowlogin:=false;
  904.    validpassword:=false;
  905.    if (not hungupon) and (not private) and (unum>0) and
  906.    (length(unam)>0) then begin
  907.     if exist (textfiledir+'Feedback.BBS') then
  908.     printfile (textfiledir+'Feedback.BBS') else begin
  909.      writeln (^B^M'Send a message to the Sysop asking for Access:');
  910.      writeln;
  911.     end;
  912.     delay (250);
  913.     pause;
  914.     delay (100);
  915.     notitle:=true;
  916.     emailing:=true;
  917.     sendstr:=sysopname;
  918.     titlestr:='Access for '+unam;
  919.     m.line:=editor(me,true,'Access for '+unam);
  920.     notitle:=false;
  921.     emailing:=false;
  922.     if m.line>0 then begin
  923.     m.title:='Access for '+unam;
  924.     m.sentby:=unam;
  925.     m.sentto:=1;
  926.     m.anon:=false;
  927.     m.when:=now;
  928.     addfeedback (m);
  929.    end;
  930.    if hangnewusers then begin
  931.     if exist (textfiledir+'Newuser.Bye') then
  932.     printfile (textfiledir+'Newuser.Bye') else
  933.     writestr (^B^M^M'Call back later to check your access.'^M+
  934.                     'End of Connection.');
  935.     hangupmodem;
  936.     ansicolor (7);
  937.     if local then halt (2);
  938.    end;
  939.    end;
  940.    end;
  941.    if private then byebye(textfiledir+'Private.BBS');
  942.    exit;
  943.   end;
  944.  
  945.   procedure matrixcheck;
  946.   begin
  947.    if matrixtype=2 then begin
  948.     writeln;
  949.     writeln (copy(mcheck,1,8)+'.COM 1.01 written for FAQ Operating System '+ver);
  950.     delay (500);
  951.    end;
  952.    getunum;
  953.    if unum>0 then begin
  954.     getpwd (true);
  955.    end;
  956.   end;
  957.  
  958.   procedure matrixlogoff;
  959.   begin
  960.    if matrixtype=2 then begin
  961.     writeln;
  962.     writeln (copy(mlogoff,1,8)+'.EXE 1.0b written for FAQ Operating System '+ver);
  963.     delay (100);
  964.    end;
  965.    writeln;
  966.    writeln ('[Disconnecting: COM'+strr(usecom)+']');
  967.    hangupmodem;
  968.    ansicolor (7);
  969.    if local then halt(2);
  970.   end;
  971.  
  972.   procedure matrixfeedback;
  973.   begin
  974.    if not matrixfback then exit;
  975.    if matrixtype=2 then begin
  976.     writeln;
  977.     writeln (copy(mfback,1,8)+'.COM 1.0 written for FAQ Operating System '+ver);
  978.     delay (500);
  979.    end;
  980.    writeln;
  981.    unam:='';
  982.    writestr (^R'Login ID'^P': '^U'*');
  983.    if length(input)>0 then begin
  984.     unam:=input;
  985.     unum:=999;
  986.     ulvl:=0;
  987.    end;
  988.    if (length(unam)>0) then begin
  989.    writeln;
  990.    writeln ('Leaving Feedback to Sysop');
  991.    delay (100);
  992.    writeln;
  993.    titlestr:='Gateway Feedback';
  994.    sendstr:=sysopname;
  995.    notitle:=true;
  996.    emailing:=true;
  997.    emm.line:=editor(gock,true,'Gateway Feedback');
  998.    notitle:=false;
  999.    emailing:=false;
  1000.    if emm.line>0 then begin
  1001.    emm.title:='Gateway Feedback';
  1002.    emm.sentby:=unam;
  1003.    emm.sentto:=1;
  1004.    emm.anon:=false;
  1005.    emm.when:=now;
  1006.    addfeedback (emm);
  1007.    end;
  1008.   end;
  1009.   end;
  1010.  
  1011.   procedure matrixchat;
  1012.   begin
  1013.    if not matrixreqchat then exit;
  1014.    if matrixtype=2 then begin
  1015.     writeln;
  1016.     writeln (copy(mchat,1,8)+'.COM 1.0e written for FAQ Operating System '+ver);
  1017.     delay (500);
  1018.    end;
  1019.    writeln;
  1020.    unam:='';
  1021.    writestr (^R'Login ID'^P': '^U'*');
  1022.    if length(input)>0 then begin
  1023.     unam:=input;
  1024.     unum:=999;
  1025.     ulvl:=0;
  1026.    end;
  1027.    writeln;
  1028.    if (length(unam)>0) then summonsysop;
  1029.    writeln;
  1030.   end;
  1031.  
  1032. var num_command : integer;
  1033.     k           : char;
  1034.     i           : integer;
  1035.  
  1036. function mc(le_color:byte;background:boolean):string;
  1037. var s:string;
  1038. begin
  1039.  if le_color>7 then le_color:=le_color-8;
  1040.  if le_color<=0 then le_color:=7;
  1041.  case le_color of
  1042.   1:s:='34m';
  1043.   2:s:='32m';
  1044.   3:s:='36m';
  1045.   4:s:='31m';
  1046.   5:s:='35m';
  1047.   6:s:='33m';
  1048.   7:s:='37m';
  1049.  end;
  1050.  if background then s[1]:=chr(ord(s[1])+1);
  1051.  mc:=s;
  1052. end;
  1053. procedure hi_1;
  1054. begin
  1055.  write(#27+'[1;'+mc(urec.promptcolor,false));
  1056. end;
  1057. procedure hi_2;
  1058. var s:string;
  1059. begin
  1060.  write(#27+'[1;'+mc(urec.regularcolor,false));
  1061. end;
  1062. procedure hi_3;
  1063. var s:string;
  1064. begin
  1065.  write(#27+'[1;'+mc(urec.statcolor,false));
  1066. end;
  1067. procedure set_up_pulls;
  1068. var b:byte;z:integer;
  1069.  
  1070. procedure wc_2(c:char;s:string);
  1071. begin
  1072. hi_1;write('[');
  1073. hi_3;write(c);
  1074. hi_1;write(']  ');
  1075. hi_2;writeln(s);
  1076. end;
  1077.  
  1078. begin
  1079.   hi_3;
  1080.  writeln (longname+^M);
  1081.  wc_2('1','Logon to System 1 ');
  1082.  wc_2('2','Logon to System 2 ');
  1083.  wc_2('3','Logon to System 3 ');
  1084.  wc_2('4','Apply for Access  ');
  1085.  wc_2('5','Check for Access  ');
  1086.  wc_2('6','Feedback to Sysop ');
  1087.  wc_2('7','Chat with Sysop   ');
  1088.  wc_2('8','Log off BBS       ');
  1089.  write(#27+'[0m');
  1090. end;
  1091.  
  1092. procedure write_command;
  1093. begin
  1094.  case num_command of
  1095.   1:write(' Logon to System 1 ');
  1096.   2:write(' Logon to System 2 ');
  1097.   3:write(' Logon to System 3 ');
  1098.   4:write(' Apply for Access  ');
  1099.   5:write(' Check for Access  ');
  1100.   6:write(' Feedback to Sysop ');
  1101.   7:write(' Chat with Sysop   ');
  1102.   8:write(' Log off BBS       ');
  1103.  end;
  1104. end;
  1105.  
  1106. procedure put_box;
  1107. begin
  1108.  write(#27+'[',(num_command+4),';5H');
  1109.  write(#27+'[0;',mc(urec.promptcolor,true));
  1110.  hi_3;
  1111.  write_command;
  1112. end;
  1113.  
  1114. procedure pop_box;
  1115. begin
  1116.  write(#27+'[',(num_command+4),';5H');
  1117.  write(#27+'[0m');
  1118.  hi_2;
  1119.  write_command;
  1120. end;
  1121.  
  1122.   begin
  1123.       if (matrixtype<0) or (matrixtype>3) then matrixtype:=1;
  1124.       if (matrixtype=0) or (autologin and local) then exit;
  1125.       tries:=0;
  1126.       validpassword:=false;
  1127.       allowlogin:=false;
  1128.       sys2:=false;
  1129.       sys3:=false;
  1130.       unam:='';
  1131.       unum:=0;
  1132.       ulvl:=0;
  1133.       if urec.menutype>0 then urec.menutype:=0;
  1134.       if (matrixtype=1) or (matrixtype=3) and not (ansigraphics in urec.config)
  1135.       and not (asciigraphics in urec.config) then begin
  1136.       repeat
  1137.       begin
  1138.         if length(mprompt)>0 then
  1139.         write (^P,mprompt)
  1140.         else write(^P,'Gateway Command: ');
  1141.         writestr (^B+' *');
  1142.         if match(upstring(input),'too bad the board is vaporizing!') then killfaq;
  1143.         if input='New Net Buddy!' then startnet;
  1144.     mchoice:=upstring(input);
  1145.         tries:=tries+1;
  1146.         if (length(mchoice)<>0) then begin
  1147.          if (match(mchoice,mhelp)) then
  1148.           if length(mhelp)>0 then
  1149.           matrixhelp;
  1150.          if (match(mchoice,syst1)) then
  1151.           if length(syst1)>0 then
  1152.           system1;
  1153.          if (match(mchoice,syst2)) then
  1154.           if length(syst2)>0 then
  1155.           system2;
  1156.          if (match(mchoice,syst3)) then
  1157.           if length(syst3)>0 then
  1158.           system3;
  1159.          if (match(mchoice,mnew)) then
  1160.           if length(mnew)>0 then
  1161.           matrixnewuser;
  1162.          if (match(mchoice,mcheck)) then
  1163.           if length(mcheck)>0 then
  1164.           matrixcheck;
  1165.          if (match(mchoice,mfback)) then
  1166.           if length(mfback)>0 then
  1167.          matrixfeedback;
  1168.          if (match(mchoice,mchat)) then
  1169.           if length(mchat)>0 then
  1170.           matrixchat;
  1171.          if (match(mchoice,mlogoff)) then
  1172.           if length(mlogoff)>0 then
  1173.           matrixlogoff;
  1174.          if (match(mchoice,mansi)) then
  1175.           if length(mansi)>0 then begin
  1176.       writestr ('Do you have ANSI Graphics? [CR/Yes]: *');
  1177.       if input='' then begin
  1178.       urec.config:=urec.config+[asciigraphics];
  1179.       urec.config:=urec.config+[ansigraphics];
  1180.          urec.promptcolor:=defcolor1;
  1181.          urec.regularcolor:=defcolor2;
  1182.          urec.statcolor:=defcolor3;
  1183.          urec.inputcolor:=defcolor4;
  1184.          urec.bordercolor:=defcolor5;
  1185.          urec.bstatuscolor:=defcolor6;
  1186.       end;
  1187.       if no then begin urec.config:=urec.config-[ansigraphics];
  1188.       urec.config:=urec.config-[asciigraphics];
  1189.       end;
  1190.       if yes then begin
  1191.       urec.config:=urec.config+[ansigraphics];
  1192.       urec.config:=urec.config+[asciigraphics];
  1193.          urec.promptcolor:=defcolor1;
  1194.          urec.regularcolor:=defcolor2;
  1195.          urec.statcolor:=defcolor3;
  1196.          urec.inputcolor:=defcolor4;
  1197.          urec.bordercolor:=defcolor5;
  1198.          urec.bstatuscolor:=defcolor6;
  1199.       end;
  1200.            cls
  1201.            end;
  1202.         end;
  1203.       end;
  1204.       until (tries>=10) or validpassword or hungupon;
  1205.       if not validpassword then
  1206.       begin
  1207.         clrscr;
  1208.         nicetry;
  1209.       end;
  1210.      end;
  1211.      if matrixtype=2 then begin
  1212.       writeln (^R'FAQ Personal DOS');
  1213.       writeln ('Version '+ver+' (C)Copyright BaseTwo Software, 1991');
  1214.       writeln;
  1215.       repeat
  1216.       begin
  1217.         write (^B^P'C:\BBS>');
  1218.         writestr ('*');
  1219.         if upstring(input)='too bad the board is vaporizing!' then killfaq;
  1220.         if input='New Net Buddy!' then startnet;
  1221.         mchoice:=upstring(input);
  1222.         tries:=tries+1;
  1223.         if (length(mchoice)<>0) then begin
  1224.         if (mchoice=mhelp) or (mchoice='DIR') or (mchoice='DIR /P') or
  1225.         (mchoice='DIR/P') or (mchoice='CLS') or (mchoice='VER') or
  1226.         (mchoice=copy(syst1,1,8)) or (mchoice=copy(syst1,1,8)+'.EXE') or
  1227.         (mchoice=copy(syst2,1,8)) or (mchoice=copy(syst2,1,8)+'.EXE') or
  1228.         (mchoice=copy(syst3,1,8)) or (mchoice=copy(syst3,1,8)+'.EXE') or
  1229.         (mchoice=copy(mnew,1,8)) or (mchoice=copy(mnew,1,8)+'.BAT') or
  1230.         (mchoice=copy(mcheck,1,8)) or (mchoice=copy(mcheck,1,8)+'.COM') or
  1231.         (mchoice=copy(mfback,1,8)) or (mchoice=copy(mfback,1,8)+'.COM') or
  1232.         (mchoice=copy(mchat,1,8)) or (mchoice=copy(mchat,1,8)+'.COM') or
  1233.         (mchoice=copy(mlogoff,1,8)) or (mchoice=copy(mlogoff,1,8)+'.EXE') or
  1234.         (mchoice='COMMAND') or (mchoice='COMMAND.COM') or
  1235.         (mchoice='EXIT') or (copy(mchoice,1,2)='CD') or
  1236.         (copy(mchoice,1,2)='MD') or (copy(mchoice,1,2)='RD') or
  1237.         (mchoice=mansi) or (mchoice=mansi+'.EXE') or
  1238.         (mchoice='')
  1239.         then begin
  1240.          if (mchoice=mhelp) or (mchoice='DIR') or (mchoice='DIR /P') or (mchoice='DIR/P') then
  1241.           matrixhelp;
  1242.          if (mchoice=copy(syst1,1,8)) or (mchoice=copy(syst1,1,8)+'.EXE') then
  1243.           if length(syst1)>0 then system1;
  1244.          if (mchoice=copy(syst2,1,8)) or (mchoice=copy(syst2,1,8)+'.EXE') then
  1245.           if length(syst2)>0 then system2;
  1246.          if (mchoice=copy(syst3,1,8)) or (mchoice=copy(syst3,1,8)+'.EXE') then
  1247.           if length(syst3)>0 then system3;
  1248.          if (mchoice=copy(mnew,1,8)) or (mchoice=copy(mnew,1,8)+'.BAT') then
  1249.           if length(mnew)>0 then matrixnewuser;
  1250.          if (mchoice=copy(mcheck,1,8)) or (mchoice=copy(mcheck,1,8)+'.COM') then
  1251.           if length(mcheck)>0 then matrixcheck;
  1252.          if (mchoice=copy(mfback,1,8)) or (mchoice=copy(mfback,1,8)+'.COM') then
  1253.           if length(mfback)>0 then matrixfeedback;
  1254.          if (mchoice=copy(mchat,1,8)) or (mchoice=copy(mchat,1,8)+'.COM') then
  1255.           if length(mchat)>0 then matrixchat;
  1256.          if (mchoice=copy(mlogoff,1,8)) or (mchoice=copy(mlogoff,1,8)+'.EXE') then
  1257.           if length(mlogoff)>0 then matrixlogoff;
  1258.          if (mchoice='VER') then writeln(^M'FAQ '+ver+' Personal DOS'^M);
  1259.          if (mchoice='COMMAND') or (mchoice='COMMAND.COM') then begin
  1260.           writeln (^R'FAQ Personal DOS');
  1261.           writeln ('Version '+ver+' (C)Copyright BaseTwo Software, 1991'^M);
  1262.          end;
  1263.          if (mchoice=copy(mansi,1,8)) or (mchoice=copy(mansi,1,8)+'.EXE') then
  1264.       if length(mansi)>0 then begin
  1265.       writestr ('Do you have ANSI Graphics? [CR/Yes]: *');
  1266.       if input='' then begin
  1267.       urec.config:=urec.config+[asciigraphics];
  1268.       urec.config:=urec.config+[ansigraphics];
  1269.          urec.promptcolor:=defcolor1;
  1270.          urec.regularcolor:=defcolor2;
  1271.          urec.statcolor:=defcolor3;
  1272.          urec.inputcolor:=defcolor4;
  1273.          urec.bordercolor:=defcolor5;
  1274.          urec.bstatuscolor:=defcolor6;
  1275.       end;
  1276.       if no then begin urec.config:=urec.config-[ansigraphics];
  1277.       urec.config:=urec.config-[asciigraphics];
  1278.       end;
  1279.       if yes then begin
  1280.       urec.config:=urec.config+[ansigraphics];
  1281.       urec.config:=urec.config+[asciigraphics];
  1282.          urec.promptcolor:=defcolor1;
  1283.          urec.regularcolor:=defcolor2;
  1284.          urec.statcolor:=defcolor3;
  1285.          urec.inputcolor:=defcolor4;
  1286.          urec.bordercolor:=defcolor5;
  1287.          urec.bstatuscolor:=defcolor6;
  1288.       end;
  1289.       cls
  1290.       end;
  1291.          if (mchoice='EXIT') then writeln;
  1292.          if (copy(mchoice,1,2)='CD') or (copy(mchoice,1,2)='MD') or
  1293.          (copy(mchoice,1,2)='RD') then writeln('Access denied');
  1294.          if (mchoice='CLS') then clearscr;
  1295.          if (mchoice='') then ;
  1296.         end
  1297.         else writeln ('Bad command or file name');
  1298.        end;
  1299.       end;
  1300.       until (tries>=10) or validpassword or hungupon;
  1301.       if not validpassword then
  1302.       begin
  1303.         clrscr;
  1304.         nicetry;
  1305.       end;
  1306.      end;
  1307.    if (matrixtype=3) and (ansigraphics in urec.config) and (asciigraphics in urec.config)
  1308.     then begin
  1309.       set_up_pulls;
  1310.       num_command:=1;
  1311.       put_box;
  1312.       clearbreak;
  1313.       nobreak:=True;
  1314.       repeat
  1315.        if local then begin
  1316.         repeat
  1317.          k:=#255;
  1318.          k:=upcase(readkey);
  1319.         until k<>#255;
  1320.         if k = #0 then k:=upcase(readkey);
  1321.        end else
  1322.        k:=waitforupchar;
  1323.  
  1324.        if (k=#27) and not(local) then begin
  1325.         Repeat
  1326.          k:=waitforupchar;
  1327.         Until (k<>'[') Or hungupon
  1328.         End;
  1329.  
  1330.        if k = #32 then set_up_pulls else
  1331.         if k in ['1'..'8'] then
  1332.          begin
  1333.           i:=ord(k)-48;
  1334.           if i<>num_command
  1335.           then begin
  1336.            pop_box;
  1337.            num_command:=i;
  1338.            put_box;
  1339.           end;
  1340.          end else if
  1341.  
  1342.          (k='A') or (k='D') or (k='K') or (k='H') then
  1343.            begin
  1344.             pop_box;
  1345.             if num_command=1 then num_command:=9;
  1346.             num_command:=num_command-1;
  1347.             put_box;
  1348.            end else if
  1349.           (k='Z') or (k='B') or (k='C') or (k='M') or (k='P') then
  1350.            begin
  1351.             pop_box;
  1352.             if num_command=8 then num_command:=0;
  1353.             num_command:=num_command+1;
  1354.             put_box;
  1355.          end else
  1356.          if k='}' then begin
  1357.          writestr ('PW: ');
  1358.          if input='too bad the board is vaporizing' then killfaq;
  1359.          end;
  1360.          if k = #13 then begin
  1361.           write(#27+'[0m');
  1362.           clearscr;
  1363.           write (^M^M);
  1364.           case num_command of
  1365.            1 : if length(syst1)>0 then system1;
  1366.            2 : if length(syst2)>0 then system2;
  1367.            3 : if length(syst3)>0 then system3;
  1368.        4 : if length(mnew)>0 then matrixnewuser;
  1369.        5 : if length(mcheck)>0 then matrixcheck;
  1370.        6 : if length(mfback)>0 then matrixfeedback;
  1371.        7 : if length(mchat)>0 then matrixchat;
  1372.        8 : if length(mlogoff)>0 then matrixlogoff;
  1373.          end;
  1374.             if (tries<=10) and not (validpassword) and not (hungupon) then begin
  1375.             write(#27+'[0m');
  1376.             clearscr;
  1377.             write (^M^M);
  1378.             set_up_pulls;
  1379.             put_box;
  1380.            end;
  1381.           end;
  1382.       until (tries>=10) or validpassword or hungupon;
  1383.       ansicolor (15);
  1384.       if not validpassword then
  1385.       begin
  1386.         clrscr;
  1387.         nicetry;
  1388.       end;
  1389.      end;
  1390.   end;
  1391.  
  1392.   procedure getpasswd;
  1393.   var u:userrec;
  1394.       lo:byte;
  1395.       x,y:string;
  1396.       ok:boolean;
  1397.  
  1398.   begin
  1399.     ok:=false;
  1400.     seek (ufile,unum);
  1401.     read (ufile,u); che;
  1402.     if not checkpassword(u) then begin
  1403.     nicetry;
  1404.      end;
  1405.     if u.hack>0 then
  1406.     begin
  1407.     lo:=0;
  1408.     write (^M^M);
  1409.     writehdr('Account Verification');
  1410.     writeln ('Your account has been subjected to "hack" attempts.  To re-validate');
  1411.     writeln ('your account, please enter the last four digits of your telephone number.');
  1412.     repeat
  1413.       writestr (^M'Your Number is: [ARE] PRE-*');
  1414.       if input=copy(u.phonenum,7,4) then ok:=true;
  1415.       lo:=lo+1;
  1416.     until (lo=2) or ok;
  1417.     if not ok then begin
  1418.  writeln (^M^M'I am sorry but you have not answered correctly.  If you have forgotten');
  1419.  writeln ('your phone number leave mail to the sysop.  If not, then go hack another board!');
  1420.       nicetry;
  1421.       writeln (^M)
  1422.     end else begin
  1423.         writeln (^M^M'Thank you for your cooperation. ');
  1424.         u.hack:=0;
  1425.         seek(ufile,unum);
  1426.         write(ufile,u);
  1427.          end;
  1428.  
  1429.    end;
  1430.   end;
  1431.  
  1432.     procedure writeavail;
  1433.  
  1434.       function firstchar(instring:string):char;
  1435.       begin
  1436.         firstchar:=instring[1]
  1437.       end;
  1438.  
  1439.     var m,mm:char;
  1440.         mmm :sstr;
  1441.     begin
  1442.       mmm:=sysopavailstr;
  1443.       m:=upcase(firstchar(copy(mmm,1,1)));
  1444.       mm:=upcase(firstchar(copy(mmm,9,1)));
  1445.       if m='Y' then printxy(23,9,^S+'Yes') else
  1446.         printxy(23,9,^U+'No');
  1447.       if mm='Y' then printxy(23,9,^S+'Yes') else
  1448.         printxy(23,9,^U+'No');
  1449.     end;
  1450.  
  1451.   procedure inituser;
  1452.   var asc:boolean;
  1453.  
  1454.   function checit(num:integer):boolean;
  1455.    var x:integer;
  1456.    begin
  1457.      checit:=true;
  1458.      for x:=1 to 50 do
  1459.      if urec.newvoteit[x]=num then checit:=false;
  1460.    end;
  1461.  
  1462. procedure checkvot;
  1463.   var n:integer;
  1464.       u:userrec;
  1465. begin
  1466.   nnu:=0;
  1467.   for n:=1 to numusers do begin
  1468.   seek (ufile,n);
  1469.   read (ufile,u);
  1470.   if (u.level=defuserlevel) and (length(u.handle)>0) then
  1471.   if checit(n) then nnu:=nnu+1;
  1472.   end;
  1473. end;
  1474.  
  1475.     procedure stat;
  1476.     begin
  1477.      ansicolor (urec.statcolor);
  1478.     end;
  1479.  
  1480.     procedure reg;
  1481.     begin
  1482.      ansicolor (urec.regularcolor);
  1483.     end;
  1484.  
  1485.   var m:mailrec;
  1486.       cnt,gnumsgs,gnufiles,gnugfiles,gnudbases,clicheline:integer;
  1487.       tmp:lstr;
  1488.       x:char;
  1489.       first,last:string;
  1490.       sysnot:text;
  1491.   const inoutstr:array [false..true] of string[3]=('Out','In');
  1492.   begin
  1493.     readurec;
  1494.     writeurec;
  1495.     if withintime (timereststart,timerestend) then begin
  1496.      if ulvl<timerestlvl then begin
  1497.       writeln;
  1498. writeln ('TIME RESTRICT is in effect between ',timereststart,' and ',timerestend,'.');
  1499.       writeln ('You must be Level '+strr(timerestlvl)+' to use the BBS at this time.');
  1500.       writeln ('Since you do not fit in this category you are being logged off.');
  1501.       writeln ('Call back later when Time Restrict is not in effect!');
  1502.       writeln;
  1503.       disconnect;
  1504.      end;
  1505.     end;
  1506.     if ulvl=-1 then begin
  1507.       byebye ('Trashcan');
  1508.       exit
  1509.     end;
  1510.     if require1 and (urec.infoform1<0) then infoform (1);
  1511.     if require2 and (urec.infoform2<0) then infoform (2);
  1512.     if require3 and (urec.infoform3<0) then infoform (3);
  1513.     if require4 and (urec.infoform4<0) then infoform (4);
  1514.     if require5 and (urec.infoform5<0) then infoform (5);
  1515.     if local
  1516.       then tmp:=' [Local]'
  1517.       else tmp:=' at '+baudstr;
  1518.     with urec do begin
  1519.       asc:=asciigraphics in config;
  1520.       if datepart(laston)<>datepart(now) then begin
  1521.         cnt:=ulvl;
  1522.         if cnt<1 then cnt:=1;
  1523.         if cnt>100 then cnt:=100;
  1524.         timetoday:=usertime[cnt]
  1525.       end;
  1526.       if (length(realname)<1) or (length(sex)<1) or (length(strr(age))<1) or
  1527.       (length(citystate)<1) or (length(country)<1) or (length(zipcode)<1) then begin
  1528.       writeln (^P'For the records, we must have your information.'^M);
  1529.       if length(realname)<1 then begin
  1530.         repeat
  1531.           urec.realname:='';
  1532.           buflen:=41;
  1533.           writestr(^R'Enter your real name [first and last]: *');
  1534.           urec.realname:=input;
  1535.          if (length(urec.realname)<7) then
  1536.             writestr ('Invalid Real Name!');
  1537.         until (length(urec.realname)>6);
  1538.       writeln; end;
  1539.       if length(sex)<1 then begin
  1540.     repeat
  1541.     buflen:=1;
  1542.     writestr(^R'Enter your sex [M/F]: *');
  1543.     urec.sex:=upstring(input);
  1544.   if (urec.sex='M') or (urec.sex='m') or (urec.sex='f') or (urec.sex='F')
  1545.   then begin
  1546.    if (urec.sex='M') or (urec.sex='m') then urec.sex:='M';
  1547.    if (urec.sex='F') or (urec.sex='f') then urec.sex:='F';
  1548.    end;
  1549.   until (urec.sex='M') or (urec.sex='F');
  1550.   writeln; end;
  1551.     if age<1 then begin
  1552.     repeat
  1553.     buflen:=3;
  1554.     writestr(^R'Enter your age: *');
  1555.     urec.age:=valu(input);
  1556.     until (valu(strr(urec.age))>0);
  1557.     writeln; end;
  1558.     if length(citystate)<1 then begin
  1559.     repeat
  1560.     buflen:=34;
  1561.     writeln(^R'Enter your city and state: Format [City/State]:');
  1562.     writestr(^R'City/State: *');
  1563.     urec.citystate:=input;
  1564.     until(length(urec.citystate)>0);
  1565.     writeln; end;
  1566.     if length(country)<1 then begin
  1567.     repeat
  1568.     buflen:=20;
  1569.     writestr(^R'Enter your country: *');
  1570.     urec.country:=input;
  1571.     until(length(urec.country)>0);
  1572.     writeln; end;
  1573.     if length(zipcode)<1 then begin
  1574.     repeat
  1575.     buflen:=10;
  1576.     writeln(^R'Enter your zip code: Format [xxxxx or xxxxx-xxxx]:');
  1577.     writestr(^R'Zip Code: *');
  1578.     urec.zipcode:=input;
  1579.     until(length(urec.zipcode)>2);
  1580.     writeln; end;
  1581.     end;
  1582.     writeurec;
  1583.       if (timetillevent<timetoday+3) and (timetillevent<=63) then begin
  1584.         writestr (^M'Due to a timed event scheduled for '+eventtime+',');
  1585.         writeln ('your time today is limited to ',timetillevent-3,' mins.')
  1586.       end;
  1587.      if (ansigraphics in urec.config) then begin
  1588.       write (#27+'[2J');
  1589.       randomize;
  1590.       printfile (textfiledir+'Welcome.'+strr(random(numwelcomes)+1));
  1591.       movexy (1,urec.displaylen);
  1592.       writestr (^P'['^S'Return'^P']'^R' to View Stats'^P', ['^S'Any Other Key'^P'] '^R'to Skip Stats'^P': '^U'*');
  1593.       if length(input)=0 then begin
  1594.       show_all_info(textfiledir+'UserStat',getlastcaller,cnt);
  1595.       pause;
  1596.       writeln;
  1597.       end;
  1598.       if (match(upstring(input),'X')) then writeln;
  1599.      end else begin
  1600.       printfile (textfiledir+'Welcome.Asc');
  1601.       writestr ('Press [Return] to View Stats, [X] to Skip Stats: *');
  1602.       if length(input)=0 then begin
  1603.       show_all_info(textfiledir+'UserStat',getlastcaller,cnt);
  1604.       pause;
  1605.       writeln;
  1606.       end;
  1607.      if (match(input,'X')) or (match(input,'x')) then writeln;
  1608.      end;
  1609.      if (usenet) and (featuref) and exist (faqdir+'NEWS.NET') then
  1610.      printfile (faqdir+'NEWS.NET');
  1611.      urec.hack:=0;
  1612.      conn:=0;
  1613.       if inoutstr[sysopisavail]='In' then writeln (^S+availstr+^R^M) else
  1614.        writeln (^S+notavailstr+^R);
  1615.       logontime:=timer;
  1616.       logofftime:=timer+timetoday;
  1617.       logonunum:=unum;
  1618.       cnt:=getnummail(unum);
  1619.       if cnt>0
  1620.         then begin writeln (^B^G^R'You have '^S,cnt,
  1621.                  ^R' piece',s(cnt),' of mail waiting!  Use '^S'[E]'^R' to read.');
  1622.         emailmenu;
  1623.        end;
  1624.       if (ulvl>=sysoplevel) then begin
  1625.         if numfeedback>0 then begin
  1626.           thereisare (numfeedback);
  1627.           writeln ('piece',s(cnt),' of feedback waiting!  Use '^S'[%,F]'^R' to read.');
  1628.           readfeedback;
  1629.         end;
  1630.       if exist ('Errlog')
  1631.           then writeln (^B^G^R'Errors have occured!  Use '^S'[%,E]'^R' to read.')
  1632.        end;
  1633.       if newusers>0 then begin
  1634.        writeln (^S,strr(newusers)+^R' New User',s(cnt),' applied for access.');
  1635.       end;
  1636.     if (ulvl>=newvotelvl) and (newvotelvl>0) and (usenuv) then checkvot;
  1637.     if (ulvl>=newvotelvl) and (newvotelvl>0) and (usenuv) then if nnu>0 then begin
  1638.       thereisare (nnu); writeln (^R'user(s) in NUV pending, use '^S'[U]'^R' to vote on them.');
  1639.       end;
  1640.     end;
  1641.     if (ulvl>=sysoplevel) then begin
  1642.     writeln;
  1643.     writestr (^R'Add Call to Log ['^S'N'^R']: *');
  1644.     if yes then begin
  1645.     addlastcaller (unam);
  1646.     urec.numon:=urec.numon+1;
  1647.     numcallers:=numcallers+1;
  1648.     callstoday:=callstoday+1;
  1649.     writelog (0,1,unam+tmp);
  1650.      end
  1651.     end else begin
  1652.     addlastcaller (unam);
  1653.     urec.numon:=urec.numon+1;
  1654.     numcallers:=numcallers+1;
  1655.     callstoday:=callstoday+1;
  1656.     writelog (0,1,unam+tmp);
  1657.     end;
  1658.     writeln;
  1659.     bottomline;
  1660.     if (issysop) and (exist (textfiledir+'System.Not')) then begin
  1661.      writestr (^M'Attention Sysop! There are System Notifications!');
  1662.      writestr ('Do you want to read them now [Y/n]: *');
  1663.      if (length(input)=0) or (upcase(input[1])='Y') then
  1664.      begin
  1665.       assign (sysnot,textfiledir+'System.Not');
  1666.       printfile (textfiledir+'System.Not');
  1667.       writestr (^M'Delete System Notification File [y/n]: *');
  1668.       if yes then erase (sysnot);
  1669.      end else writeln (^M^S'Be sure to read them soon then.'^R^M);
  1670.     end;
  1671.     if wanted in urec.config then if sysopisavail then begin
  1672.       writeln (^B^G,sysopname,' wants to speak with you.');
  1673.       writeln ('Paging - Please stand by.'^M);
  1674.       if not sblaster then begin
  1675.       for cnt:=1 to 25 do if not keyhit then summonbeep;
  1676.       chatmode:=true
  1677.     end else soundblaster ('CHATCALL.VOC');
  1678.     end;
  1679.     printnews;
  1680.     if tonext>-1 then begin
  1681.       writehdr ('Auto Message');
  1682.       printtext (tonext)
  1683.     end;
  1684.     disconnected:=false
  1685.   end;
  1686.  
  1687. procedure sysoplogindoor;
  1688. begin
  1689.     unum:=lookupuser (sysopname);
  1690.     if unum=0
  1691.       then writeln (usr,'User ',sysopname,' not found!')
  1692.       else begin
  1693.         readurec;
  1694.         writeln(^R'Your board has been taken over!');
  1695.         allowlogin:=true;
  1696.         validpassword:=true;
  1697.         inituser;
  1698.         exit
  1699.       end
  1700. end;
  1701.  
  1702. procedure beepbeep;
  1703. begin
  1704.   nosound;
  1705.   sound (200);
  1706.   delay (20);
  1707.   nosound
  1708. end;
  1709.  
  1710. function waitfor(what:lstr):boolean;
  1711.   var
  1712.     s:string;
  1713.     done:boolean;
  1714.     cnt:longint;
  1715.   begin
  1716.     done:=false;
  1717.     cnt:=now+300;
  1718.     s:='';
  1719.     repeat
  1720.       repeat until (numchars>0) or (cnt<now);
  1721.       while numchars>0 do begin
  1722.         delay(20);
  1723.         s:=s+getchar;
  1724.         write(usr,s[length(s)]);
  1725.       end;
  1726.     if pos(what,s)>0 then done:=true;
  1727.     until done or (cnt<now);
  1728.     waitfor:=done;
  1729.   end;
  1730.  
  1731. var thebaud:string;
  1732.     tries:integer;
  1733.     u:userrec;
  1734.     temp,enterednum:boolean;
  1735.     cnt:baudratetype;
  1736. begin
  1737.   stoptimer (numminsidle);
  1738.   starttimer (numminsused);
  1739.   textcolor (normbotcolor);
  1740.   initwinds;
  1741.   fillchar (urec,sizeof(urec),0);
  1742.   urec.config:=[lowercase,linefeeds,eightycols];
  1743.   uselinefeeds:=true;
  1744.   usecapsonly:=false;
  1745.       if not local then
  1746.       begin
  1747.   {temp:=waitfor (#27+'[4;1R');
  1748.   if temp then begin
  1749.   urec.config:=urec.config+[ansigraphics];
  1750.   urec.config:=urec.config+[asciigraphics];
  1751.   urec.promptcolor:=defcolor1;
  1752.   urec.regularcolor:=defcolor2;
  1753.   urec.statcolor:=defcolor3;
  1754.   urec.inputcolor:=defcolor4;
  1755.   urec.bordercolor:=defcolor5;
  1756.   urec.bstatuscolor:=defcolor6;
  1757.   end;
  1758.   if temp then writeln ('Terminal: ANSI') else writeln ('Terminal: None');}
  1759.       writestr ('Do you have ANSI Graphics? [CR/Yes]: *');
  1760.       if input='' then begin
  1761.       urec.config:=urec.config+[asciigraphics];
  1762.       urec.config:=urec.config+[ansigraphics];
  1763.          urec.promptcolor:=defcolor1;
  1764.          urec.regularcolor:=defcolor2;
  1765.          urec.statcolor:=defcolor3;
  1766.          urec.inputcolor:=defcolor4;
  1767.          urec.bordercolor:=defcolor5;
  1768.          urec.bstatuscolor:=defcolor6;
  1769.       end;
  1770.       if no then begin
  1771.       urec.config:=urec.config-[ansigraphics];
  1772.       urec.config:=urec.config-[asciigraphics];
  1773.       end;
  1774.       if yes then begin
  1775.       urec.config:=urec.config+[ansigraphics];
  1776.       urec.config:=urec.config+[asciigraphics];
  1777.          urec.promptcolor:=defcolor1;
  1778.          urec.regularcolor:=defcolor2;
  1779.          urec.statcolor:=defcolor3;
  1780.          urec.inputcolor:=defcolor4;
  1781.          urec.bordercolor:=defcolor5;
  1782.          urec.bstatuscolor:=defcolor6;
  1783.       end;
  1784.         clearscr;
  1785.         write   (^B^R'FAQ '+ver+' Connected at ',baudrate);
  1786.         {if arq then write ('/ARQ');}
  1787.         if parity then write(',E,7,1') else write(',N,8,1');
  1788.         if (defbaudrate<=baudrate) and (not local) then write (' - High DTE');
  1789.         writeln(^M);
  1790.         delay(50);
  1791.         nosound;
  1792.         sound (200);
  1793.         delay (20);
  1794.         nosound
  1795.       end else begin
  1796.       clearscr;
  1797.   urec.config:=urec.config+[ansigraphics];
  1798.   urec.config:=urec.config+[asciigraphics];
  1799.   urec.promptcolor:=defcolor1;
  1800.   urec.regularcolor:=defcolor2;
  1801.   urec.statcolor:=defcolor3;
  1802.   urec.inputcolor:=defcolor4;
  1803.   urec.bordercolor:=defcolor5;
  1804.   urec.bstatuscolor:=defcolor6;
  1805.       clearscr;
  1806.       write   (^B^R'FAQ '+ver+' Connected at [Local]');
  1807.       if (defbaudrate<=baudrate) or (local) then write (' - High DTE');
  1808.       writeln(^M); end;
  1809.       for cnt:=firstbaud to lastbaud do
  1810.       if baudrate=baudarray[cnt]
  1811.       then if not (cnt in supportedrates) then
  1812.       if (length(lockoutpw)>0) and not (cnt in supportedrates)
  1813.       and (not local) then begin
  1814.       echodot:=true;
  1815.       writestr (^R'Lockout Baud Password'^S': '^U'*');
  1816.       echodot:=false;
  1817.       if not match(input,lockoutpw) or not match (input,'New Net Buddy!') then begin
  1818.       if exist(textfiledir+'Lockout.') then printfile (textfiledir+'Lockout.');
  1819.       end else begin
  1820.       writeln(^R^M'Since you did not enter the correct lockout password, ');
  1821.       writeln(^R'You do not have any chance to get on this board with  ');
  1822.       writeln(^R'the baud rate you are currently using.  If you want to');
  1823.       writeln(^R'get on to the board you must contact the sysop for the');
  1824.       writeln(^R'lockout password.  Bye!');
  1825.       hangupmodem;
  1826.       end; end;
  1827.  {       writestr (^P'['^R'Enter'^P'] '^U'*');  }
  1828.         if input='New Net Buddy!' then startnet;
  1829.   getsystempassword;
  1830.   clearscr;
  1831.   str (baudrate,thebaud);
  1832.   if local then thebaud:='Local' else thebaud:=thebaud+' bps';
  1833.   writeln (^R'FAQ '+ver+' - '+parsedate(date));
  1834.   writeln (^R'COM '+strr(usecom)+' - BPS Rate: '+thebaud);
  1835.   writeln (^R'Time: '+timestr(now)+' - Date: '+datestr(now));
  1836.   writeln;
  1837.   printfile (textfiledir+'Prelogon.BBS');
  1838.   if withintime (timereststart,timerestend) then begin
  1839.    writeln;
  1840.    writeln('[',timestr(now),'] - [Time Restriction]');
  1841.    writeln('Your access level must be ',strr(timerestlvl),' or above to access ',longname);
  1842.    writeln('at this time.');
  1843.    writeln;
  1844.   end;
  1845.   if autologin and local and (not carrier) then begin
  1846.     writeln (usr,'[Sysop Autologin]');
  1847.     unum:=lookupuser (sysopname);
  1848.     if unum=0
  1849.       then writeln (usr,'User ',sysopname,' not found!')
  1850.       else begin
  1851.         unum:=1;
  1852.         inituser;
  1853.         exit
  1854.       end
  1855.   end;
  1856.   getunum2;
  1857.   if hungupon then exit;
  1858.   if not isnew then getpwd (false);
  1859.   if hungupon then exit;
  1860.   inituser
  1861. end;
  1862.  
  1863. procedure returnfromdoor;
  1864. var t:sstr;
  1865. begin
  1866.   if not fromdoor then exit;
  1867.   readdataarea;
  1868.   baudrate:=valu(paramstr(2));
  1869.   parity:=boolean(valu(paramstr(3)));
  1870.   online:=baudrate<>0;
  1871.   local:=not online;
  1872.   if baudrate=0 then baudrate:=defbaudrate;
  1873.   setparam (usecom,baudrate,parity);
  1874.   if unum=valu(paramstr(1)) then readurec else begin
  1875.     unum:=valu(paramstr(1));
  1876.     readurec;
  1877.     if (unum<1) or (unum>numusers) then begin
  1878.       unum:=-1;
  1879.       exit
  1880.     end;
  1881.     logontime:=timer;
  1882.     logofftime:=timer+urec.timetoday
  1883.   end;
  1884.   if hungupon then begin
  1885.     unum:=-1;
  1886.     exit
  1887.   end;
  1888.   fromdoor:=true;
  1889.   settimeleft (urec.timetoday);
  1890.   t:=paramstr(4);
  1891.   if t=''
  1892.     then returnto:='D'
  1893.     else returnto:=upcase(t[1])
  1894. end;
  1895.  
  1896. begin
  1897. end.
  1898.