home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / ROS / ROS32K10.LBR / ROSUTL.IQC / ROSUTL.INC
Text File  |  2000-06-30  |  6KB  |  165 lines
  1. { ROSUTL.INC - Remote Operating System Utility Sub-system }
  2.  
  3. overlay procedure display_users;
  4. { Display "user" file }
  5.   var
  6.     i, colbeg, colend, len: integer;
  7.     ch, disp_case: char;
  8.     t: tad_array;
  9.     key: StrName;
  10.     temp_user_rec: user_list;
  11.   begin
  12.     if user_rec.access = 255
  13.       then ch := select('<A>ll, <U>nvalidated, or <Q>uick:', 'AllUnvalidatedQuick')
  14.       else ch := 'Q';
  15.     GetTAD(t);
  16.     if ch = 'U'
  17.       then writeln(USR, 'Unvalidated users as of: ', FormTAD(t))
  18.       else writeln(USR, 'User file as of: ', FormTAD(t));
  19.     writeln(USR);
  20.     if user_rec.access = 255
  21.       then write(USR, FileLen(DatF), ' records, ');
  22.     writeln(USR, UsedRecs(DatF), ' users in file.');
  23.     colend := len_msg;
  24.     ClearKey(IdxF);
  25.     repeat
  26.       NextKey(IdxF, i, key);
  27.       if OK
  28.         then with temp_user_rec do
  29.           begin
  30.             GetRec(DatF, i, temp_user_rec);
  31.             if (ch = 'Q') and (fn <> 'SYSOP') and (access >= 20)
  32.               then
  33.                 begin
  34.                   key := fn + ' ' + ln;
  35.                   colbeg := colend + 2;
  36.                   while 0 <> colbeg mod 4 do
  37.                     colbeg := succ(colbeg);
  38.                   len := colbeg - colend;
  39.                   colend := colbeg + length(key);
  40.                   if colend > len_msg
  41.                     then
  42.                       begin
  43.                         writeln(USR);
  44.                         colend := length(key)
  45.                       end
  46.                     else write(USR, ' ':len);
  47.                   write(USR, key)
  48.                 end
  49.             else if (ch = 'A') or ((ch = 'U') and (access < 20))
  50.               then
  51.                 begin
  52.                   if case_sw
  53.                     then disp_case := 'L'
  54.                     else disp_case := 'U';
  55.                   writeln(USR,
  56.                     pad(ln, len_ln), ' ',
  57.                     pad(fn, len_fn), ' ',
  58.                     pad(ad, len_ad), ' ',
  59.                     pad(pw, len_pw), ' ',
  60.                     access:3, ' ',
  61.                     nulls:2, ' ',
  62.                     disp_case, ' ',
  63.                     FormTAD(laston):35, ' ',
  64.                     time_today:2, ' ',
  65.                     time_total:4, ' ',
  66.                     lasthi:4, ' ',
  67.                     upload:3, ' ',
  68.                     download:3)
  69.                 end
  70.           end
  71.     until (not OK) or brk
  72.   end;
  73.  
  74. overlay function chat: boolean;
  75. { Chat with sysop }
  76.   var
  77.     ch: char;
  78.     i: integer;
  79.     count: real;
  80.     t: tad_array;
  81.     st: StrStd;
  82.   begin
  83.     OK := FALSE;
  84.     GetTAD(t);
  85.     if (t[2] < ChatStart) or (t[2] > ChatEnd - 1)
  86.       then writeln(USR, 'Sorry, the hours to chat are ', ChatStart, ':00 to ', ChatEnd, ':00.')
  87.       else
  88.         begin
  89.           writeln(USR);
  90.           writeln(USR, 'Please standby ', user_rec.fn, ' ', user_rec.ln, '.');
  91.           writeln(USR, 'Will ring for 30 seconds.  Type ^C to cancel.');
  92.           writeln(USR);
  93.           write(USR, '>------------------------------<', CR, '>');
  94.           i := 15;
  95.           repeat
  96.             write(BEL, BEL, BEL);           { BEL is not normally sent to console }
  97.             write(USR, '->', BEL);
  98.             count := 1.6 * lps;
  99.             repeat
  100.               ch := GetChar;
  101.               count := count - 1.0
  102.             until (not online) or (count < 0.0) or (ch in [ETX, ESC]);
  103.             i := pred(i)
  104.           until (not online) or (i <= 0) or (ch in [ETX, ESC]);
  105.           writeln(USR);
  106.           if ch = ETX
  107.             then writeln(USR, 'Cancelled.')
  108.           else if ch = ESC
  109.             then
  110.               begin
  111.                 OK := TRUE;
  112.                 writeln(USR, 'Sysop is available.  Go ahead (type ^C to exit)...');
  113.                 writeln(USR);
  114.                 repeat
  115.                   GetStr(st, ch, len_msg, 'EA');
  116.                   writeln(USR)
  117.                 until (not online) or (ch = ETX)
  118.               end
  119.             else writeln(USR, 'Sorry, the sysop is not available.')
  120.         end;
  121.     if OK
  122.       then chat := FALSE
  123.       else chat := ask('Would you care to leave a message')
  124.   end;
  125.  
  126. overlay procedure display_time;
  127. { Display current system time and date, time on system, and time remaining. }
  128.   var
  129.     time_on: integer;
  130.     t: tad_array;
  131.     st: StrStd;
  132.   begin
  133.     GetTAD(t);
  134.     st := FormTAD(t);
  135.     writeln(USR, st);
  136.     time_on := 60 * t[2] + t[1] - login_time;
  137.     if time_on < 0
  138.       then time_on := time_on + 1440;
  139.     writeln(USR, 'Time on system: ', time_on, '   ', 'time remaining: ', user_rec.limit - time_on);
  140.     if user_rec.access = 255
  141.       then if ask('Do you want to reset the time')
  142.         then
  143.           begin
  144.             writeln(USR);
  145.             writeln(USR, 'Time and date set routine.  Enter exactly 2 digits, please:');
  146.             writeln(USR);
  147.             t[5] := strint(prompt('Year  : ', 2, 'AE'));
  148.             writeln(USR);
  149.             t[4] := strint(prompt('Month : ', 2, 'AE'));
  150.             writeln(USR);
  151.             t[3] := strint(prompt('Day   : ', 2, 'AE'));
  152.             writeln(USR);
  153.             t[2] := strint(prompt('Hour  : ', 2, 'AE'));
  154.             writeln(USR);
  155.             t[1] := strint(prompt('Minute: ', 2, 'AE'));
  156.             writeln(USR);
  157.             t[0] := strint(prompt('Second: ', 2, 'AE'));
  158.             writeln(USR);
  159.             GetTAD(t);
  160.             st := FormTAD(t);
  161.             writeln(USR, st)
  162.           end
  163.   end;
  164.  
  165.