home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / beehive / bbs / pic16quo.arc / PICS2K.INC < prev    next >
Text File  |  1991-08-11  |  16KB  |  477 lines
  1. { PICS2K.INC - Pascal Integrated Communications System Overlays}
  2. { 6/10/87  Version 1.6 Copyright 1987 by Les Archambault}
  3.  
  4. overlay procedure login;
  5.   var
  6.     continue,abort: boolean;
  7.     key: StrName;
  8.  
  9.   procedure get_new_user(var continue: boolean);
  10.     var
  11.       i: integer;
  12.     begin
  13.       continue := FALSE;
  14.       Writeln(USR);
  15.       Writeln(USR, 'Name not found.');
  16.       list('A');
  17.       Writeln(USR);
  18.       continue := ask('Are you a new user');
  19.       if continue
  20.         then with user_rec do
  21.           begin
  22.             get_case;
  23.             get_nulls;
  24.             st:=prompt('From what STATE [2 letter abbrev.] are you calling',len_st,'ES');
  25.             cy := prompt('What CITY', len_ad, 'EL');
  26.             ph:=prompt('Your phone number [###-###-####] ',len_ph,'EL');
  27.             ad:=prompt('What computer do you use',len_ad,'EL');
  28.             Writeln(USR);
  29.             Writeln(USR, 'You are ', fn, ' ', ln, ' from ', cy, ', ', st, '.');
  30.             writeln(usr, 'phone number ',ph);
  31.             writeln(usr,ad,' computer.');
  32.             Writeln(USR);
  33.             continue := ask('Is that correct');
  34.             if continue
  35.               then
  36.                 begin
  37.                   get_new_password;
  38.                   used := 0;
  39.                   if fn = 'SYSOP'
  40.                     then access := 255
  41.                     else access := uval_acc;
  42.                   limit := uval_time;
  43.                   if fn='SYSOP' then conf_flags:=254 else conf_flags := 0;
  44.                   columns := def_chars;
  45.                   lines := def_lines;
  46.                   for i := 0 to 5 do
  47.                     laston[i] := 0;
  48.                   time_today := 0;
  49.                   flags:=0;
  50.                   time_total := 0;
  51.                   lasthi := 0;
  52.                   upload := 0;
  53.                   download := 0;
  54.  
  55.                   key := pad(ln, len_ln) + pad(fn, len_fn);
  56.                   AddRec(DatF, user_loc, user_rec);
  57.                   AddKey(IdxF, user_loc, key);
  58.                   log(9, '');
  59.                   list('I');
  60.                   pause
  61.                 end
  62.           end
  63.     end;
  64.  
  65.   procedure init_user;
  66.     var
  67.       str: StrTAD;
  68.  
  69.     procedure display_random_quote;     {vdp 4/18/87.  inserted procedure}
  70.       var
  71.         sel : integer;
  72.       begin {procedure display_random_quote}
  73.         if quot_count > 0 then
  74.           begin
  75.             sel := random( quot_count );
  76.             seek( qidx_file, sel );
  77.             read( qidx_file, qidx_rec );
  78.             seek( quot_file, qidx_rec.loc );
  79.  
  80.             quot_rec.text := 'ZZZ';
  81.             writeln(USR);
  82.             while (not eof(quot_file)) and
  83.                   (quot_rec.text <> '') and (not brk) and online do
  84.               begin
  85.                 read( quot_file, quot_rec );
  86.                 writeln(USR, quot_rec.text);
  87.               end;
  88.           end;
  89.       end;  {procedure display_random_quote}
  90.  
  91.     begin
  92.       temp_hi_lmr:=0;
  93.       if local_online
  94.         then log(2, 'Local')
  95.         else log(2, intstr(rate, 3) + ' bps');
  96.       Seek(logr_file, 0);
  97.       Read(logr_file, logr_rec);
  98.       logr_rec.user := succ(logr_rec.user);  {caller number}
  99.       if logr_rec.user=maxint then logr_rec.user:=1; {reset }
  100.       Seek(logr_file, 0);
  101.       Write(logr_file, logr_rec);
  102.       GetTAD(login_t);
  103.       if (login_t[3] <> user_rec.laston[3]) or
  104.          (login_t[4] <> user_rec.laston[4]) or
  105.          (login_t[5] <> user_rec.laston[5]) then user_rec.time_today := 0;
  106.       if user_rec.access < 10               { Hang up on twit }
  107.         then remote_online := FALSE
  108.       else
  109.         begin                        {vdp 4/18/87}
  110.           show_user_stats;
  111.           if login_quote then        {vdp 1/18/88}
  112.             begin                    {vdp 1/18/88}
  113.               display_random_quote;       {vdp 4/18/87}
  114.               delay( login_quote_delay ); {vdp 1/18/88}
  115.             end;                     {vdp 1/18/88}
  116.         end;                         {vdp 4/18/87}
  117.     end;
  118.  
  119.   begin { login }
  120.     abort:=false;
  121.     Writeln(USR, version);
  122.     Writeln(USR, ver_date);
  123.     repeat until (not BRK) or (not online);
  124.     if (not macro_in_progress) and (online) then list('W');
  125.     repeat
  126.       if macro_in_progress then
  127.         begin
  128.           user_rec.fn:='SYSOP'; user_rec.ln:='';
  129.         end
  130.       else
  131.         get_name(user_rec.fn, user_rec.ln,'C');
  132.       timeout := sleepy_time;                { increase input timeout }
  133.       key := pad(user_rec.ln, len_ln) + pad(user_rec.fn, len_fn);
  134.       FindKey(IdxF, user_loc, key);
  135.       if OK
  136.         then
  137.           begin
  138.             GetRec(DatF, user_loc, user_rec);
  139.             if macro_in_progress then
  140.               begin
  141.                 valid_pw:=true;
  142.                 mode:=sysop_mode;
  143.               end
  144.             else
  145.               begin
  146.                 Get_old_password('  Password',valid_pw);
  147.                 if not valid_pw then list('P');
  148.               end;
  149.             continue := TRUE;
  150.           end
  151.         else
  152.           begin
  153.             if diskfree(homdrv,homusr)>maxfree_logs then
  154.               begin
  155.                 get_new_user(continue);
  156.                 if continue then valid_pw:=true;
  157.               end
  158.             else
  159.               begin
  160.                valid_pw:=false;
  161.                writeln(usr);
  162.                writeln(usr,'Name not found. Not enough disk space for new callers.');
  163.                writeln(usr,'           Please call back soon.');
  164.                writeln(usr);
  165.                delay(5000);
  166.                continue:=false;
  167.                remote_online:=false;
  168.                mdhangup;
  169.                abort:=true;
  170.               end;
  171.           end;
  172.     until (not online) or continue or abort;
  173.     in_use := valid_pw;
  174.     connected := continue;
  175.     if online and in_use
  176.       then init_user;
  177.   end;
  178.  
  179. overlay procedure cold_start;
  180.   var
  181.     i,try,errcnt : integer;
  182.     SysmThis, SysmLast: SysmPtr;
  183.     sysm_text: text;
  184.     t:tad_array;
  185.  
  186. Procedure build_sysm;
  187.   { Build SYSMSG.BB# file }
  188.     var i:integer;
  189.         goof,error:boolean;
  190.         work:string[255];
  191.         dummy:char;
  192.     begin
  193.       goof:=false;
  194.       errcnt:=0;
  195.       {$I-} Close(sysm_file) {$I+};         { Shouldn't erase an open file }
  196.       i := IOresult;                        { Ignore any errors }
  197.       Rewrite(sysm_file);
  198.       Assign(sysm_text, sysm_name + '.TXT');
  199.       {$I-} Reset(sysm_text) {$I+};
  200.       if IOresult = 0
  201.         then
  202.           begin
  203.             Write('  Creating ', sysm_name, ext);
  204.             while (not eof(sysm_text)) and (errcnt<50) do
  205.               begin
  206.                 {$I-} readln(sysm_text,work); {$I+}
  207.                 error:=(ioresult<>0);
  208.                 if length(work)>79 then
  209.                   begin
  210.                     sysm_rec:=copy(work,1,79);
  211.                     writeln;
  212.                     writeln;
  213.                     writeln('Line too long, truncating.');
  214.                     writeln;
  215.                     goof:=true;
  216.                   end
  217.                 else sysm_rec:=work;
  218.                 if not error then write(sysm_file,sysm_rec);
  219.                 if error then
  220.                   begin
  221.                     writeln;
  222.                     writeln;
  223.                     writeln('Error reading text line. No CR,LF ? ');
  224.                     goof:=true;
  225.                     errcnt:=succ(errcnt);
  226.                   end;
  227.               end;             {while not eof text file}
  228.             Close(sysm_text);
  229.             Close(sysm_file);
  230.             Reset(sysm_file);
  231.             if goof or error then
  232.               begin
  233.                 writeln;
  234.                 writeln(sysm_name,'TXT problem may result in parts of SYSMSG.BB# not being complete.');
  235.                 writeln;
  236.                 writeln('   Lines in text file should not be longer than 79 characters');
  237.                 writeln('   or have high bits set (soft CRs) by the editor you use.');
  238.                 writeln;
  239.                 delay(10000);
  240.               end;
  241.           end        {ioresult=0}
  242.         else
  243.           begin
  244.             Writeln;
  245.             Write('System message text file  ', sysm_name,'TXT not found.');
  246.           end;
  247.       Writeln;
  248.     end;
  249.  
  250. procedure open_quote_file;
  251. { builds QUOTES.BB# and QUOTEIDX.BB# if necessary, and opens them }
  252.   var
  253.     rec_count    : integer;
  254.     in_quote     : boolean;
  255.     qtxt_file    : text;                   {file var for QUOTES.TXT}
  256.     quot_exists  : boolean;
  257.     qtxt_exists  : boolean;
  258.  
  259. {$V-}
  260.   procedure trim( var st : StrStd );
  261.   {trims trailing blanks and tabs from strings}
  262.     var
  263.       i : integer;
  264.     begin {procedure trim}
  265.       i := length( st );
  266.       while (i > 0) and ( (st[i] = ' ') or (st[i] = char(TAB)) ) do
  267.         begin
  268.           delete( st, i, 1 );
  269.           i := pred( i );
  270.         end;
  271.     end;  {procedure trim}
  272. {$V+}
  273.  
  274. {$V-}
  275.   function file_exists( fname : StrStd ) : boolean;
  276.   { returns TRUE if the named file exists }
  277.     var
  278.       fil : file;
  279.     begin {function file_exists}
  280.       assign(fil, fname);
  281.       {$I-} reset(fil); {$I+}
  282.       file_exists := (IOresult = 0);
  283.       {$I-} close(fil); {$I+}
  284.     end;  {function file_exists}
  285. {$V+}
  286.  
  287.   begin {procedure open_quote_file}
  288.  
  289.     randomize;
  290.     quot_exists := file_exists(quot_name + ext) and
  291.                    file_exists(qidx_name + ext);
  292.     qtxt_exists := file_exists(quot_name + '.TXT');
  293.  
  294.     if not quot_exists then
  295.       begin
  296.         {rebuild QUOTES.BB# and QUOTEIDX.BB# from QUOTES.TXT}
  297.         if qtxt_exists then
  298.           begin
  299.             writeln( char(BEL) + quot_name + ext + ' and/or ' +
  300.                                  qidx_name + ext + ' not found.');
  301.             writeln ('Rebuilding ' + quot_name + ext + ' and ' +
  302.                                      qidx_name + ext + '.'       );
  303.             assign(quot_file, quot_name + ext);
  304.             rewrite(quot_file);
  305.             assign(qidx_file, qidx_name + ext);
  306.             rewrite(qidx_file);
  307.             assign(qtxt_file, quot_name + '.TXT');
  308.             reset(qtxt_file);
  309.  
  310.             rec_count := 0;
  311.             in_quote := FALSE;
  312.             while not eof(qtxt_file) do
  313.               begin
  314.                 readln(qtxt_file, quot_rec.text);
  315.                 trim(quot_rec.text);
  316.                 if (not in_quote) and (quot_rec.text <> '') then
  317.                   begin
  318.                     in_quote := TRUE;
  319.                     qidx_rec.loc := rec_count;
  320.                     write(qidx_file, qidx_rec);
  321.                   end;
  322.                 if in_quote then
  323.                   begin
  324.                     write(quot_file, quot_rec);
  325.                     rec_count := succ( rec_count );
  326.                     in_quote := quot_rec.text <> '';
  327.                   end;
  328.               end;
  329.             close(qtxt_file);
  330.             close(quot_file);
  331.             close(qidx_file);
  332.           end;
  333.       end;
  334.  
  335.     if quot_exists or qtxt_exists then
  336.       begin
  337.         assign(quot_file, quot_name + ext);
  338.         reset(quot_file);
  339.         assign(qidx_file, qidx_name + ext);
  340.         reset(qidx_file);
  341.         quot_count := FileSize( qidx_file );
  342.       end
  343.     else
  344.       quot_count := 0;
  345.  
  346.   end;  {procedure open_quote_file}
  347.  
  348.   begin     {cold start}
  349.     debug:=false;
  350.     cold                := TRUE;
  351.     lps                 := (Mhz/4.0)*1250.0;       {adjust for machine speed}
  352.     for i:=0 to 5 do global_date[i]:=0;            { preset for no clock vers}
  353.     mult_cmds           :=false;                    {no multiple commands}
  354.     cmd_queue           :='';
  355.     chat_ok             := def_chat_ok;
  356.     clock               := true;                   {unless turned off}
  357.     hour_count          :=0.0;
  358.     macro_in_progress   := false;
  359.     gettad(t);
  360.     macro_done          := t[3];
  361.     val_acc             := def_val_acc;
  362.     uval_acc            := def_uval_acc;
  363.     val_time            := def_val_time;
  364.     uval_time           := def_uval_time;
  365.     chatstart           := def_chatstart;
  366.     chatend             := def_chatend;
  367.     unv_days            := def_unv_days;
  368.     val_days            := def_val_days;
  369.     unr_days            := def_unr_days;
  370.     rea_days            := def_rea_days;
  371.     max_tries           := def_max_tries;
  372.     restrict300         := def_restrict300;
  373.     start_restrict300   := def_start_restrict300;
  374.     end_restrict300     := def_end_restrict300;
  375.     auto_macro          := def_auto_macro;
  376.     auto_macro_start    := def_auto_macro_start;
  377.     max_msg_lines       := def_max_msg_lines;
  378.     restrict_public     := def_restrict_public;
  379.     limit_lines         :=def_limit_lines;
  380.     up_down_ratio       :=def_up_down_ratio;
  381.     sleepy_time         :=def_sleepy_time;
  382.     maxfree_uplds       :=def_maxfree_uplds;
  383.     maxfree_logs        :=def_maxfree_logs;
  384.     maxfree_mslimit     :=def_maxfree_mslimit;
  385.     maxfree_lines       :=def_maxfree_lines;
  386.     maxfree_abs         :=def_maxfree_abs;
  387.     extra_time_sw       :=def_extra_time;
  388.     extra_time_start    :=def_extra_time_start;
  389.     extra_time_stop     :=def_extra_time_stop;
  390.     extra_time_val      :=def_extra_time_val;
  391.     time_adjust         :=def_time_adjust;
  392.  
  393.     macro               := Deflt_macro;
  394.  
  395.     audit_on    := FALSE;
  396.     delay_down  := FALSE;
  397.     in_library  := FALSE;                   { Start in non-library mode }
  398.     in_arc      := FALSE;
  399.  
  400.     SysmBase    := nil;                     { Initialize pointers}
  401.     SectBase    := nil;
  402.     AreaBase    := nil;
  403.     MesgBase    := nil;
  404.     DirBase     := nil;
  405.     LibBase     := nil;
  406.     Artbase     := nil;
  407.     ArcBase     := nil;
  408.     UsrOutPtr   := addr(putchar);           { Initialize output driver }
  409.     HomDrv      := BDOS(getdrive);          { Assume system files are }
  410.     HomUsr      := BDOS(getseluser, $FF);   {   in the startup area }
  411.     AudDrv      := Homdrv;                  { default setting}
  412.     AudUsr      := HomUsr;
  413.     BDOS(13);                               { Reset disks}
  414.     setsect(homdrv,homusr);                 { Return to proper drive, user}
  415.     Assign(sysm_file, sysm_name + ext);
  416.     Assign(summ_file, summ_name + ext);
  417.     Assign(mesg_file, mesg_name + ext);
  418.     Assign(logr_file, logr_name + ext);
  419.     Assign(stat_file, stat_name + ext);
  420.     Assign(nwin_file, nwin_name + ext);
  421.     Try:=0;
  422.     {$I-} Reset(sysm_file) {$I+};           { Try to open system message file }
  423.     if IOresult <> 0
  424.       then
  425.         begin
  426.           Write('Cannot open ', sysm_name + ext, '.');
  427.           build_sysm;
  428.           try:=succ(try);
  429.         end;
  430.     {$I-} read(sysm_file, sysm_rec) {$I+};  { Try to read file }
  431.     if IOresult <> 0
  432.       then
  433.         begin
  434.           OK:=false;
  435.           if try=0 then
  436.             begin
  437.               write('Cannot read ',sysm_name +ext,'.');
  438.               build_sysm;
  439.               seek(sysm_file,0);
  440.               {$I-} read(sysm_file,sysm_rec); {$I+}
  441.               OK:=(IOresult=0);
  442.             end;
  443.           if not OK then
  444.             begin
  445.               Writeln;
  446.               Writeln('Cannot create ', sysm_name + ext, '.');
  447.               Writeln('Unable to continue.');
  448.               halt;
  449.             end;
  450.         end;
  451.     i := 0;
  452.     while not EOF(sysm_file) do
  453.       begin
  454.         if sysm_rec[1] = ':'
  455.           then
  456.             begin
  457.               new(SysmThis);
  458.               if SysmBase = nil
  459.                 then SysmBase := SysmThis
  460.                 else SysmLast^.next := SysmThis;
  461.               SysmLast := SysmThis;
  462.               SysmLast^.key := sysm_rec[2];
  463.               SysmLast^.loc := i;
  464.               SysmLast^.next := nil
  465.             end;
  466.         read(sysm_file, sysm_rec);
  467.         i := succ(i)
  468.       end;
  469.     open_quote_file;                        { vdp 4/18/87 }
  470.     RcvDrv := 0;                            { Default to A0: for uploads }
  471.     RcvUsr := 0;
  472.     Read_section_file;
  473.     if auto_macro and (t[2]<auto_macro_start) then macro_done:=t[3]-1;
  474.   end;
  475.  
  476.  {end of PICS2K.INC }
  477.