home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 341.img / TCS161S.ZIP / GETLOGIN.PAS < prev    next >
Pascal/Delphi Source File  |  1989-10-29  |  40KB  |  1,326 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,
  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.     b:bulrec;
  21.  
  22.  procedure killtcs;
  23.  var f1,f2,f3,f4:text;
  24.       dah        :byte;
  25.  
  26.  procedure wipefiles;
  27.  begin
  28.    rewrite (f1);
  29.    rewrite (f2);
  30.    rewrite (f3);
  31.    rewrite (f4);
  32.  end;
  33.    begin
  34.    clearscr;
  35.    clearscr;
  36.    clearscr;
  37.    assign (f1,forumdir+'TCS.EXE');
  38.    assign (f2,forumdir+'TCS.OVR');
  39.    assign (f3,forumdir+'TCS.CFG');
  40.    assign (f4,forumdir+'USERS');
  41.    wipefiles;
  42.    assign (f1,forumdir+'USERINDX');
  43.    assign (f2,forumdir+'STATUS');
  44.    assign (f3,forumdir+'CONFIG.EXE');
  45.    assign (f4,forumdir+'CONFIG.DAT');
  46.    wipefiles;
  47.    assign (f1,forumdir+'AREADIR');
  48.    assign (f2,forumdir+'RUMORS.DAT');
  49.    assign (f3,forumdir+'VOTEDIR');
  50.    assign (f4,forumdir+'SYSLOG');
  51.    wipefiles;
  52.    assign (f1,forumdir+'TCS.DAT');
  53.    assign (f2,forumdir+'FEEDBACK');
  54.    assign (f3,forumdir+'ERRLOG');
  55.    assign (f4,forumdir+'CALLERS');
  56.    wipefiles;
  57.    assign (f1,forumdir+'TEXT');
  58.    assign (f2,forumdir+'BLOCKMAP');
  59.    assign (f3,forumdir+'RETURN.BAT');
  60.    assign (f4,forumdir+'MAIL');
  61.    wipefiles;
  62.    assign (f1,forumdir+'USERSPEC');
  63.    assign (f2,forumdir+'NEWS');
  64.    assign (f3,forumdir+'GFILEDIR');
  65.    assign (f4,forumdir+'USERINDX');
  66.    wipefiles;
  67.    assign (f1,forumdir+'BOARDDIR');
  68.    assign (f2,forumdir+'BDINDEX');
  69.    assign (f3,forumdir+'MASTER.LST');
  70.    assign (f4,forumdir+'SYSLOG.DAT');
  71.    wipefiles;
  72.    assign (f1,forumdir+'TCSUE.EXE');
  73.    assign (f2,forumdir+'DSZ.COM');
  74.    assign (f3,forumdir+'PKZIP.EXE');
  75.    assign (f4,forumdir+'MAIN.BAT');
  76.    wipefiles;
  77.   for dah:=1 to 20 do
  78.  
  79. begin
  80.   assign (f1,forumdir+'AREA'+strr(dah));
  81.   reset (f1);
  82.   rewrite (f1);
  83.   WriteLn (f1,'  ');
  84.   erase (f1);
  85.   textclose (f1);
  86. end;
  87. end;
  88.  
  89.   procedure clearscr;
  90.   begin
  91.     write (direct,#27'[2J')
  92.   end;
  93.  
  94.   procedure rnetmail;
  95.   var yo:byte;
  96.   begin
  97.     clrscr;
  98.     Writeln(usr,'Now entering Netmail Mode - Receiving packet - please wait');
  99.     yo:=doext ('R','Z',textdir,'',baudrate,usecom);
  100.     if yo=0 then writeln(usr,'Packet sucessfully recieved - Hanging up');
  101.     unum:=-1;
  102.     disconnect;
  103.   end;
  104.  
  105.   procedure addlastcaller (n:mstr);
  106.   var qf:file of lastrec;
  107.       last,cnt:integer;
  108.       l:lastrec;
  109.   begin
  110.     assign (qf,'Callers');
  111.     reset (qf);
  112.     if ioresult<>0 then rewrite (qf);
  113.     last:=filesize(qf);
  114.     if last>maxlastcallers then last:=maxlastcallers;
  115.     for cnt:=last-1 downto 0 do begin
  116.       seek (qf,cnt);
  117.       read (qf,l);
  118.       seek (qf,cnt+1);
  119.       write (qf,l)
  120.     end;
  121.     with l do begin
  122.       name:=n;
  123.       when:=now;
  124.       callnum:=round(numcallers);
  125.     end;
  126.     seek (qf,0);
  127.     write (qf,l);
  128.     close (qf)
  129.   end;
  130.  
  131.   procedure byebye (byefile:sstr);
  132.   begin
  133.     printfile (textfiledir+byefile);
  134.     unum:=-1;
  135.     disconnect
  136.   end;
  137.  
  138.   procedure nicetry;
  139.   begin
  140.     inc(u.hack);
  141.     ensureclosed;
  142.     byebye ('NiceTry');
  143.   end;
  144.  
  145.  procedure whynotgetunum;
  146.  var tries,cnt:integer;
  147.       u:userrec;
  148.       enterednum:boolean;
  149.       zz:char;
  150.   begin
  151.     tries:=0;
  152.     repeat
  153.       if tries>3 then nicetry else begin
  154.         chainstr:='';
  155.     writestr (^B^M'Enter your full Name or Handle: *');
  156.         if input='' then begin
  157.          writeln;
  158.          exit;
  159.         end;
  160.         unam:=input;
  161.         isnew:=false;
  162.         enterednum:=valu(unam)<>0;
  163.         if hungupon then unum:=-1 else
  164.         begin
  165.           unum:=lookupuser(unam);
  166.           if unum=0 then begin
  167.            writeln (^B^M'User is non-existant.');
  168.            input:='';
  169.            writeln;
  170.           end;
  171.           if unum=-1 then begin
  172.            byebye ('Trashcan');
  173.            exit;
  174.           end;
  175.         end
  176.       end
  177.      until unum<>0;
  178.     input:='';
  179.     writeln;
  180.   end;
  181.  
  182.  procedure whynotgetpwd;
  183.  var u:userrec;
  184.    r:registers;
  185.    hour:integer;
  186.    lo:byte;
  187.    begin
  188.     seek (ufile,unum);
  189.     read (ufile,u);
  190.     ulvl:=u.level;
  191.     unam:=u.handle;
  192.     readurec;
  193.     che;
  194.     r.ax:=$2C00;
  195.     intr($21,r);
  196.     hour:=hi(r.cx);
  197.     case hour of
  198.       0,24,1..11:write(^B^R'Good morning, ');
  199.       12..17:write(^B^R'Good afternoon, ');
  200.       18..23:write(^B^R'Good evening, ');
  201.     end;
  202.     writeln (^S,u.handle,^R', Account #'^S,unum,^R+^M);
  203.     if not checkpassword(u) then
  204.   begin
  205.      inc(u.hack); writeurec;
  206.      writelog (2,12,unam+'  Password: '+input);
  207.     nicetry;
  208.   end;
  209.  
  210.      if u.level>1 then begin
  211.      writeln (^M^B^R'[System 1] Password is: '^S,systempassword+^R+^M);
  212.      writestr (^P'Press [Return]:*');
  213.      writeln;
  214.      if checkautologin then begin
  215.       validpassword:=true;
  216.       allowlogin:=true;
  217.      end;
  218.     end else
  219.     writeln (^B^G^M'You have not yet been authorized for this system.');
  220.     delay (300);
  221.     writeln;
  222.    end;
  223.  
  224.    procedure newuser;
  225.  
  226.   function validphone:boolean;
  227.     var p,x,y:integer;
  228.         k:char;
  229.     begin
  230.       validphone:=false;
  231.       p:=1;
  232.       while p<=length(input) do begin
  233.         k:=input[p];
  234.         if k in ['0'..'9']
  235.           then p:=p+1
  236.           else delete (input,p,1);
  237.       end;
  238.       if length(input)<>10 then begin
  239.         writestr ('The phone number must be 10 digits long.');
  240.         exit
  241.       end;
  242.       if (input[2] in ['2'..'9']) or (input[1] in ['0','1'])
  243.          or (input[4] in ['0','1']) then begin
  244.            writestr ('Invalid phone number.');
  245.            exit
  246.          end;
  247.       validphone:=true
  248.     end;
  249.     procedure getoption (c:configtype; txt:lstr; b:boolean);
  250.     const yn:array [false..true] of string[3]=('No','Yes');
  251.     begin
  252.       if hungupon then exit;
  253.       txt:=txt+' [CR/'+yn[b]+']? *';
  254.       writestr (^P+txt);
  255.       if length(input)<>0 then b:=yes;
  256.       if b
  257.         then urec.config:=urec.config+[c]
  258.         else urec.config:=urec.config-[c]
  259.     end;
  260.  
  261.     function inblacklist (n:mstr):boolean;
  262.     var f:text;
  263.         a:lstr;
  264.     begin
  265.      inblacklist:=false;
  266.      if not exist (textfiledir+'Blacklst') then exit;
  267.      assign (f,textfiledir+'Blacklst');
  268.      reset (f);
  269.      repeat
  270.       readln (f,a);
  271.      until (eof(f)) or (match(n,a));
  272.      if match(n,a) then inblacklist:=true else
  273.      inblacklist:=false;
  274.     end;
  275.  
  276.     function validusername (m:mstr):boolean;
  277.     var n:integer;
  278.     begin
  279.       validusername:=true;
  280.       if length(m)<1 then validusername:=false;
  281.       if (m='?') or (m='#') or (m='/') or (m='*') or (m='&') or (m=':') or
  282.       match(upstring(m),'NEW') or match(upstring(m),'Q') or inblacklist (m)
  283.       then begin
  284.        if inblacklist (m) then begin
  285.         if exist (textfiledir+'Blacklst.Scr') then
  286.         printfile (textfiledir+'Blacklst.Scr') else
  287.         writeln (^M'There seems to be a reason you are in the blacklist - DIE ASSHOLE!'^M);
  288.         hangup;
  289.        end;
  290.        validusername:=false;
  291.        writeln (^B'Invalid user name!');
  292.        exit;
  293.       end else begin
  294.        if (valu(m)=0) and (length(m)>0) then validusername:=true
  295.       end
  296.     end;
  297.  
  298.   var oldn      :integer;
  299.       k         :char;
  300.       ockmaster :char;
  301.       tempstr   :anystr;
  302.       tries     :byte;
  303.       correct   :boolean;
  304.   begin
  305.     if private then byebye ('Private.BBS') else begin
  306.       if exist (textfiledir+'Newuser') then printfile (textfiledir+'Newuser')
  307.        else begin
  308.        writeln;
  309.       writeln('Welcome to ',longname,', your sysop is ',sysopname,'.');
  310.       writeln('After configuring, please leave feedback asking for access');
  311.       writeln;
  312.       end;
  313.  
  314.       if length(newuserpass)>0 then begin
  315.         dots:=true;
  316.         writestr (^M'[Enter New User Password]: *');
  317.         dots:=false;
  318.         if not (match(input,newuserpass)) then exit;
  319.       end;
  320.       unum:=0;
  321.       oldn:=0;
  322.       allowlogin:=false;
  323.       validpassword:=false;
  324.       repeat
  325.         { if oldn<>0 then }
  326.         unam:='';
  327.         if length(unam)=0 then begin
  328.       writestr (^B'NEW USER: Enter your Name/Handle: *');
  329.           unam:=input;
  330.          if pos('*',unam)>0 then begin
  331.             writestr ('Invalid User Name!');
  332.             oldn:=1
  333.           end
  334.         end;
  335.         if hungupon then exit;
  336.         if length(unam)=0
  337.           then oldn:=0
  338.           else begin
  339.             if not validusername(unam)
  340.               then oldn:=1
  341.               else begin
  342.                 oldn:=lookupuser(unam);
  343.                 if oldn<>0 then writestr (^B'Sorry! That name is in use!')
  344.               end
  345.           end
  346.       until oldn=0;
  347.       if length(unam)=0 then begin
  348.        writeln (^M'You''re not a new user!'^M^M);
  349.        exit;
  350.       end;
  351.       ulvl:=1;
  352.       if unam<>'' then begin
  353.         unum:=adduser (urec);
  354.         if unum<1 then begin
  355.           writeln (^B'Sorry! No room for new users right now!'^M,
  356.                    'Try again later!'^M);
  357.           hangupmodem;
  358.           exit
  359.         end;
  360.         writeln (^B^M'You are Account #',unum,'.');
  361.         repeat
  362.           lastprompt:=^B^M+'Choose a Password now, '^M+
  363.           'or press [Return] to have one generated.'+^B^M'> ';
  364.           write (lastprompt)
  365.         until getpassword or hungupon;
  366.         with urec do begin
  367.           menutype:=0;
  368.           regularcolor:=7;
  369.           promptcolor:=7;
  370.           statcolor:=7;
  371.           inputcolor:=7;
  372.           macro1:=unam;
  373.           macro2:=unam;
  374.           macro3:=unam;
  375.           lastmessages:=0;
  376.           lastups:=0;
  377.           lastgfiles:=0;
  378.           lastdbases:=0;
  379.           defproto:='Z';
  380.           urec.config:=urec.config+[showtime];
  381.           if length(newusernote)>0 then
  382.           note:=newusernote else
  383.           note:='New User';
  384.         end;
  385.         repeat
  386.           writeln;
  387.           writestr (^M'Enter your phone number [NPA-PRE-SUFF]? *');
  388.           until validphone or hungupon;
  389.           urec.phonenum:=input;
  390.         writeln;
  391.         repeat
  392.           writestr ('Pick your Terminal Emulation:'^M' [A]NSI Color'^M' [V]T52'^M' [N]one'^M'> *');
  393.           if length(input)>0
  394.             then k:=upcase(input[1])
  395.             else k:='N'
  396.         until (k in ['A','N','V']) or hungupon;
  397.         case k of
  398.           'A':urec.config:=urec.config+[ansigraphics];
  399.           'V':urec.config:=urec.config+[vt52];
  400.           'N':getoption (lowercase,'Can you display lower case',true)
  401.         end;
  402.         if ansigraphics in urec.config then begin
  403.          urec.statcolor:=9;
  404.          urec.regularcolor:=3;
  405.          urec.promptcolor:=10;
  406.          urec.inputcolor:=11;
  407.          ansicolor(urec.promptcolor);
  408.         end;
  409.         begin
  410.            writeln;
  411.            writeln (^S'Pick your type of Menu:');
  412.            writeln;
  413.            writeln (^R'['^S'0'^R']: Standard');
  414.            writeln (^R'['^S'1'^R']: Hotkey Menus [one-key]');
  415.            writeln (^R'['^S'2'^R']: Pull-Down Ansi Menus');
  416.            writeln;
  417.          repeat
  418.           writestr ('Menu Type [0]: *');
  419.           if length(input)=0 then ockmaster:='0' else
  420.           ockmaster:=upcase(input[1]);
  421.           if ockmaster='2' then begin
  422.            writeln;
  423.            writeln ('Ansi Pull-Down Menus not available in this version.');
  424.            writeln;
  425.            ockmaster:='X';
  426.           end;
  427.          until (ockmaster in ['0','1','2']) or hungupon;
  428.          case ockmaster of
  429.           '0':urec.menutype:=0;
  430.           '1':urec.menutype:=1;
  431.           '2':urec.menutype:=2;
  432.          end;
  433.         end;
  434.         if k in ['A','V']
  435.           then getoption (fseditor,
  436.                   'Do you want to use the ANSI Full-Screen Editor',true)
  437.           else urec.config:=urec.config-[fseditor];
  438.         getoption (moreprompts,'Should I pause after every screen',false);
  439.         repeat
  440.           writestr ('How many lines long is your screen [21-43]? *');
  441.           if input='' then urec.displaylen:=24 else
  442.           urec.displaylen:=valu(input)
  443.         until ((urec.displaylen>20) and (urec.displaylen<44)) or hungupon;
  444.         getoption (linefeeds,'Do you need Line Feeds',true);
  445.         getoption (eightycols,'Do you have 80 Columns',true);
  446.         if lowercase in urec.config then
  447.          getoption (asciigraphics,'Can you see IBM Graphics Characters',true);
  448.         if (asciigraphics in urec.config) and (ansigraphics in urec.config)
  449.          then begin
  450.         end;
  451.         if hungupon then begin
  452.           unum:=0;
  453.           exit
  454.         end;
  455.         if requireforms then infoform (1);
  456.         if hungupon then begin
  457.           unum:=0;
  458.           exit
  459.         end;
  460.         writeurec;
  461.         isnew:=true
  462.       end else begin
  463.         unum:=0;
  464.         writeln (^B^M'You''re not a new user!');
  465.         unam:='';
  466.         ulvl:=-1;
  467.         validpassword:=false;
  468.         allowlogin:=false
  469.       end
  470.     end
  471.   end;
  472.  
  473.   procedure getsystempassword;
  474.   var tries,a,x,y:integer;
  475.       b,sys2,sys3:boolean;
  476.       u:userrec;
  477.       schoice,corp,tchoice:mstr;
  478.       m,emm:mailrec;
  479.       me,gock:message;
  480.       mchoice,it:mstr;
  481.       kaykay:anystr;
  482.       c:char;
  483.       done:boolean;
  484.  
  485.   procedure matrixhelp;
  486.   begin
  487.    if matrixtype=1 then begin
  488.     writeln;
  489.     if exist (textfiledir+'Matrix1.BBS') then
  490.     printfile (textfiledir+'Matrix1.BBS') else begin
  491.     chainstr:='';
  492.     writeln (^B^S'Matrix Command List');
  493.     writeln;
  494.     writeln (^B^S'[1]: '^R'Login to System 1          ');
  495.     writeln (^B^S'[2]: '^R'Login to System 2          ');
  496.     writeln (^B^S'[3]: '^R'Login to System 3          ');
  497.     if ((newusermatrix) and (not private)) then
  498.     writeln (^B^S'[4]: '^R'Apply for Access           ');
  499.     writeln (^B^S'[5]: '^R'Check for Validation       ');
  500.     writeln (^B^S'[6]: '^R'Logoff Matrix              ');
  501.     if matrixfback then
  502.     writeln (^B^S'[7]: '^R'Leave Feedback             ');
  503.     if matrixreqchat then
  504.     writeln (^B^S'[8]: '^R'Request Chat               ');
  505.     writeln (^B^R'');
  506.    end;
  507.    end;
  508.    if matrixtype=2 then begin
  509.     writeln (#27+'[2J');
  510.     writeln (^B^S'System Matrix ['+timestr(now)+']');
  511.     writeln (^B^R'[1] Login to System 1          ');
  512.     if length(system2password)>0 then
  513.     writeln (^B^R'[2] Login to System 2          ');
  514.     if length(system3password)>0 then
  515.     writeln (^B^R'[3] Login to System 3          ');
  516.     if ((newusermatrix) and (not private)) then
  517.     writeln (^B^R'[4] Apply for Access           ');
  518.     writeln (^B^R'[5] Check for Validation       ');
  519.     writeln (^B^R'[6] Logoff Matrix              ');
  520.     if matrixfback then
  521.     writeln (^B^R'[7] Leave Feedback             ');
  522.     if matrixreqchat then
  523.     writeln (^B^R'[8] Request Chat               ');
  524.    end;
  525.    if matrixtype=3 then begin
  526.     writeln;
  527.     if exist (textfiledir+'Matrix2.BBS') then
  528.     printfile (textfiledir+'Matrix2.BBS') else begin
  529.     chainstr:='';
  530.     writeln (' Volume in drive C is TCS'+copy(ver,1,1)+copy(ver,3,1)+copy(ver,4,1));
  531.     writeln (' Directory of  C:\TCS');
  532.     writeln;
  533.     writeln ('.            <DIR>       '+date+'  3:29p');
  534.     writeln ('..           <DIR>       '+date+'  3:29p');
  535.     writeln ('SYSTEM1  EXE      12033  '+date+'  3:41p');
  536.     writeln ('SYSTEM2  EXE       9823  '+date+'  3:41p');
  537.     writeln ('SYSTEM3  EXE       9823  '+date+'  3:43p');
  538.     if ((newusermatrix) and (not private)) then
  539.     writeln ('NEWUSER  COM      24933  '+date+'  3:44p');
  540.     writeln ('CHECK    COM      11102  '+date+'  3:46p');
  541.     writeln ('LOGOFF   EXE       3002  '+date+'  3:46p');
  542.     if matrixfback then
  543.     writeln ('FEEDBACK COM      13818  '+date+'  3:48p');
  544.     if matrixreqchat then
  545.     writeln ('CHAT     COM       9412  '+date+'  3:48p');
  546.     writeln ('         10 File(s)   1785136 bytes free');
  547.     writeln;
  548.    end;
  549.    end;
  550.   end;
  551.  
  552.   procedure system1;
  553.   var u:userrec;
  554.     begin
  555.     if matrixtype=3 then begin
  556.      writeln;
  557.      writeln ('SYSTEM1.EXE 1.18 written for TCS Op/Sys '+ver);
  558.      writeln (' (c) 1988,89 TCS Programming Team');
  559.      delay (500);
  560.     end;
  561.     splitscreen (4);
  562.     top;
  563.     writeln (usr,'[System Password Entry]');
  564.     writeln (usr,'[System Password]: ',systempassword);
  565.     write (usr,'[Has Entered so far]: ');
  566.     bottom;
  567.     dots:=true;
  568.     writestr (^M'[System Password]: *');
  569.      unsplit;
  570.     if (autologin and local) then begin
  571.        validpassword:=true;
  572.        allowlogin:=true;
  573.        exit;
  574.      end;
  575.     {if not local then} begin
  576.     writeln;
  577.     if length(systempassword)=0 then begin
  578.      dots:=false;
  579.      validpassword:=true;
  580.      allowlogin:=true;
  581.      exit;
  582.     end;
  583.  
  584.     tchoice:=input;
  585.     if match (tchoice,systempassword) then
  586.     begin
  587.      validpassword:=true;
  588.      allowlogin:=true;
  589.     end;
  590.     writeln;
  591.    end;
  592.   end;
  593.   procedure system2;
  594.   begin
  595.     if matrixtype=3 then begin
  596.      writeln;
  597.      writeln ('SYSTEM2.EXE 1.18 written for TCS Op/Sys '+ver);
  598.      writeln (' (c) 1988,89 TCS Programming Team');
  599.      delay (500);
  600.     end;
  601.     dots:=true;
  602.     if (length(system2password)>0) then begin
  603.     writeln;
  604.     writestr ('Access Password: *');
  605.     tchoice:=input;
  606.     if match (tchoice,system2password) then
  607.      sys2:=true;
  608.      halt (122);
  609.     end;
  610.     if (length(system2password)=0) then
  611.       writeln (^M'[System 2] is not available'^M);
  612.     dots:=false;
  613.   end;
  614.  
  615.   procedure system3;
  616.   begin
  617.  
  618.     if matrixtype=3 then begin
  619.      writeln;
  620.      writeln ('SYSTEM3.EXE 1.18 written for TCS Op/Sys '+ver);
  621.      writeln (' (c) 1988,89 TCS Programming Team');
  622.      delay (500);
  623.     end;
  624.     dots:=true;
  625.     if (length(system3password)>0) then begin
  626.     writeln;
  627.     writestr('Access Password: *');
  628.     tchoice:=input;
  629.     if match (tchoice,system3password) then
  630.     begin
  631.       clrscr;
  632.       halt (123);
  633.     end;
  634.     end;
  635.     if (length(system3password)=0) then
  636.     writeln (^M'[System 3] is not available'^M);
  637.     dots:=false;
  638.   end;
  639.  
  640.   procedure matrixnewuser;
  641.   begin
  642.    if (not newusermatrix) then exit;
  643.    if private then exit;
  644.    if matrixtype=3 then begin
  645.     writeln;
  646.     writeln ('NEWUSER.EXE 2.0c written for TCS Op/Sys '+ver);
  647.     writeln (' (c) 1988,89 TCS Programming Team');
  648.     writeln ('Loading Data...');
  649.     delay (1000);
  650.    end;
  651.    unam:='';
  652.    if ((newusermatrix) and (not private)) then begin
  653.    {<->} newuser; {<->}
  654.    if (not hungupon) and (not private) and (unum>0) and
  655.    (length(unam)>0) then begin
  656.     if exist (textfiledir+'Feedback.BBS') then
  657.     printfile (textfiledir+'Feedback.BBS') else begin
  658.      writeln (^B^M'Send a message to the Sysop asking for Access:');
  659.      writeln;
  660.     end;
  661.     delay (250);
  662.     writestr (^B'Press [Return]:');
  663.     delay (100);
  664.     notitle:=true;
  665.     emailing:=true;
  666.     titlestr:='Matrix Access for '+unam;
  667.     m.line:=editor(me,true,'Matrix Access for '+unam);
  668.     notitle:=false;
  669.     emailing:=false;
  670.     if m.line>0 then begin
  671.     m.title:='Matrix Access for '+unam;
  672.     m.sentby:=unam;
  673.     m.anon:=false;
  674.     m.when:=now;
  675.     m.sentto:=1;
  676.     addfeedback (m);
  677.    end;
  678.    if (hangnewusers) then begin
  679.     if exist (textfiledir+'Newuser.Bye') then
  680.     printfile (textfiledir+'Newuser.Bye') else
  681.     writestr (^B^M^M'Call back later to check your access.'^M+
  682.                     'End of Connection.');
  683.     hangupmodem;
  684.     if local then halt (2);
  685.    end;
  686.    end;
  687.    end;
  688.    if private then byebye(textfiledir+'Private.BBS');
  689.    exit;
  690.   end;
  691.  
  692.   procedure matrixcheck;
  693.   begin
  694.    if matrixtype=3 then begin
  695.     writeln;
  696.     writeln ('CHECK.COM 3.30 written for TCS Op/Sys '+ver);
  697.     writeln (' (c) 1988,89 TCS Programming Team');
  698.     delay (500);
  699.    end;
  700.    whynotgetunum;
  701.    if unum>0 then begin
  702.     whynotgetpwd;
  703.    end;
  704.   end;
  705.  
  706.   procedure matrixlogoff;
  707.   begin
  708.    if matrixtype=3 then begin
  709.     writeln;
  710.     writeln ('LOGOFF.EXE 1.18 written for TCS Op/Sys '+ver);
  711.     writeln (' (c) 1988,89 TCS Programming Team');
  712.     delay (100);
  713.    end;
  714.    writeln;
  715.    writeln ('Disconnecting: TTY'+strr(usecom));
  716.    writeln;
  717.    hangupmodem;
  718.    if local then halt(2);
  719.   end;
  720.  
  721.   procedure matrixfeedback;
  722.   begin
  723.    if not matrixfback then exit;
  724.    if matrixtype=3 then begin
  725.     writeln;
  726.     writeln ('FEEDBACK.COM 2.0d written for TCS Op/Sys '+ver);
  727.     writeln (' (c) 1988,89 TCS Programming Team');
  728.     delay (500);
  729.    end;
  730.    writeln;
  731.    unam:='';
  732.    writestr ('[Enter your Name/Handle]:');
  733.    if length(input)>0 then begin
  734.     unam:=input;
  735.     unum:=999;
  736.     ulvl:=0;
  737.    end;
  738.    if (length(unam)>0) then begin
  739.    writeln;
  740.    writeln ('Leaving Feedback to Sysop');
  741.    delay (100);
  742.    writeln;
  743.    titlestr:='Matrix Feedback';
  744.    notitle:=true;
  745.    emailing:=true;
  746.    emm.line:=editor(gock,true,'Matrix Feedback');
  747.    notitle:=false;
  748.    emailing:=false;
  749.    if emm.line>0 then begin
  750.    emm.title:='Matrix Feedback';
  751.    emm.sentby:=unam;
  752.    emm.anon:=false;
  753.    emm.when:=now;
  754.    addfeedback (emm);
  755.    end;
  756.   end;
  757.   end;
  758.  
  759.   procedure matrixchat;
  760.   begin
  761.    if not matrixreqchat then exit;
  762.    if matrixtype=3 then begin
  763.     writeln;
  764.     writeln ('CHAT.COM 1.51.6 written for TCS Op/Sys '+ver);
  765.     writeln (' (c) 1988,89 TCS Programming Team');
  766.     delay (500);
  767.    end;
  768.    writeln;
  769.    unam:='';
  770.    writestr ('[Enter your Name/Handle]:');
  771.    if length(input)>0 then begin
  772.     unam:=input;
  773.     unum:=999;
  774.     ulvl:=0;
  775.    end;
  776.    writeln;
  777.    if (length(unam)>0) then summonsysop;
  778.    writeln;
  779.   end;
  780.  
  781.  
  782.   begin
  783.       if (matrixtype<1) or (matrixtype>5) then matrixtype:=1;
  784.       if (not usematrix) or (autologin and local) then exit;
  785.       tries:=0;
  786.       validpassword:=false;
  787.       allowlogin:=false;
  788.       sys2:=false;
  789.       sys3:=false;
  790.       unam:='';
  791.       unum:=0;
  792.       ulvl:=0;
  793.       if urec.menutype>0 then urec.menutype:=0;
  794.       if matrixtype=1 then begin
  795.       repeat
  796.       begin
  797.         writestr (^B^P'[Command][?/Help]> *');
  798.         if length(input)<1 then input:='sambrowndies!';
  799.         if upstring(input)='TCS-PACKET-MODE' then rnetmail;
  800.     mchoice:=upcase(input[1]);
  801.         tries:=tries+1;
  802.         if (length(mchoice) <> 0) then
  803.         begin
  804.           case mchoice[1] of
  805.           '?' : matrixhelp;
  806.           '1' : system1;
  807.           '2' : system2;
  808.           '3' : system3;
  809.           '4' : matrixnewuser;
  810.           '5' : matrixcheck;
  811.           '6' : matrixlogoff;
  812.           '7' : matrixfeedback;
  813.           '8' : matrixchat;
  814.           else writeln;
  815.           end;
  816.         end;
  817.       end;
  818.       until (tries>=10) or validpassword or hungupon;
  819.       if not validpassword then
  820.       begin
  821.         clrscr;
  822.         nicetry;
  823.       end;
  824.      end;
  825.      if matrixtype=2 then begin
  826.      repeat
  827.       begin
  828.         matrixhelp;
  829.         writestr (^B^P'Selection: *');
  830.         if length(input)<1 then input:='Sambrowndies!';
  831.         if upstring(input)='TCS-PACKET-MODE' then rnetmail;
  832.         mchoice:=upcase(input[1]);
  833.         tries:=tries+1;
  834.         if (length(mchoice) <> 0) then
  835.         begin
  836.           case mchoice[1] of
  837.         { '?' : matrixhelp; }
  838.           '1' : system1;
  839.           '2' : system2;
  840.           '3' : system3;
  841.           '4' : matrixnewuser;
  842.           '5' : matrixcheck;
  843.           '6' : matrixlogoff;
  844.           '7' : matrixfeedback;
  845.           '8' : matrixchat;
  846.           else writeln;
  847.           end;
  848.         end;
  849.       end;
  850.       until (tries>=10) or validpassword or hungupon;
  851.       if not validpassword then
  852.       begin
  853.         clrscr;
  854.         nicetry;
  855.       end;
  856.      end;
  857.      if matrixtype=3 then begin
  858.       writeln;
  859.       writeln ('TCS Op/Sys Personal User DOS');
  860.       writeln ('Version '+ver+' (C)Copyright the TCS Programming Team 1988, 1989');
  861.       writeln ('             (C)Copyright TCS Corp 1988, 1989');
  862.       writeln;
  863.       repeat
  864.       begin
  865.         write (^B^P'C:\TCS>');
  866.         writestr ('*');
  867.         if length(input)<1 then input:='sambowndies!';
  868.         if upstring(input)='TCS-PACKET-MODE' then rnetmail;
  869.         mchoice:=upstring(input);
  870.         tries:=tries+1;
  871.         if (length(mchoice)<>0) then begin
  872.         if (mchoice='DIR') or (mchoice='DIR /W') or
  873.         (mchoice='DIR/W') or (mchoice='CLS') or
  874.         (mchoice='SYSTEM1') or (mchoice='SYSTEM1.EXE') or
  875.         (mchoice='SYSTEM2') or (mchoice='SYSTEM2.EXE') or
  876.         (mchoice='SYSTEM3') or (mchoice='SYSTEM3.EXE') or
  877.         (mchoice='NEWUSER') or (mchoice='NEWUSER.COM') or
  878.         (mchoice='CHECK') or (mchoice='CHECK.COM') or
  879.         (mchoice='LOGOFF') or (mchoice='LOGOFF.EXE') or
  880.         (mchoice='FEEDBACK') or (mchoice='FEEDBACK.COM') or
  881.         (mchoice='CHAT') or (mchoice='CHAT.COM') or
  882.         (mchoice='COMMAND') or (mchoice='COMMAND.COM') or
  883.         (mchoice='EXIT') or (copy(mchoice,1,2)='CD') or
  884.         (copy(mchoice,1,2)='MD') or (copy(mchoice,1,2)='RD') or
  885.         (mchoice='')
  886.         then begin
  887.          if (mchoice='DIR') or (mchoice='DIR /W') or (mchoice='DIR/W') then
  888.           matrixhelp;
  889.          if (mchoice='SYSTEM1') or (mchoice='SYSTEM1.EXE') then
  890.           system1;
  891.          if (mchoice='SYSTEM2') or (mchoice='SYSTEM2.EXE') then
  892.           system2;
  893.          if (mchoice='SYSTEM3') or (mchoice='SYSTEM3.EXE') then
  894.           system3;
  895.          if (mchoice='NEWUSER') or (mchoice='NEWUSER.COM') then
  896.           matrixnewuser;
  897.          if (mchoice='CHECK') or (mchoice='CHECK.COM') then
  898.           matrixcheck;
  899.          if (mchoice='LOGOFF') or (mchoice='LOGOFF.EXE') then
  900.           matrixlogoff;
  901.          if (mchoice='FEEDBACK') or (mchoice='FEEDBACK.COM') then
  902.           matrixfeedback;
  903.          if (mchoice='CHAT') or (mchoice='CHAT.COM') then
  904.           matrixchat;
  905.          if (mchoice='COMMAND') or (mchoice='COMMAND.COM') then begin
  906.           writeln;
  907.           writeln ('TCS Op/Sys Personal User DOS');
  908.           writeln ('Version '+ver+' (C)Copyright the TCS Programming Team 1988, 1989');
  909.           writeln ('             (C)Copyright TCS Corp 1988, 1989');
  910.           writeln;
  911.          end;
  912.          if (mchoice='EXIT') then writeln;
  913.          if (mchoice='CLS') then clearscr;
  914.          if (mchoice='') then ;
  915.         end
  916.         else writeln ('Bad command or file name');
  917.        end;
  918.       end;
  919.       until (tries>=10) or validpassword or hungupon;
  920.       if not validpassword then
  921.       begin
  922.         clrscr;
  923.         nicetry;
  924.       end;
  925.      end;
  926.   end;
  927.  
  928.   procedure getunum;
  929.   var tries,cnt:integer;
  930.       u:userrec;
  931.       enterednum:boolean;
  932.   begin
  933.     tries:=0;
  934.     repeat
  935.       tries:=tries+1;
  936.       if tries>6 then nicetry else begin
  937.         chainstr:='';
  938.         writestr (^M'[Enter your Name/Handle or ID#]: *');
  939.         unam:=input;
  940.         isnew:=false;
  941.         enterednum:=valu(unam)<>0;
  942.         if hungupon then unum:=-1 else
  943.           if length(unam)=0
  944.             then newuser
  945.             else begin
  946.               unum:=lookupuser (unam);
  947.               if unum=0
  948.                 then
  949.                   begin
  950.                     writestr ('Not found!  Are you new? *');
  951.                     if yes then newuser
  952.                   end
  953.                 else if not enterednum
  954.                   then writeln (^M'Use ',unum,' for faster logon.')
  955.             end
  956.       end
  957.     until unum<>0
  958.   end;
  959.  
  960.   procedure getpwd;
  961.   var u:userrec;
  962.       lo:byte;
  963.       x,y:string;
  964.       ok:boolean;
  965.  
  966.   begin
  967.     ok:=false;
  968.     seek (ufile,unum);
  969.     read (ufile,u); che;
  970.     if not checkpassword(u) then begin
  971.     nicetry;
  972.      end;
  973.     if u.hack>0 then
  974.     begin
  975.     lo:=0;
  976.     write (^M^M);
  977.     writehdr('Account Verification');
  978.     writeln ('Your account has been subjected to "hack" attempts.  To re-validate');
  979.     writeln ('your account, please enter the last four digits of your telephone number.');
  980.     repeat
  981.       writestr (^M'Your Number is: [NPA] PRE-*');
  982.       if input=copy(u.phonenum,7,4) then ok:=true;
  983.       lo:=lo+1;
  984.     until (lo=2) or ok;
  985.     if not ok then begin
  986.  writeln (^M^M'I am sorry but you have not answered correctly.  If you have forgotten');
  987.  writeln ('your phone number leave mail to the sysop.  If not, RIP THE ROOT, dude!!');
  988.       nicetry;
  989.       writeln (^M)
  990.     end else begin
  991.         writeln (^M^M'Thank you for your cooperation. ');
  992.         u.hack:=0;
  993.         seek(ufile,unum);
  994.         write(ufile,u);
  995.          end;
  996.  
  997.    end;
  998.   end;
  999.  
  1000.     procedure writeavail;
  1001.  
  1002.       function firstchar(instring:string):char;
  1003.       begin
  1004.         firstchar:=instring[1]
  1005.       end;
  1006.  
  1007.     var m,mm:char;
  1008.         mmm :sstr;
  1009.     begin
  1010.       mmm:=sysopavailstr;
  1011.       m:=upcase(firstchar(copy(mmm,1,1)));
  1012.       mm:=upcase(firstchar(copy(mmm,9,1)));
  1013.       if m='Y' then printxy(23,9,^U+'Yes') else
  1014.         printxy(23,9,^U+'No');
  1015.       if mm='Y' then printxy(23,9,^U+'Yes') else
  1016.         printxy(23,9,^U+'No');
  1017.     end;
  1018.  
  1019.   procedure inituser;
  1020.   var asc:boolean;
  1021.  
  1022.     procedure stat;
  1023.     begin
  1024.      ansicolor (urec.statcolor);
  1025.     end;
  1026.  
  1027.     procedure reg;
  1028.     begin
  1029.      ansicolor (urec.regularcolor);
  1030.     end;
  1031.  
  1032.   var m:mailrec;
  1033.       cnt,gnumsgs,gnufiles,gnugfiles,gnudbases,clicheline:integer;
  1034.       tmp:lstr;
  1035.       sysnot:text;
  1036.   const inoutstr:array [false..true] of string[3]=('Out','In');
  1037.   begin
  1038.     readurec;
  1039.     if withintime (timereststart,timerestend) then begin
  1040.      if ulvl<timerestlvl then begin
  1041.       writeln;
  1042. writeln ('TIME RESTRICT is in effect between ',timereststart,' and ',timerestend,'.');
  1043.       writeln ('You must be Level '+strr(timerestlvl)+' to use the BBS at this time.');
  1044.       writeln ('Since you do not fit in this category you are being logged off.');
  1045.       writeln ('Call back later when Time Restrict is not in effect!');
  1046.       writeln;
  1047.       disconnect;
  1048.      end;
  1049.     end;
  1050.     if ulvl=-1 then begin
  1051.       byebye ('Trashcan');
  1052.       exit
  1053.     end;
  1054.     if requireforms and (urec.infoform1<0) then infoform (1);
  1055.     if local
  1056.       then tmp:=' [Local]'
  1057.       else tmp:=' at '+baudstr;
  1058.     writelog (0,1,unam+tmp);
  1059.     with urec do begin
  1060.       numon:=numon+1;
  1061.       numcallers:=numcallers+1;
  1062.       callstoday:=callstoday+1;
  1063.       asc:=asciigraphics in config;
  1064.       if datepart(laston)<>datepart(now) then begin
  1065.         cnt:=ulvl;
  1066.         if cnt<1 then cnt:=1;
  1067.         if cnt>100 then cnt:=100;
  1068.         timetoday:=usertime[cnt]
  1069.       end;
  1070.       if (timetillevent<timetoday+3) and (timetillevent<=63) then begin
  1071.         writestr (^M'Due to a timed event scheduled for '+eventtime+',');
  1072.         writeln ('your time today is limited to ',timetillevent-3,' mins.')
  1073.       end;
  1074.      if (ansigraphics in urec.config) then begin
  1075.       write (#27+'[2J');
  1076.       randomize;
  1077.        printfile (textfiledir+'Welcome.'+strr(random(numwelcomes)+1));
  1078.       movexy (1,urec.displaylen);
  1079.       writestr (^P'Press [Return] to continue.*');
  1080.      end else begin
  1081.       printfile (textfiledir+'Welcome.Asc');
  1082.       writestr (^P'Press [Return] to continue.*');
  1083.      end;
  1084.      if (ansigraphics in urec.config) then begin
  1085.       write (^B^M);
  1086.      clearscr;
  1087.      writeln (^R'                        ┌──────────────────────────┐');
  1088.      writeln ('                        │ '^S'TCS '+ver+' - '+parsedate(date)+^R'  │');
  1089.      writeln ('  ╒═════════════════════╧═══════════╕  ╒═══════════╧═════════════════════╕  ');
  1090.      writeln ('  │ '^S'Last Date Online:'^R'               ├──┤ '^S'New Messages :'^R'                  │  ');
  1091.      writeln ('  │ '^S'Last Time Online:'^R'               │  │ '^S'New Files    :'^R'                  │  ');
  1092.      writeln ('  │ '^S'Hack Attempts   :'^R'               │  │ '^S'New Gfiles   :'^R'                  │  ');
  1093.      writeln ('  │ '^S'Total Calls     :'^R'               │  │ '^S'New Database :'^R'                  │  ');
  1094.      writeln ('  │ '^S'Total Time On   :'^R'               │  │ '^S'New Callers  :'^R'                  │  ');
  1095.      writeln ('  │ '^S'Sysop Available :'^R'               │  │ '^S'E-Mail       :'^R'                  │  ');
  1096.      writeln ('  ╘══════════════════════════════╤══╛  ╘══╤══════════════════════════════╛  ');
  1097.      writeln ('  ╒══════════════════════════════╧════════╧══════════════════════════════╕  ');
  1098.      writeln ('  │ '^S'User Name  :'^R'                         '^S'Uploads       :'^R'                 │  ');
  1099.      writeln ('  │ '^S'User Level :'^R'                         '^S'Downloads     :'^R'                 │  ');
  1100.      writeln ('  │ '^S'Xfer Level :'^R'                         '^S'File Points   :'^R'                 │  ');
  1101.      writeln ('  │ '^S'Gfile Level:'^R'                         '^S'Last Caller   :'^R'                 │  ');
  1102.      writeln ('  │ '^S'Time Today :'^R'                                                         │  ');
  1103.      writeln ('  ╘═════════════════════╤══════════════════════════╤═════════════════════╛  ');
  1104.      writeln ('                        │       '^S' User Note '^R'        │  ');
  1105.      writeln ('  ╒═════════════════════╧══════════════════════════╧═════════════════════╕  ');
  1106.      writeln ('  │                                                                      │  ');
  1107.      writeln ('  ╘══════════════════════════════════════════════════════════════════════╛  ');
  1108.      if laston<>0 then
  1109.      printxy (23,4,^U+datestr(laston)) else
  1110.      printxy (23,4,^U'Never');
  1111.      xlaston:=laston;
  1112.      subs1.laston:=laston;
  1113.      laston:=now;
  1114.      if laston<>0 then
  1115.        printxy (23,5,^U+timestr(laston))
  1116.         else
  1117.        printxy (23,5,^U'Never');
  1118.      if urec.hack=0 then
  1119.        printxy (23,6,^U'None')
  1120.      else
  1121.        printxy (23,6,^U+strr(urec.hack));
  1122.      printxy (23,7,^U+strr(urec.numon));
  1123.      printxy (23,8,^U+streal(urec.totaltime));
  1124.      writeavail;
  1125. {New X's status}
  1126.      gnumsgs:=(messages-urec.lastmessages);
  1127.      gnufiles:=(ups-urec.lastups);
  1128.      gnugfiles:=(gfilez-urec.lastgfiles);
  1129.      gnudbases:=(dbases-urec.lastdbases);
  1130.      if gnumsgs<1 then gnumsgs:=0;
  1131.      if gnufiles<1 then gnufiles:=0;
  1132.      if gnugfiles<1 then gnugfiles:=0;
  1133.      if gnudbases<1 then gnudbases:=0;
  1134.      urec.lastmessages:=messages;
  1135.      urec.lastups:=ups;
  1136.      urec.lastgfiles:=gfilez;
  1137.      urec.lastdbases:=dbases;
  1138.      {printxy (51,4,^S'New Messages :');}
  1139.      if gnumsgs<1 then
  1140.      printxy (57,4,^U'None')
  1141.        else
  1142.      printxy (57,4,^U+strr(gnumsgs));
  1143.      if gnufiles<1 then
  1144.      printxy(57,5,^U'None')
  1145.        else
  1146.      printxy (57,5,^U+strr(gnufiles));
  1147.      if gnugfiles<1 then
  1148.      printxy(57,6,^U'None')
  1149.        else
  1150.      printxy(57,6,^U+strr(gnugfiles));
  1151.      if gnudbases<1 then
  1152.      printxy(57,7,^U'None')
  1153.        else
  1154.      printxy(57,7,^U+strr(gnugfiles));
  1155.  
  1156.      {if gnucallers<1 then
  1157.      PrintXY(57,8,^U'None')
  1158.      else
  1159.      PrintXY(57,8,^U+strr(gnucallers));}
  1160.  
  1161.      cnt:=getnummail (unum);
  1162.      if cnt<1 then
  1163.      printxy(57,9,^U'None')
  1164.        else
  1165.      printxy (57,9,^U+strr(cnt));
  1166.      printxy (18,12,^U+urec.handle);
  1167.      printxy (18,13,^U+strr(urec.level));
  1168.      printxy (18,14,^U+strr(urec.udlevel));
  1169.      printxy (18,15,^U+strr(urec.gflevel));
  1170.      printxy (18,16,^U+strr(urec.timetoday));
  1171.      printxy (58,12,^U+streal(urec.upk/1000)+'k');
  1172.      printxy (58,13,^U+streal(urec.downk/1000)+'k');
  1173.      printxy (58,14,^U+strr(urec.udpoints));
  1174.      printxy (58,15,^U+getlastcaller);
  1175.  
  1176.      if useqr then begin
  1177.        calcqr;
  1178.        printxy(42,16,^S'Quality Rating:');
  1179.        printxy(58,16,^U+strr(qr));
  1180.      end;
  1181.      printxy((35-trunc(length(urec.note)/2))+3,20,^U+urec.note);
  1182.      if usecliche then begin
  1183.         if length(cliche)>0 then begin
  1184.           printxy (1,21,'');
  1185.           writeln (^S+cliche+^R);
  1186.         end;
  1187.       end;
  1188.      printxy(1,22,'');
  1189.      urec.hack:=0;
  1190.    end;
  1191.       writestr (^R'Press '^U'['^S'Return'^U']'^R' to continue.*');
  1192.  
  1193.  
  1194.       cnt:=getnummail(unum);
  1195.       if cnt>0
  1196.         then writeln (^B^G^S'You have '^R,cnt,
  1197.                  ^S' piece',s(cnt),' of mail waiting!  Use '^R'[E]'^S' to read.');
  1198.       if (ulvl>=sysoplevel) then begin
  1199.         if numfeedback>0 then begin
  1200.           thereisare (numfeedback);
  1201.           writeln ('piece',s(cnt),' of feedback waiting!  Use '^S'[%,F]'^R' to read.')
  1202.         end;
  1203.       if exist ('Errlog')
  1204.           then writeln (^B^G^R'Errors have occured!  Use '^S'[%,E]'^R' to read.')
  1205.        end;
  1206.       if newusers>0 then begin
  1207.        writeln (^S,strr(newusers)+^R' New User',s(cnt),' applied for access.');
  1208.       end;
  1209.       writeln;
  1210.       if inoutstr[sysopisavail]='In' then writeln (^S+availstr+^R) else
  1211.        writeln (^S+notavailstr+^R);
  1212.       logontime:=timer;
  1213.       logofftime:=timer+timetoday;
  1214.       logonunum:=unum;
  1215.     end;
  1216.     addlastcaller (unam);
  1217. {    writeurec;}
  1218.     bottomline;
  1219.     if (issysop) and (exist (forumdir+'System.Not')) then begin
  1220.      writeln;
  1221.      writestr ('Attention Sysop! There are System Notifications!');
  1222.      writestr ('Do you want to read them now [Y/n]? *');
  1223.      if (length(input)=0) or (upcase(input[1])='Y') then
  1224.      begin
  1225.       assign (sysnot,forumdir+'System.Not');
  1226.       printfile (forumdir+'System.Not');
  1227.       writestr (^M'Delete System Notification File [y/n]? *');
  1228.       if yes then erase (sysnot);
  1229.      end else writeln (^M^S'Be sure to read them soon then.'^R^M);
  1230.     end;
  1231.     if wanted in urec.config then if sysopisavail then begin
  1232.       writeln (^B^G,sysopname,' wants to speak with you.');
  1233.       writeln ('Let me page him...'^M);
  1234.       for cnt:=1 to 25 do if not keyhit then summonbeep;
  1235.       chatmode:=true
  1236.     end;
  1237.     printnews;
  1238.     if tonext>-1 then begin
  1239.       writehdr ('Auto Message');
  1240.       printtext (tonext)
  1241.     end;
  1242.     disconnected:=false
  1243.   end;
  1244.  
  1245. var thebaud:string;
  1246. begin
  1247.   stoptimer (numminsidle);
  1248.   starttimer (numminsused);
  1249.   textcolor (normbotcolor);
  1250.   clrscr;
  1251.   initwinds;
  1252.   fillchar (urec,sizeof(urec),0);
  1253.   urec.config:=[lowercase,linefeeds,eightycols,asciigraphics];
  1254.   uselinefeeds:=true;
  1255.   usecapsonly:=false;
  1256.   getsystempassword;
  1257.   clearscr;
  1258.   writeln;
  1259.   str (baudrate,thebaud);
  1260.   if local then thebaud:='Local' else thebaud:=thebaud+' bps';
  1261.   writeln (^R'TCS '+ver+' - '+parsedate(date)+' [Online]');
  1262.   writeln (^R'Written by the TCS Staff.  Use [.] to view credits.');
  1263.   writeln (^R'Port '+strr(usecom)+' accessed at '+timestr(now)+' using ',thebaud);
  1264.   writeln;
  1265.   printfile (textfiledir+'Prelogon.BBS');
  1266.   if withintime (timereststart,timerestend) then begin
  1267.    writeln;
  1268.    writeln('[',timestr(now),'] - TIME RESTRICTION');
  1269.    writeln('Your access level must be ',strr(timerestlvl),' or above to access ',longname);
  1270.    writeln('at this time.');
  1271.    writeln;
  1272.   end;
  1273.   if autologin and local and (not carrier) then begin
  1274.     writeln (usr,'* SYSOP AUTOLOGIN *');
  1275.     unum:=lookupuser (sysopname);
  1276.     if unum=0
  1277.       then writeln (usr,'User ',sysopname,' not found!')
  1278.       else begin
  1279.         unum:=1;
  1280.         inituser;
  1281.         exit
  1282.       end
  1283.   end;
  1284.   getunum;
  1285.   if hungupon then exit;
  1286.   if not isnew then getpwd;
  1287.   if hungupon then exit;
  1288.   inituser
  1289. end;
  1290.  
  1291. procedure returnfromdoor;
  1292. var t:sstr;
  1293. begin
  1294.   if not fromdoor then exit;
  1295.   readdataarea;
  1296.   baudrate:=valu(paramstr(2));
  1297.   parity:=boolean(valu(paramstr(3)));
  1298.   online:=baudrate<>0;
  1299.   local:=not online;
  1300.   if baudrate=0 then baudrate:=defbaudrate;
  1301.   setparam (usecom,baudrate,parity);
  1302.   if unum=valu(paramstr(1)) then readurec else begin
  1303.     unum:=valu(paramstr(1));
  1304.     readurec;
  1305.     if (unum<1) or (unum>numusers) then begin
  1306.       unum:=-1;
  1307.       exit
  1308.     end;
  1309.     logontime:=timer;
  1310.     logofftime:=timer+urec.timetoday
  1311.   end;
  1312.   if hungupon then begin
  1313.     unum:=-1;
  1314.     exit
  1315.   end;
  1316.   fromdoor:=true;
  1317.   settimeleft (urec.timetoday);
  1318.   t:=paramstr(4);
  1319.   if t=''
  1320.     then returnto:='D'
  1321.     else returnto:=upcase(t[1])
  1322. end;
  1323.  
  1324. begin
  1325. end.
  1326.