{ PICS3A.INC  Pascal Integrated Communications System commands processor }
{ 6/8/87 vers 1.6 Copyright 1987 by Les Archambault.}

Overlay Procedure Set_Initial_areas;
   var drive,user:integer;
  begin
    if (not macro_in_progress) and online then
      begin
        pause;
        list('B');
        pause;
        repeat until (not BRK) or (not online);
      end;
    if user_rec.access >= 250 then
      begin
        FindSect('NEWIN',Drive,User,OK);
        SectReq:='NEWIN';
        SetDrv:=Drive;
        SetUsr:=User;
        mesg_area_change('SYSTEM');
        scan_areas;
      end
    else
      begin
        FindSect('LOGIN',Drive,User,OK);
        SectReq:='LOGIN';
        SetDrv:=Drive;
        SetUsr:=User;
        mesg_area_change('POST');
        scan_areas;
      end;
  end;

Overlay Procedure Check_time;
{checks time on system and time left}

begin
  timer(time_on, time_left);
  if time_left <= 0 then
    begin
      writeln(USR, 'Dein Zeit-Limit ist ueberschritten. Ruf bitte morgen wieder an.', BEL, BEL, BEL);
      remote_online := FALSE
    end
  else if time_left <= 5 then
  writeln(USR, 'Nur noch ', intstr(time_left,1), ' Min. bis zum Logout.', BEL);
end;

Overlay Procedure Make_Prompt;

begin
  st := intstr(time_left, 1) + '-' + pr_msg[mode];
  case mode of
    message_mode: st := st + ' ' + AreaReq;
    files_mode  : begin
                    st := st + ' ' + SectReq;
                    if in_library then st := st + ' [' + LibReq + ']';
                    if in_arc then st:=st+' ['+ArcReq+']';
                    if new_dir then directory;
                    if up_down_display then
                       begin
                         Repeat until (not BRK) or (not online);
                         ReadDir(direntries,dirspace,dirbase);
                         directory;
                         writeln(usr);
                         writeln(USR, user_rec.upload, ' Uploads, ',
                         user_rec.download, ' Downloads bis heute.');
                         up_down_display := FALSE;
                       end;
                  end;
  end;
  if (user_rec.access>=250) and Audit_on then st:=st+' (Audit AN) ';
end;

Overlay Procedure Write_status_line;
  begin
    putstat(' ' + user_rec.fn + ' ' + user_rec.ln + '  ' + user_rec.cy +
     '  Access: ' + intstr(user_rec.access, 1) + '  On: ' +
     intstr((time_on+user_rec.time_today), 1) + '  Heap: '
     + intstr(MaxAvail, 1));
  end;

overlay procedure Process_messages;
  begin
    case ch of
         'T': Articles;
         'B': mesg_area_change('');
         'S': begin
                mesg_enter(' ');
                mesg_build_index(AreaSet);
              end;
         'F': begin
                clear_heaps;
                if in_library then LibReadDir(LibEntries,LibSpace,LibBase)
                else
                if in_arc then ArcReadDir(ArcEntries,ArcSpace,ArcBase)
                else
                ReadDir(direntries,dirspace,dirbase);
                new_dir:=false;
                mode := files_mode;
              end;
         'E': in_use := FALSE;
         'K': mesg_quick_scan;
         'L': mesg_read;
         'N': scan_areas;
         'I': mesg_summary;
         'U': begin
                clear_heaps;
                mode := utility_mode;
              end;
         'X': if (user_rec.access >= 250) or (not remote_copy) then
              begin
                clear_heaps;
                mode := sysop_mode;
              end;
         'M': list('B');
         'Y': list('I');
         'C': List_file('OTHERSYS.LST',4,0)
    else
      begin
        list('M');
        if (not macro_in_progress) then
          begin
            mult_cmds:=false;
            cmd_queue:='';
          end;
      end;
    end;
  end;

Overlay procedure Process_files;

  begin
    if (st[1]='H') and (user_rec.access<val_acc) then list('S')
    else
    if ((st='REN') and (user_rec.access>250))  then rename_file
    else
    if ((st='DEL') and (user_rec.access>250))  then delete_file
    else
    if ((st='COPY') and (user_rec.access>250))  then copy_file
    else
    if ((st='STAT') and (user_rec.access>250))  then file_status
    else
    if st='HX' then SendXmodem('X')
    else
    if st='HK' then SendXmodem('K')
    else
    If st='HB' then SendXmodem('B')
    else
    If st='SB' then 
      begin
        if in_arc then arc;
        if in_library then library;
        RecvXmodem('B');
      end
    else
    if st='SX' then
      begin
        if in_arc then arc;
        if in_library then library;
        RecvXmodem('X');
      end
    else
    if st='SK' then
      begin
        if in_arc then arc;
        if in_library then library;
        RecvXmodem('K');
      end
    else
    case ch of
        'A': begin
               if in_library then library;
               arc;
             end;
        'B': begin
               if in_library then library;
               if in_arc then arc;
               file_area_change('')
             end;
        'I': directory;
        'F': find_files;
        'E': in_use := FALSE;
        'L': begin
               if in_arc then arc;
               library;
             end;
        'M': begin
               clear_heaps;
               mesg_build_index(areaset);
               mode := message_mode;
             end;
        'D': newin_list;
        'S': begin
               if in_arc then arc;
               if in_library then library;
               RecvXmodem(user_rec.prot);
             end;
        'H': SendXmodem(user_rec.prot);
        'Z': SendText;
        'U': begin
               if in_library then library;
               if in_arc then arc;
               clear_heaps;
               mode := utility_mode;
             end;
        'X': if (user_rec.access >= 250) or (not remote_copy) then
               begin
                 if in_library then library;
                 if in_arc then arc;
                 clear_heaps;
                 mode := sysop_mode;
               end;
        'G': toggle_st_switch
    else
      begin
        list('F');
        if user_rec.access > 250 then list('Z');
        if (not macro_in_progress) then
          begin
            mult_cmds:=false;
            cmd_queue:='';
          end;
      end;
    end;
  end;


