home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / beehive / bbs / pic16quo.arc / PICS3A.INC < prev    next >
Text File  |  1991-08-11  |  10KB  |  346 lines
  1. { PICS3A.INC  Pascal Integrated Communications System commands processor }
  2. { 6/8/87 vers 1.6 Copyright 1987 by Les Archambault.}
  3.  
  4. Overlay Procedure Set_Initial_areas;
  5.    var drive,user:integer;
  6.   begin
  7.     if (not macro_in_progress) and online then
  8.       begin
  9.         pause;
  10.         list('B');
  11.         pause;
  12.         repeat until (not BRK) or (not online);
  13.       end;
  14.     if user_rec.access >= 250 then
  15.       begin
  16.         FindSect('NEWIN',Drive,User,OK);
  17.         SectReq:='NEWIN';
  18.         SetDrv:=Drive;
  19.         SetUsr:=User;
  20.         mesg_area_change('SYSTEM');
  21.       end
  22.     else
  23.       begin
  24.         FindSect('LOGIN',Drive,User,OK);
  25.         SectReq:='LOGIN';
  26.         SetDrv:=Drive;
  27.         SetUsr:=User;
  28.         mesg_area_change('POST');
  29.       end;
  30.   end;
  31.  
  32. Overlay Procedure Check_time;
  33. {checks time on system and time left}
  34.  
  35. begin
  36.   timer(time_on, time_left);
  37.   if time_left <= 0 then
  38.     begin
  39.       writeln(USR, 'Access time expired.  Please call back tomorrow.', BEL, BEL, BEL);
  40.       remote_online := FALSE
  41.     end
  42.   else if time_left <= 5 then
  43.   writeln(USR, 'Less than 5 minutes of access time left.  Please finish up.', BEL);
  44. end;
  45.  
  46. Overlay Procedure Make_Prompt;
  47.  
  48. begin
  49.   st := intstr(time_left, 1) + '-' + pr_msg[mode];
  50.   case mode of
  51.     message_mode: st := st + ' ' + AreaReq;
  52.     files_mode  : begin
  53.                     st := st + ' ' + SectReq;
  54.                     if in_library then st := st + ' [' + LibReq + ']';
  55.                     if in_arc then st:=st+' ['+ArcReq+']';
  56.                     if new_dir then directory;
  57.                     if up_down_display then
  58.                        begin
  59.                          Repeat until (not BRK) or (not online);
  60.                          ReadDir(direntries,dirspace,dirbase);
  61.                          directory;
  62.                          writeln(usr);
  63.                          writeln(USR, user_rec.upload, ' uploads, ',
  64.                          user_rec.download, ' downloads to date.');
  65.                          up_down_display := FALSE;
  66.                        end;
  67.                   end;
  68.   end;
  69.   if (user_rec.access>=250) and Audit_on then st:=st+' (Audit ON) ';
  70. end;
  71.  
  72. Overlay Procedure Write_status_line;
  73.   begin
  74.     putstat(user_rec.fn + ' ' + user_rec.ln + '  ' + user_rec.cy + ', ' +
  75.      user_rec.st + '  Access: ' + intstr(user_rec.access, 1) + '  On: ' +
  76.      intstr((time_on+user_rec.time_today), 1) + '  Heap: '
  77.      + intstr(MaxAvail, 1));
  78.   end;
  79.  
  80. overlay procedure Process_messages;
  81.   begin
  82.     case ch of
  83.          'A': Articles;
  84.          'C': mesg_area_change('');
  85.          'E': begin
  86.                 mesg_enter(' ');
  87.                 mesg_build_index(AreaSet);
  88.               end;
  89.          'F': begin
  90.                 clear_heaps;
  91.                 if in_library then LibReadDir(LibEntries,LibSpace,LibBase)
  92.                 else
  93.                 if in_arc then ArcReadDir(ArcEntries,ArcSpace,ArcBase)
  94.                 else
  95.                 ReadDir(direntries,dirspace,dirbase);
  96.                 new_dir:=false;
  97.                 mode := files_mode;
  98.               end;
  99.          'G': in_use := FALSE;
  100.          'Q': mesg_quick_scan;
  101.          'R': mesg_read;
  102.          'S': mesg_summary;
  103.          'U': begin
  104.                 clear_heaps;
  105.                 mode := utility_mode;
  106.               end;
  107.          'X': if (user_rec.access >= 250) or (not remote_copy) then
  108.               begin
  109.                 clear_heaps;
  110.                 mode := sysop_mode;
  111.               end;
  112.          'B', 'I': list(ch);
  113.          'O': List_file('OTHERSYS.LST',homdrv,homusr)
  114.     else
  115.       begin
  116.         list('M');
  117.         if (not macro_in_progress) then
  118.           begin
  119.             mult_cmds:=false;
  120.             cmd_queue:='';
  121.           end;
  122.       end;
  123.     end;
  124.   end;
  125.  
  126. Overlay procedure Process_files;
  127.   begin
  128.     if (st[1]='S') and (user_rec.access<val_acc) then list('S')
  129.     else
  130.     if st='REN' then rename_file
  131.     else
  132.     if st='DEL' then delete_file
  133.     else
  134.     if st='COPY' then copy_file
  135.     else
  136.     if st='STAT' then file_status
  137.     else
  138.     if st='SK' then SendXmodem('K')
  139.     else
  140.     If st='SB' then SendXmodem('B')
  141.     else
  142.     if st='TYPE' then SendText
  143.     else
  144.     If st='RB' then RecvXmodem('B')
  145.     else
  146.     case ch of
  147.         'A': begin
  148.                if in_library then library;
  149.                arc;
  150.              end;
  151.         'C': begin
  152.                if in_library then library;
  153.                if in_arc then arc;
  154.                file_area_change('')
  155.              end;
  156.         'D': directory;
  157.         'F': find_files;
  158.         'G': in_use := FALSE;
  159.         'L': begin
  160.                if in_arc then arc;
  161.                library;
  162.              end;
  163.         'M': begin
  164.                clear_heaps;
  165.                mesg_build_index(areaset);
  166.                mode := message_mode;
  167.              end;
  168.         'N': newin_list;
  169.         'R': RecvXmodem(' ');
  170.         'S': SendXmodem('X');                  { 128 byte protocol}
  171.         'T': SendText;
  172.         'U': begin
  173.                if in_library then library;
  174.                if in_arc then arc;
  175.                clear_heaps;
  176.                mode := utility_mode;
  177.              end;
  178.         'X': if (user_rec.access >= 250) or (not remote_copy) then
  179.                begin
  180.                  if in_library then library;
  181.                  if in_arc then arc;
  182.                  clear_heaps;
  183.                  mode := sysop_mode;
  184.                end;
  185.         'Z': toggle_st_switch
  186.     else
  187.       begin
  188.         list('F');
  189.         if user_rec.access>=250 then list('Z');
  190.         if (not macro_in_progress) then
  191.           begin
  192.             mult_cmds:=false;
  193.             cmd_queue:='';
  194.           end;
  195.       end;
  196.     end;
  197.   end;
  198.  
  199.  
  200. Overlay procedure process_utility;
  201.   Begin
  202.     case ch of
  203.          'A': alter_user_params;
  204.          'C': if chat then mesg_enter('S');
  205.          'F': begin
  206.                 clear_heaps;
  207.                 if in_library then LibReadDir(Libentries,Libspace,Libbase)
  208.                 else
  209.                 if in_arc then ArcReadDir(ArcEntries,ArcSpace,ArcBase)
  210.                 else
  211.                 ReadDir(direntries,dirspace,dirbase);
  212.                 new_dir:=false;
  213.                 mode := files_mode;
  214.               end;
  215.          'G': in_use := FALSE;
  216.          'M': begin
  217.                clear_heaps;
  218.                mesg_build_index(areaset);
  219.                mode := message_mode;
  220.              end;
  221.          'S': display_stats;
  222.          'T': display_time;
  223.          'U': display_users;
  224.          'Y': show_user_stats;
  225.          'X': begin
  226.                if (user_rec.access >= 250) or (not remote_copy)
  227.                 then mode := sysop_mode;
  228.               end
  229.     else
  230.       begin
  231.         list('U');
  232.         if (not macro_in_progress) then
  233.           begin
  234.             mult_cmds:=false;
  235.             cmd_queue:='';
  236.           end;
  237.       end;
  238.     end;
  239.   end;
  240.  
  241. Overlay procedure process_sysop;
  242.   Begin
  243.     case ch of
  244.          'A': toggle_audit;
  245.          'B': Make_message;
  246.          'C': config_sys;
  247.          'D': delete_user;
  248.          'E': edit_user('','');
  249.          'F': begin
  250.                 clear_heaps;
  251.                 mode:=files_mode;
  252.                 if in_library then LibReadDir(Libentries,Libspace,Libbase)
  253.                 else
  254.                 if in_arc then ArcReadDir(ArcEntries,ArcSpace,ArcBase)
  255.                 else
  256.                 ReadDir(direntries,dirspace,dirbase);
  257.                 new_dir:=false;
  258.               end;
  259.          'G': in_use := FALSE;
  260.          'I': rebuild_index;
  261.          'L': print_log;
  262.          'M': begin
  263.                clear_heaps;
  264.                mesg_build_index(areaset);
  265.                mode := message_mode;
  266.              end;
  267.          'N': process_newin;
  268.          'O': process_macro;
  269.          'P': purge_files;
  270.          'R': print_messages;
  271.          'S': sys_dir;
  272.          'T': toggle_printer;
  273.          'U': mode := utility_mode;
  274.          'V': validate_user
  275.     else
  276.       begin
  277.         list('X');
  278.         if (not macro_in_progress) then
  279.           begin
  280.             mult_cmds:=false;
  281.             cmd_queue:='';
  282.           end;
  283.       end;
  284.     end;
  285.   end;
  286.  
  287. Overlay Procedure Exit_system;
  288.  
  289.     procedure display_random_quote;     {vdp 1/11/88.  inserted procedure}
  290.       var
  291.         sel : integer;
  292.       begin {procedure display_random_quote}
  293.         if quot_count > 0 then
  294.           begin
  295.             sel := random( quot_count );
  296.             seek( qidx_file, sel );
  297.             read( qidx_file, qidx_rec );
  298.             seek( quot_file, qidx_rec.loc );
  299.  
  300.             quot_rec.text := 'ZZZ';
  301.             writeln(USR);
  302.             while (not eof(quot_file)) and
  303.                   (quot_rec.text <> '') and (not brk) and online do
  304.               begin
  305.                 read( quot_file, quot_rec );
  306.                 writeln(USR, quot_rec.text);
  307.               end;
  308.           end;
  309.       end;  {procedure display_random_quote}
  310.  
  311.   begin
  312.     if in_library then library;
  313.     if in_arc then arc;
  314.     if audit_on then toggle_audit;
  315.     if (user_rec.fn <> 'SYSOP') and online
  316.        then if not valid_pw
  317.          then mesg_enter('S')
  318.        else if ask('Do you have a message for the sysop')
  319.               then mesg_enter('S');
  320.     if logout_quote then                      { vdp 1/18/88 }
  321.       begin                                   { vdp 1/18/88 }
  322.         display_random_quote;                 { vdp 1/18/88 }
  323.         delay( logout_quote_delay );          { vdp 1/18/88 }
  324.       end;                                    { vdp 1/18/88 }
  325.     wrapup;
  326.     setup;
  327.   end;
  328.  
  329. overlay procedure check_300_restrict;
  330.  var t:tad_array;
  331.   begin
  332.     gettad(t);
  333.     if (rate=300) and (restrict300)
  334.     and (t[2]>start_restrict300) and (t[2]<end_restrict300) then
  335.     begin
  336.       writeln(usr);
  337.       writeln(usr,'300 Baud Callers are restricted from ',
  338.       start_restrict300,':00 - ',end_restrict300,':00 hours.');
  339.       writeln(usr,'Please call back outside of these times.');
  340.       remote_online:=false;
  341.       mdhangup;
  342.     end;
  343.   end;
  344.  
  345. {end of PICS3A.inc }
  346.