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 / ROSFIL.IQC / ROSFIL.INC
Text File  |  2000-06-30  |  9KB  |  260 lines
  1. { ROSFIL.INC - Remote Operating System File Sub-system }
  2.  
  3. overlay procedure section(req: Str10);
  4. { View and set up section for use }
  5.   var
  6.     i: integer;
  7.     this: SectPtr;
  8.  
  9.   procedure ReadDir(var entries: integer; var first: FilePtr);
  10.   { Create an alphabetized list of files in the current section }
  11.     var
  12.       i, off: integer;
  13.       this: FilePtr;
  14.       searchblk: FileBlock;                 { Buffer to define search params }
  15.       answerblk: array[0..3] of FileBlock;  { Buffer to receive file names }
  16.     begin
  17.       new_dir := TRUE;
  18.       while first <> nil do                 { Clean out any old directory list }
  19.         begin
  20.           this := first;
  21.           first := first^.Next;             { Go to next on chain }
  22.           dispose(this)                     { Reclaim space }
  23.         end;
  24.       DirEntries := 0;
  25.       with searchblk do
  26.         begin
  27.           drive := 0;
  28.           for i := 1 to 11 do
  29.             fname[i] := ord('?');
  30.           extent := ord('?');
  31.           s1     := ord('?');
  32.           s2     := ord('?');
  33.           reccount := 0;
  34.           for i := 16 to 31 do
  35.             map[i] := 0
  36.         end;
  37.       BDOS(setdma, addr(answerblk));
  38.       BDOS(seldrive, SetDrv);               { 'Log in' drive/user }
  39.       BDOS(getseluser, SetUsr);
  40.       off := BDOS(findfirst, addr(searchblk));
  41.       while off <> 255 do
  42.         begin
  43.           with answerblk[off] do
  44.             if (ord(fname[10]) and $80) = 0 { Non-system? }
  45.               then InsertFile(fname, 0, reccount + (extent + (s2 shl 5)) shl 7,
  46.                               entries, first);
  47.           off := BDOS(findnext, addr(searchblk))
  48.         end;
  49.       BDOS(seldrive, HomDrv);               { Restore default drive/user }
  50.       BDOS(getseluser, HomUsr);
  51.       BDOS(setdma, fcb)                     { Restore DMA buffer }
  52.     end;
  53.  
  54.   begin { section }
  55.     if req = ''
  56.       then req := compress(prompt('Section (? for MENU): ', 10, 'ES'));
  57.     writeln(USR);
  58.     while (not new_dir) and (req <> '') do
  59.       begin
  60.         this := SectBase;
  61.         if req = '?'
  62.           then
  63.             begin
  64.               writeln(USR, 'Available file sections:');
  65.               writeln(USR);
  66.               while (not brk) and (this <> nil) do
  67.                 begin
  68.                   if user_rec.access >= this^.SectAccs
  69.                     then writeln(USR, pad(this^.SectName, 14), this^.SectDesc)
  70.                   else if this^.SectAccs < 100
  71.                     then writeln(USR, pad(this^.SectName, 14), 'Validation required');
  72.                   this := this^.next
  73.                 end;
  74.               writeln(USR);
  75.               req := compress(prompt('Section (? for MENU): ', 10, 'AES'));
  76.               writeln(USR)
  77.             end
  78.         else if req <> ''
  79.           then
  80.             begin
  81.               while (req <> this^.SectName) and (this <> nil) do
  82.                 this := this^.next;
  83.               if (req = this^.SectName) and (user_rec.access >= this^.SectAccs)
  84.                 then
  85.                   begin
  86.                     SectReq := req;
  87.                     SetDrv  := this^.SectDrive;
  88.                     SetUsr  := this^.SectUser;
  89.                     ReadDir(DirEntries, DirBase)
  90.                   end
  91.               else if (req = this^.SectName) and (this^.SectAccs < 100)
  92.                 then
  93.                   begin
  94.                     writeln(USR, 'Validation required');
  95.                     writeln(USR);
  96.                     req := compress(prompt('Section (? for MENU): ', 10, 'AES'));
  97.                     writeln(USR)
  98.                   end
  99.                 else
  100.                   begin
  101.                     writeln(USR, '"', req, '" not found.  Available file sections:');
  102.                     writeln(USR);
  103.                     i := 0;
  104.                     this := SectBase;
  105.                     while (not brk) and (this <> nil) do
  106.                       begin
  107.                         if user_rec.access >= this^.SectAccs
  108.                           then
  109.                             begin
  110.                               write(USR, pad(this^.SectName, 12));
  111.                               i := succ(i);
  112.                               if 0 = i mod 6
  113.                                 then writeln(USR)
  114.                             end;
  115.                         this := this^.next
  116.                       end;
  117.                     if 0 <> i mod 6
  118.                       then writeln(USR);
  119.                     writeln(USR);
  120.                     req := compress(prompt('Section (? for MENU): ', 10, 'AES'));
  121.                     writeln(USR)
  122.                   end
  123.             end
  124.       end
  125.   end;
  126.  
  127. overlay procedure library;
  128. { Open and close a library }
  129.   var
  130.     i: integer;
  131.  
  132.   procedure LibReadDir(var entries: integer; var first: FilePtr);
  133.   { Read library directory }
  134.     var
  135.       i, off: integer;
  136.       this: FilePtr;
  137.       LibBlock: array[0..3] of EntryBlock;
  138.     begin
  139.       new_dir := TRUE;
  140.       in_library := TRUE;
  141.       while first <> nil do                 { Clean out any old library list }
  142.         begin
  143.           this := first;
  144.           first := first^.Next;             { Go to next on chain }
  145.           dispose(this)                     { Reclaim space }
  146.         end;
  147.       LibEntries := 0;
  148.       blockread(LibFile, LibBlock, 1);
  149.       for i := 1 to pred(LibBlock[0].fsize shl 2) do
  150.         begin
  151.           off := i mod 4;
  152.           if off = 0
  153.             then blockread(LibFile, LibBlock, 1);
  154.           with LibBlock[off] do
  155.             if status < $FE
  156.               then InsertFile(fname, index, fsize, entries, first)
  157.         end
  158.     end;
  159.  
  160.   begin { library }
  161.     if in_library
  162.       then
  163.         begin
  164.           BDOS(seldrive, SetDrv);           { 'Log in' drive/user }
  165.           BDOS(getseluser, SetUsr);
  166.           Close(LibFile);
  167.           BDOS(seldrive, HomDrv);           { Restore default drive/user }
  168.           BDOS(getseluser, HomUsr);
  169.           writeln(USR, 'Library ', LibReq, ' closed.');
  170.           in_library := FALSE
  171.         end
  172.       else
  173.         begin
  174.           LibReq := compress(prompt('Library: ', 12, 'ES'));
  175.           writeln(USR);
  176.           if LibReq <> ''
  177.             then
  178.               begin
  179.                 if pos('.', LibReq) = 0
  180.                   then LibReq := LibReq + '.LBR';
  181.                 if copy(LibReq, succ(pos('.', LibReq)), 3) = 'LBR'
  182.                   then
  183.                     begin
  184.                       BDOS(seldrive, SetDrv);    { 'Log in' drive/user }
  185.                       BDOS(getseluser, SetUsr);
  186.                       Assign(LibFile, LibReq);
  187.                       {$I-} reset(LibFile) {$I+};
  188.                       if IOresult = 0
  189.                         then LibReadDir(LibEntries, LibBase)
  190.                         else writeln(USR, 'Cannot open ', LibReq);
  191.                       BDOS(seldrive, HomDrv);    { Restore default drive/user }
  192.                       BDOS(getseluser, HomUsr)
  193.                     end
  194.                   else writeln(USR, LibReq, ' is not a library file.')
  195.               end
  196.         end
  197.   end;
  198.  
  199. overlay procedure directory;
  200. { Display section or library directory }
  201.  
  202.   procedure DispDir(entries: integer; this: FilePtr);
  203.   { Display list }
  204.     var
  205.       i, j, mm, ss, size: integer;
  206.       st: Str10;
  207.     begin
  208.       if entries = 0
  209.         then writeln(USR, ' is empty.')
  210.         else
  211.           begin
  212.             writeln(USR, ' contains ', entries, ' files:');
  213.             i := 1;
  214.             while (not brk) and (this <> nil) do
  215.               begin                         { Scan the whole list }
  216.                 if st_switch
  217.                   then
  218.                     begin
  219.                       size := this^.fsize shr 3;
  220.                       if (this^.fsize mod 8) <> 0
  221.                         then size := succ(size);
  222.                       st := intstr(size, 4) + 'k '
  223.                     end
  224.                   else
  225.                     begin
  226.                       send_time(this^.fsize, mm, ss);
  227.                       st := intstr(mm, 3) + ':' + intstr(ss, 2);
  228.                       for j := 3 to length(st) do
  229.                         if st[j] = ' '
  230.                           then st[j] := '0'
  231.                     end;
  232.                 write(USR, this^.fname, st);
  233.                 this := this^.next;         { Go to next on list }
  234.                 if 0 = i mod columns
  235.                   then writeln(USR)
  236.                   else write(USR, fence, ' ');
  237.                 i := succ(i)
  238.               end
  239.           end;
  240.       if 0 <> pred(i) mod columns
  241.         then writeln(USR)
  242.     end;
  243.  
  244.   begin { directory }
  245.     new_dir := FALSE;
  246.     writeln(USR);
  247.     if in_library
  248.       then
  249.         begin
  250.           write(USR, '  Library ', LibReq);
  251.           DispDir(LibEntries, LibBase)
  252.         end
  253.       else
  254.         begin
  255.           write(USR, '  Section ', SectReq);
  256.           DispDir(DirEntries, DirBase)
  257.         end
  258.   end;
  259.  
  260.