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 / BEEHIVE / BBS / ROSUNCR.ARC / ROSFIL.INC < prev    next >
Text File  |  1991-08-11  |  12KB  |  338 lines
  1. { ROSFIL.INC - Remote Operating System: File Sub-system }
  2.  
  3. { 08dec87 wb - Modified so Section file data is accessed from disk instead
  4.   of heap to reduce ram requirement. }
  5.  
  6. overlay procedure toggle_st_switch;
  7. { Toggle file size display }
  8.   begin
  9.     writeln(USR);
  10.     st_switch := not st_switch;
  11.     write(USR, 'File sizes will be shown in ');
  12.     if st_switch
  13.       then writeln(USR, 'bytes, where "k" is 1024.')
  14.       else writeln(USR, 'minutes and seconds of transfer time.')
  15.   end;
  16.  
  17. overlay procedure newin_list;
  18. { List new uploads }
  19.   var
  20.     i, line_count: integer;
  21.     str: StrTAD;
  22.     temp_user_rec: user_list;
  23.   begin
  24.     line_count := 0;
  25.     i := pred(FileSize(nwin_file));
  26.     while (not brk) and (i >= 0) do
  27.       begin
  28.         seek(nwin_file, i);
  29.         read(nwin_file, nwin_rec);
  30.         with nwin_rec do
  31.           begin
  32.             if status = public
  33.               then
  34.                 begin
  35.                   str := FormTAD(date);
  36.                   GetRec(DatF, user, temp_user_rec);
  37.                   writeln(USR);
  38.                   writeln(USR, pad(name, 15), descr);
  39.                   writeln(USR, '   ', pad(str, 30),
  40.                     temp_user_rec.fn, ' ', temp_user_rec.ln);
  41.                   if user_rec.lines <> 99
  42.                     then
  43.                       begin
  44.                         line_count := succ(line_count);
  45.                         if line_count mod (user_rec.lines div 3) = 0
  46.                         then pause
  47.                       end
  48.                 end
  49.           end;
  50.         i := pred(i)
  51.       end
  52.   end;
  53.  
  54. overlay procedure file_area_change(req: Str10);
  55. { View and set up file area for use }
  56.   const
  57.     col_width = 12;
  58.   var
  59.     col_count, col_limit, Drive, User: integer;
  60.     pr: StrPr;
  61.   begin
  62.     col_limit := max(1, user_rec.columns div col_width);
  63.     if req = ''
  64.       then
  65.         begin
  66.           pr := 'File area';
  67.           if user_rec.help_level > 1
  68.             then pr := pr + ' [press "?" for menu]';
  69.           req := prompt(pr, 10, 'ES?')
  70.         end;
  71.     while (not new_dir) and (req <> '') do
  72.       begin
  73.         if req = '?'
  74.           then
  75.             begin
  76.               writeln(USR, 'Available file areas:');
  77.               writeln(USR);
  78.               reset(sect_file);
  79.               while (not brk) and (not eof(sect_file)) do
  80.                 begin
  81.                   readln(sect_file,SDrive,SUser,SAccs,SName,SDesc);
  82.                   if SDrive <> ' ' then
  83.                     if user_rec.access >= SAccs then
  84.                       writeln(USR, pad(SName, 14), SDesc);
  85.                 end;
  86.               writeln(USR);
  87.               req := prompt(pr, 10, 'ES?')
  88.             end
  89.         else if req <> ''
  90.           then
  91.             begin
  92.               FindSect(req, Drive, User, OK);
  93.               if OK
  94.                 then
  95.                   begin
  96.                     SectReq := req;
  97.                     SetDrv  := Drive;
  98.                     SetUsr  := User;
  99.                     ReadDir(DirEntries, DirSpace, DirBase)
  100.                   end
  101.                  else
  102.                   begin
  103.                     writeln(USR, '"', req, '" not found.  Available file areas:');
  104.                     writeln(USR);
  105.                     col_count := 0;
  106.  
  107.                     reset(sect_file);
  108.                     while (not brk) and (not eof(sect_file)) do
  109.                       begin
  110.                         readln(sect_file,SDrive,SUser,SAccs,SName,SDesc);
  111.                         if SDrive <> ' ' then
  112.                           if user_rec.access >= SAccs then
  113.                             begin
  114.                               write(USR, pad(SNAme, col_width));
  115.                               col_count := succ(col_count);
  116.                               if 0 = col_count mod col_limit
  117.                                 then writeln(USR)
  118.                             end;
  119.                       end;
  120.                     if 0 <> col_count mod col_limit
  121.                       then writeln(USR);
  122.                     writeln(USR);
  123.                     req := prompt(pr, 10, 'ES?')
  124.                   end
  125.             end
  126.       end
  127.   end;
  128.  
  129. {  begin
  130.     col_limit := max(1, user_rec.columns div col_width);
  131.     if req = ''
  132.       then
  133.         begin
  134.           pr := 'File area';
  135.           if user_rec.help_level > 1
  136.             then pr := pr + ' [press "?" for menu]';
  137.           req := prompt(pr, 10, 'ES?')
  138.         end;
  139.     while (not new_dir) and (req <> '') do
  140.       begin
  141.         this := SectBase;
  142.         if req = '?'
  143.           then
  144.             begin
  145.               writeln(USR, 'Available file areas:');
  146.               writeln(USR);
  147.               while (not brk) and (this <> nil) do
  148.                 begin
  149.                   if user_rec.access >= this^.SectAccs
  150.                     then writeln(USR, pad(this^.SectName, 14), this^.SectDesc);
  151.                   this := this^.next
  152.                 end;
  153.               writeln(USR);
  154.               req := prompt(pr, 10, 'ES?')
  155.             end
  156.         else if req <> ''
  157.           then
  158.             begin
  159.               FindSect(req, Drive, User, OK);
  160.               if OK
  161.                 then
  162.                   begin
  163.                     SectReq := req;
  164.                     SetDrv  := Drive;
  165.                     SetUsr  := User;
  166.                     ReadDir(DirEntries, DirSpace, DirBase)
  167.                   end
  168.                 else
  169.                   begin
  170.                     writeln(USR, '"', req, '" not found.  Available file areas:');
  171.                     writeln(USR);
  172.                     col_count := 0;
  173.                     this := SectBase;
  174.                     while (not brk) and (this <> nil) do
  175.                       begin
  176.                         if user_rec.access >= this^.SectAccs
  177.                           then
  178.                             begin
  179.                               write(USR, pad(this^.SectName, col_width));
  180.                               col_count := succ(col_count);
  181.                               if 0 = col_count mod col_limit
  182.                                 then writeln(USR)
  183.                             end;
  184.                         this := this^.next
  185.                       end;
  186.                     if 0 <> col_count mod col_limit
  187.                       then writeln(USR);
  188.                     writeln(USR);
  189.                     req := prompt(pr, 10, 'ES?')
  190.                   end
  191.             end
  192.       end
  193.   end;
  194. }
  195.  
  196. overlay procedure library;
  197. { Open and close a library }
  198.   var
  199.     i: integer;
  200.     this: FilePtr;
  201.   begin { library }
  202.     if in_library
  203.       then
  204.         begin
  205.           SetSect(SetDrv, SetUsr);          { Close file }
  206.           Close(libr_file);
  207.           SetSect(HomDrv, HomUsr);
  208.           while LibBase <> nil do           { Clean out old list }
  209.             begin
  210.               this := LibBase;
  211.               LibBase := LibBase^.Next;     { Go to next on chain }
  212.               dispose(this)                 { Reclaim space }
  213.             end;
  214.           in_library := FALSE;
  215.           writeln(USR, 'Library ', LibReq, ' closed.')
  216.         end
  217.       else
  218.         begin
  219.           LibReq := prompt('Library', 12, 'ES');
  220.           delete(LibReq, 1, pos(':', LibReq));
  221.           if LibReq <> ''
  222.             then
  223.               begin
  224.                 if pos('.', LibReq) = 0
  225.                   then LibReq := LibReq + '.LBR';
  226.                 if copy(LibReq, succ(pos('.', LibReq)), 3) = 'LBR'
  227.                   then LibReadDir(LibEntries, LibSpace, LibBase);
  228.                 if not in_library
  229.                   then writeln(USR, 'Cannot open ', LibReq, '.')
  230.               end
  231.         end
  232.   end;
  233.  
  234. overlay procedure directory;
  235. { Display file area or library directory }
  236.   const
  237.     col_width = 19;
  238.   var
  239.     i, j, k, entries, rows, mm, ss, size, col_count, col_limit, line_count: integer;
  240.     this: FilePtr;
  241.     nodes: array[1..4] of FilePtr;
  242.     st: Str10;
  243.     fn: FileName;
  244.   begin
  245.     col_limit := max(1, user_rec.columns div col_width);
  246.     writeln(USR);
  247.     new_dir := FALSE;
  248.     if in_library
  249.       then
  250.         begin
  251.           this := LibBase;
  252.           entries := LibEntries;
  253.           if entries = 0
  254.             then writeln(USR, '   Library: ', LibReq, ' is empty.')
  255.             else writeln(USR, '   Library: ', LibReq, '   Files: ', entries,
  256.                  '   Space used: ', LibSpace, 'k')
  257.         end
  258.       else
  259.         begin
  260.           this := DirBase;
  261.           entries := DirEntries;
  262.           if entries = 0
  263.             then writeln(USR, '   File area: ', SectReq, ' is empty.')
  264.             else write(USR, '   File area: ', SectReq, '   Files: ', entries,
  265.                  '   Space used: ', DirSpace, 'k');
  266.           if user_rec.access >= 250
  267.             then writeln(USR, '   Free: ', free_space, 'k')
  268.             else writeln(USR)
  269.         end;
  270.     line_count := 2;
  271.     if entries > 0
  272.       then
  273.         begin
  274.           rows := entries div col_limit;
  275.           if 0 <> entries mod col_limit
  276.             then rows := succ(rows);
  277.           nodes[1] := this;
  278.           for i := 2 to col_limit do
  279.             begin
  280.               for j := 1 to rows do
  281.                 this := this^.next;
  282.               nodes[i] := this
  283.             end;
  284.           i := 1;
  285.           while (not brk) and (i <= rows) do
  286.             begin
  287.               for j := 1 to col_limit do
  288.                 begin
  289.                   this := nodes[j];
  290.                   if (i + rows * pred(j)) <= entries
  291.                     then
  292.                       begin
  293.                         if st_switch
  294.                           then
  295.                             begin
  296.                               size := this^.fsize shr 3;
  297.                               if (this^.fsize mod 8) <> 0
  298.                                 then size := succ(size);
  299.                               st := intstr(size, 4) + 'k '
  300.                             end
  301.                           else
  302.                             begin
  303.                               send_time(this^.fsize, mm, ss);
  304.                               st := intstr(mm, 3) + ':' + intstr(ss, 2);
  305.                               for k := 3 to length(st) do
  306.                                 if st[k] = ' '
  307.                                   then st[k] := '0'
  308.                             end;
  309.                         fn := this^.fname;
  310.                         if ($80 and ord(fn[11])) <> 0
  311.                           then
  312.                             begin
  313.                               fn[9] := '*'; { Indicate $SYS file }
  314.                               fn[11] := chr($7F and ord(fn[11]))
  315.                             end;
  316.                         write(USR, fn, st);
  317.                         if j < col_limit
  318.                           then write(USR, fence, ' ')
  319.                           else writeln(USR)
  320.                       end
  321.                     else writeln(USR);
  322.                   nodes[j] := nodes[j]^.next   { Go to next on list }
  323.                 end;
  324.               if user_rec.lines <> 99
  325.                 then
  326.                   begin
  327.                     line_count := succ(line_count);
  328.                     if line_count mod user_rec.lines = 0
  329.                       then pause
  330.                   end;
  331.               i := succ(i)
  332.             end
  333.         end;
  334.     if j <> col_limit
  335.       then writeln(USR)
  336.   end;
  337.  
  338.