Overlay procedure process_utility;
  Begin
    case ch of
         'P': alter_user_params;
         'O': if chat then mesg_enter('S');
         'A': if user_rec.access < 15 then Benutzer_Eintrag
                  else
                    begin
                    writeln(USR);
                    writeln(USR, 'Aber ', user_rec.fn, '! Schon wieder eintragen ?!?!');
                    writeln(usr);
                    end;
         'F': begin
                clear_heaps;
                if in_library then LibReadDir(Libentries,Libspace,Libbase)
                else
                if in_arc then ArcReadDir(ArcEntries,ArcSpace,ArcBase)
                else
                ReadDir(direntries,dirspace,dirbase);
                new_dir:=false;
                mode := files_mode;
              end;
         'E': in_use := FALSE;
         'M': begin
               clear_heaps;
               mesg_build_index(areaset);
               mode := message_mode;
             end;
         'S': display_stats;
         'Z': display_time;
         'U': display_users;
         'D': show_user_stats;
         'X': begin
               if (user_rec.access >= 250) or (not remote_copy)
                then mode := sysop_mode;
              end
    else
      begin
        list('U');
        if (not macro_in_progress) then
          begin
            mult_cmds:=false;
            cmd_queue:='';
          end;
      end;
    end;
  end;

Overlay procedure process_sysop;
  Begin
    if st='UE' then validate_user
    else
    if ((st='UL') and (user_rec.access > 250)) then delete_user
    else
    if st='UA' then edit_user('','')
    else
    case ch of
         'K': toggle_audit;
         'B': Make_message;
         'C': if (user_rec.access=255) then config_sys
              else writeln(usr, 'Nur lokal von der Konsole aktiv...');
         'F': begin
                clear_heaps;
                mode:=files_mode;
                if in_library then LibReadDir(Libentries,Libspace,Libbase)
                else
                if in_arc then ArcReadDir(ArcEntries,ArcSpace,ArcBase)
                else
                ReadDir(direntries,dirspace,dirbase);
                new_dir:=false;
              end;
         'E': in_use := FALSE;
         'I': if ((user_rec.access=255) and ask('Wirklich Index erneuern'))
              then rebuild_index else writeln(usr, 'Nur lokal von der Konsole aktiv...');
         'P': print_log;
         'M': begin
               clear_heaps;
               mesg_build_index(areaset);
               mode := message_mode;
             end;
         'N': process_newin;
         'O': if (user_rec.access=255) then process_macro
              else writeln(usr, 'Nur lokal von der Konsole aktiv...');
         'R': if (user_rec.access=255) then purge_files
              else writeln(usr, 'Nur lokal von der Konsole aktiv...');
         'L': print_messages;
         'S': sys_dir;
         'D': if (not remote_copy) then toggle_printer
              else writeln(usr, 'Nur lokal von der Konsole aktiv...');
         'U': mode := utility_mode
    else
      begin
        list('X');
        if (not macro_in_progress) then
          begin
            mult_cmds:=false;
            cmd_queue:='';
          end;
      end;
    end;
  end;

Overlay Procedure Exit_system;
  begin
    if in_library then library;
    if in_arc then arc;
    if audit_on then toggle_audit;
    if (user_rec.fn <> 'SYSOP') and online
       then if not valid_pw
         then mesg_enter('S')
       else if ask('Hast Du noch einen Kommentar an den SysOp')
              then mesg_enter('S');
    wrapup;
    setup;
  end;

overlay procedure check_300_restrict;
 var t:tad_array;
  begin
    gettad(t);
    if (rate=300) and (restrict300)
    and (t[2]>start_restrict300) and (t[2]<end_restrict300) then
    begin
      writeln(usr);
      writeln(usr,'300 Baud Anrufer sind in der Zeit von ',
      start_restrict300,':00 bis ',end_restrict300,':00 Uhr nicht zugelassen.');
      writeln(usr,'Ruf bitte noch einmal ausserhalb dieser Zeiten an.');
      remote_online:=false;
      mdhangup;
    end;
  end;

{end of PICS3A.inc }