home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / bbs / pics16.ark / PICS2E.INC < prev    next >
Encoding:
Text File  |  1987-06-06  |  13.3 KB  |  388 lines
  1. { PICS2E.INC - Pascal Integrated Communications System Utility Sub-system }
  2. { 5/25/87 vers 1.6 Copyright 1987 by Les Archambault}
  3.  
  4. overlay procedure display_users;
  5. { Display user file }
  6.   const
  7.     col_width = 19;
  8.   var
  9.     i, colbeg, colend, len,count: integer;
  10.     ch, disp_case, disp_nois: char;
  11.     t: tad_array;
  12.     key: StrName;
  13.     temp_user_rec: user_list;
  14.     str:strtad;
  15.     caller:boolean;
  16.  
  17.   begin   {display users}
  18.    SetSect(HomDrv,HomUsr);
  19.    if (user_rec.access >= 250) or (not remote_copy) then caller:=false
  20.    else caller:=true;
  21.     repeat
  22.     if (not caller) then
  23.       begin
  24.         writeln(usr);
  25.         st := prompt('Type of list <A><B><E><Q><U><?> ',80, 'ES?');
  26.         if length(st)=1 then ch:=st[1]
  27.         else ch:=' ';
  28.         if not(ch in ['A','E','Q','U'])
  29.           then Writeln(USR, '<A>ll, <B>rief, <E>xceptional, <U>n-validated, <Q>uit');
  30.       end
  31.     else
  32.       If user_rec.access>=val_acc then ch:='B'
  33.       else ch:='Q';
  34.     if ch in ['A','B','E','U'] then
  35.     Begin
  36.     Writeln(USR);
  37.     Writeln(USR, 'The user list will be alphabetic by last name,');
  38.     Writeln(USR, 'starting with a character or string you specify.');
  39.     Writeln(USR);
  40.     key := prompt('Start [ <CR> for all names]', len_name, 'ES');
  41.     if key = ' '
  42.       then
  43.         begin
  44.           ClearKey(IdxF);
  45.           NextKey(IdxF, i, key)
  46.         end
  47.       else
  48.         begin
  49.           SearchKey(IdxF, i, key);
  50.           if not OK
  51.             then
  52.               begin
  53.                 ClearKey(IdxF);
  54.                 NextKey(IdxF, i, key)
  55.               end
  56.         end;
  57.     GetTAD(t); Count:=0;
  58.     str := FormTAD(t);
  59.     if ch = 'E'
  60.       then Writeln(USR, 'Exceptional - access, time, exempt from purge.')
  61.     else if ch = 'U'
  62.       then Write(USR, 'Unvalidated ');
  63.     Writeln(USR, 'Users As Of: ', str);
  64.     Writeln(USR);
  65.     if (user_rec.lines<>99) and (not printer_copy) then count:=count+2;
  66.     if (user_rec.access >= 250) or (not remote_copy) then
  67.       begin
  68.         Writeln(USR, FileLen(DatF), ' records, ');
  69.         if (user_rec.lines<>99) and (not printer_copy) then count:=succ(count);
  70.       end;
  71.     if ch<>'B' then Writeln(USR, UsedRecs(DatF), ' users in file.');
  72.     if (user_rec.lines<>99) and (not printer_copy) then count:=succ(count);
  73.     colend := 999;
  74.     while (not brk) and OK do
  75.       with temp_user_rec do
  76.         begin
  77.           GetRec(DatF, i, temp_user_rec);
  78.           if (ch = 'B') and (fn <> 'SYSOP') and (access >= val_acc)
  79.             then
  80.               begin
  81.                 Writeln(usr,pad(ln,succ(len_ln)),' ',pad(fn,succ(len_fn)),
  82.                  '    ',pad(cy,succ(len_cy)),'  ',st);
  83.                 writeln(usr,'Computer: ',pad(ad,succ(len_ad)),' Last on: ',laston[4],
  84.                   '/',laston[3],'/',laston[5]);
  85.                 writeln(usr);
  86.                 if (user_rec.lines <>99) and (not printer_copy) then
  87.                   begin
  88.                     count:=count+3;
  89.                     if count>=user_rec.lines then
  90.                       begin
  91.                         pause; count:=0;
  92.                       end;
  93.                   end;
  94.               end
  95.           else if (ch = 'A')
  96.                or ((ch = 'U') and (access < val_acc))
  97.                or ((ch = 'E') and ((access > val_acc) or (limit > val_time)
  98.                or test_bit(flags,5)))
  99.             then if fn<>'SYSOP' then
  100.               begin
  101.                 Writeln(usr);
  102.                 Writeln(USR,                 {first line}
  103.                   ln,' ',fn,'   ',cy,',',st,'   ',
  104.                   pad(ph, succ(len_ph)),'  ',
  105.                   pad(ad, succ(len_ad)));
  106.  
  107.                 Writeln(usr,                 {second line}
  108.                   'Access:',access:4,
  109.                   '    Time Limit:',limit:4);
  110.  
  111.                 if shift_lock
  112.                   then disp_case := 'U'
  113.                   else disp_case := 'L';
  114.                 if noisy
  115.                   then disp_nois := 'N'
  116.                   else disp_nois := 'Q';
  117.  
  118.                 Write(USR,                   {third line}
  119.                   'Nulls:',nulls:2,
  120.                   '    Case:',disp_case:2,
  121.                   '    Noisy:',disp_nois:2,
  122.                   '    Conferences:');
  123.                   if conf_flags>0 then
  124.                     begin
  125.                       for i:=1 to 7 do
  126.                        if test_bit(conf_flags,i) then write(usr,' ',chr(i+48));
  127.                       writeln(usr);
  128.                     end
  129.                   else writeln(usr,' None');
  130.  
  131.                 Writeln(usr,                 {fourth line}
  132.                   'Cols:',columns:3,
  133.                   '   Lines:',lines:3,
  134.                   '   Last on: ',laston[4],'/',laston[3],'/',laston[5],' ',
  135.                   '   Last msg read:',lasthi:5);
  136.  
  137.                 Write(usr,                   {fourth line}
  138.                   'Uplds:',upload:3,
  139.                   '    Downlds:',download:4,
  140.                   '   Password: ',pw,
  141.                   '   Flags set:');
  142.                   if flags>0 then
  143.                     begin
  144.                       for i:=0 to 7 do
  145.                         if test_bit(flags,i) then write(usr,' ',chr(i+48));
  146.                       writeln(usr);
  147.                     end
  148.                   else writeln(usr,' None');
  149.  
  150.                  if (user_rec.lines<>99) and (not printer_copy) then
  151.                    begin
  152.                      count:=count+6;
  153.                      if count>=user_rec.lines then
  154.                      begin
  155.                        pause; count:=0;
  156.                      end;
  157.                    end;
  158.               end;
  159.           NextKey(IdxF, i, key)
  160.         end;
  161.    end;  {valid command}
  162.    until (ch='Q') or (not online) or caller;
  163.   end;
  164.  
  165. overlay function chat: boolean;
  166. { Chat with sysop }
  167.   var
  168.     ch: char;
  169.     i: integer;
  170.     count: real;
  171.     t: tad_array;
  172.     str: StrStd;
  173.   begin
  174.     OK := op_chat;
  175.     if op_chat
  176.       then Writeln(USR, 'Chat requested by Sysop...', BEL, BEL)
  177.       else
  178.         begin
  179.           GetTAD(t);
  180.           if (not chat_ok) then
  181.             writeln(usr,'Sorry, the Chat function is not active at this time.')
  182.           else
  183.           if (t[2] < ChatStart) or (t[2] > pred(ChatEnd))
  184.             then Writeln(USR, 'Sorry, the hours to chat are ', ChatStart, ':00 to ', ChatEnd, ':00.')
  185.             else
  186.               begin
  187.                 Writeln(USR);
  188.                 Writeln(USR, 'Please standby ', user_rec.fn, ' ', user_rec.ln, '.');
  189.                 Writeln(USR, 'Will ring for 30 seconds.  Type ^C to cancel.');
  190.                 Writeln(USR);
  191.                 Write(USR, '|-------------------------------|', CR, '|');
  192.                 i := 15;
  193.                 repeat
  194.                   Write(BEL, BEL, BEL);           { BEL is not normally sent to console }
  195.                   Write(USR, '-+', BEL);
  196.                   count := 1.17 * lps;       {1.17 is loop speed adjustment}
  197.                   repeat
  198.                     ch := GetChar;
  199.                     count := count - 1.0
  200.                   until (not online) or (count < 0.0) or (ch in [ETX, ESC]);
  201.                   i := pred(i)
  202.                 until (not online) or (i <= 0) or (ch in [ETX, ESC]);
  203.                 Writeln(USR);
  204.                 if ch = ETX
  205.                   then Writeln(USR, 'Cancelled.')
  206.                   else if ch = ESC
  207.                     then
  208.                       begin
  209.                         Writeln(USR, 'Sysop is available.  Type ^C to exit CHAT...');
  210.                         OK := TRUE
  211.                       end
  212.                     else Writeln(USR, 'Sorry, the sysop is not available.')
  213.               end
  214.         end;
  215.     if OK
  216.       then
  217.         begin
  218.           Writeln(USR);
  219.           next_inpstr := '';
  220.           repeat
  221.             str := next_inpstr;
  222.             GetStr(str, ch, len_msg, 'AEW');
  223.             Writeln(USR)
  224.           until (not online) or (ch = ETX);
  225.           chat := FALSE
  226.         end
  227.       else chat := ask('Would you care to leave a message')
  228.   end;
  229.  
  230. overlay procedure display_time;
  231. { Display current system time and date }
  232.   var
  233.     t: tad_array;
  234.     str: StrTAD;
  235.     min,hr,err:integer;
  236.     temp:real;
  237.   begin
  238.     GetTAD(t);
  239.     str := FormTAD(t);
  240.     Writeln(USR, str);
  241.     if (not clock) then
  242.       begin
  243.        writeln(usr);
  244.        hr:=trunc((hour_count/600.0)*(mhz/4.0));
  245.        write(usr,'System thinks time is ',hr,':');
  246.        min:=trunc(frac(hour_count/600)*(mhz/4.0)*60);
  247.        if min<10 then write(usr,'0');
  248.        writeln(usr,min);
  249.        if (user_rec.access>=250)
  250.          then if (ask('Change time adjustment multiplier')) then
  251.          begin
  252.            writeln(usr,'less than 1.0 slows timer,  greater than 1.0 speeds timer');
  253.            writeln(usr,'Present setting is ',time_adjust:2:2);
  254.            st:=prompt('New value',4,'E');
  255.            val(st,temp,err);
  256.            if err=0 then time_adjust:=temp;
  257.          end;
  258.       end;
  259.     if (user_rec.access >= 250) or (not remote_copy)
  260.       then if ask('Do you want to reset the time')
  261.              then
  262.                begin
  263.                  Writeln(USR);              { Change login time so system doesn't hang up on us }
  264.                  login_t[5] := strint(prompt('Year  ', 2, 'E'));
  265.                  login_t[4] := strint(prompt('Month ', 2, 'E'));
  266.                  login_t[3] := strint(prompt('Day   ', 2, 'E'));
  267.                  login_t[2] := strint(prompt('Hour  ', 2, 'E'));
  268.                  login_t[1] := strint(prompt('Minute', 2, 'E'));
  269.                  login_t[0] := strint(prompt('Second', 2, 'E'));
  270.                  SetTAD(login_t);
  271.                  str := FormTAD(login_t);
  272.                  Writeln(USR, str);
  273.                end;
  274.   end;
  275.  
  276. overlay procedure display_stats;
  277.   var
  278.     i, days, max: integer;
  279.     t: tad_array;
  280.     day_array: array[0..23] of integer;
  281.  
  282.   procedure show_graph(title: StrPr);
  283.     var
  284.       i, j: integer;
  285.       factor, scale: real;
  286.       line: StrStd;
  287.     begin
  288.       Writeln(USR, ' ':8, title, ' for the Last ', days, ' Days');
  289.       Writeln(USR);
  290.       factor := max / 15.0;
  291.       for j := 15 downto 1 do
  292.         begin
  293.           line := '                                                                       ';
  294.           scale := factor * j;
  295.           for i := 0 to 23 do
  296.             if day_array[i] > scale
  297.               then
  298.                 begin
  299.                   line[1 + 3 * i] := '*';
  300.                   line[2 + 3 * i] := '*'
  301.                 end;
  302.           Write(USR, scale:3:0);
  303.           i := length(line);
  304.           while line[i] = ' ' do
  305.             i := pred(i);
  306.           Writeln(USR, ' ', copy(line, 1, i))
  307.         end;
  308.       Writeln(USR, '    12  1  2  3  4  5  6  7  8  9 10 11 12  1  2  3  4  5  6  7  8  9 10 11');
  309.       Writeln(USR, '    |------------- A. M. ---------------|------------- P. M. -------------|')
  310.     end;
  311.  
  312.   begin { show_stats }
  313.     GetTAD(t);
  314.     days := round(greg_to_jul(t[3], t[4], t[5]) - greg_to_jul(stat_rec.date[3],
  315.       stat_rec.date[4], stat_rec.date[5]));
  316.     if days = 0
  317.       then days := 1;
  318.     max := 0;
  319.     for i := 0 to 23 do
  320.       begin
  321.         day_array[i] := round((100.0 * stat_rec.busy_per_hour[i]) / (60.0 * days));
  322.         if max < day_array[i]
  323.           then max := day_array[i]
  324.       end;
  325.     show_graph('Percent of Average System Usage by Hour')
  326.   end;
  327.  
  328. overlay procedure alter_user_params;
  329. { Get new user parameters }
  330.   var
  331.     valid, continue: boolean;
  332.     ch: char;
  333.     i: integer;
  334.     temp: string[2];
  335.   begin
  336.     repeat
  337.       continue := false;
  338.       st:=prompt('Parameter <B><C><L><N><P><Q><S><?> ',80, 'ES?');
  339.       if length(st)=1 then ch:=st[1]
  340.       else ch:='?';
  341.       case ch of
  342.         'B': begin
  343.                user_rec.noisy := not user_rec.noisy;
  344.                if user_rec.noisy
  345.                  then Writeln(USR, 'Prompt bell on.')
  346.                  else Writeln(USR, 'Prompt bell off.')
  347.              end;
  348. (*        'C': begin
  349.                Writeln(USR, 'Current characters-per-line setting is ', user_rec.columns, '.');
  350.                temp := prompt('New setting [20-80]', 2, 'ES');
  351.                i := strint(temp);
  352.                if (temp=' ') or (not (i in [20..80]))
  353.                  then Writeln(USR, 'Characters-per-line unchanged.')
  354.                  else user_rec.columns := i
  355.              end;
  356. *)
  357.         'L': begin
  358.                Writeln(USR, 'Current lines-per-page setting is ', user_rec.lines, '.');
  359.                temp := prompt('New setting [10-48 or 99 to inhibit pause]', 2, 'ES');
  360.                i := strint(temp);
  361.                if (temp = ' ') or (not (i in [10..48, 99]))
  362.                  then Writeln(USR, 'Lines-per-page unchanged.')
  363.                  else user_rec.lines := i
  364.              end;
  365.         'N': begin
  366.                Writeln(USR, 'Currently using ', user_rec.nulls, ' nulls.');
  367.                get_nulls
  368.              end;
  369.         'P': begin
  370.                get_old_password('Please enter current password', valid);
  371.                if valid
  372.                  then get_new_password
  373.                  else Writeln(USR, 'Password unchanged.')
  374.              end;
  375.         'Q': continue:=true;
  376.         'S': get_case
  377.        else
  378.              begin
  379.                list('C');
  380.                continue := FALSE;
  381.              end;
  382.       end;
  383.     until (continue) or (not online);
  384.     if online then putrec(datf,user_loc,user_rec);
  385.   end;
  386.  
  387. {end of PICS2E.inc }
  388.