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 / ROS341.ARC / ROSSYX.INC < prev    next >
Text File  |  2000-06-30  |  6KB  |  149 lines
  1. { ROSSYX.INC - Remote Operating System Sysop Sub-system Extended Commands }
  2.  
  3. overlay procedure extended_commands;
  4. { Extended sysop functions - second password required }
  5.   var
  6.     ch_sel: char;
  7.  
  8.   procedure delete_file;
  9.   { Delete file from disk }
  10.     var
  11.       DelName: FileName;
  12.       DelFile: file;
  13.     begin
  14.       DelName := correct_fn(prompt('Name of file to delete', 12, 'ES'));
  15.       if DelName <> ''
  16.         then
  17.           begin
  18.             Assign(DelFile, DelName);
  19.             SetSect(SetDrv, SetUsr);
  20.             {$I-} Reset(DelFile) {$I+};             { Ensure file exists }
  21.             OK := (IOresult = 0);
  22.             if OK
  23.               then
  24.                 begin
  25.                   if ask('Are you sure')
  26.                     then
  27.                       begin
  28.                         Close(DelFile);
  29.                         Erase(DelFile);
  30.                         writeln(USR, DelName, ' deleted.')
  31.                       end
  32.                 end
  33.               else writeln(USR, DelName, ' not found.');
  34.             SetSect(HomDrv, HomUsr)
  35.           end
  36.     end;
  37.  
  38.   procedure copy_file;
  39.   { Copy file from one file area to another }
  40.     var
  41.       DstDrv, DstUsr, Remaining: integer;
  42.       DstSect, SrcName: FileName;
  43.       SrcFile, DstFile: file;
  44.  
  45.     procedure do_copy;
  46.       const
  47.         BufSize = 4;
  48.         BufBytSize = 512;                     { BufSize * 128 }
  49.       var
  50.         NoOfRecsToRead: Integer;
  51.         Buffer: array[1..BufBytSize] of Byte;
  52.       begin
  53.         while OK and (Remaining > 0) do
  54.           begin
  55.             if BufSize <= Remaining
  56.               then NoOfRecsToRead := BufSize
  57.               else NoOfRecsToRead := Remaining;
  58.             SetSect(SetDrv, SetUsr);
  59.             {$I-} BlockRead(SrcFile, Buffer, NoOfRecsToRead) {$I+};
  60.             OK := (IOresult = 0);
  61.             if OK
  62.               then
  63.                 begin
  64.                   SetSect(DstDrv, DstUsr);
  65.                   {$I-} BlockWrite(DstFile, Buffer, NoOfRecsToRead) {$I+};
  66.                   OK := (IOresult = 0);
  67.                   if OK
  68.                     then Remaining := Remaining - NoOfRecsToRead
  69.                     else writeln(USR, 'Write failed.')
  70.                 end
  71.               else writeln(USR, 'Read failed.')
  72.           end
  73.       end;
  74.  
  75.     begin { copy_file }
  76.       SrcName := correct_fn(prompt('Name of file to copy', 12, 'ES'));
  77.       Assign(SrcFile, SrcName);
  78.       SetSect(SetDrv, SetUsr);
  79.       {$I-} Reset(SrcFile) {$I+};           { Ensure file exists }
  80.       OK := (IOresult = 0);
  81.       if OK
  82.         then
  83.           begin
  84.             Remaining := FileSize(SrcFile);
  85.             DstSect := prompt('Destination file area', 10, 'ES');
  86.             FindSect(DstSect, DstDrv, DstUsr, OK);
  87.             if OK
  88.               then
  89.                 begin
  90.                   Assign(DstFile, SrcName);
  91.                   SetSect(DstDrv, DstUsr);
  92.                   {$I-} Reset(DstFile) {$I+};    { Ensure file doesn't already exist }
  93.                   OK := (IOresult <> 0);
  94.                   if OK
  95.                     then
  96.                       begin
  97.                         {$I-} Rewrite(DstFile) {$I+};
  98.                         OK := (IOresult = 0);
  99.                           if OK
  100.                             then
  101.                               begin
  102.                                 do_copy;
  103.                                 SetSect(DstDrv, DstUsr);
  104.                                 {$I-} Close(DstFile) {$I+};
  105.                                 OK := OK and (IOresult = 0);
  106.                                 SetSect(SetDrv, SetUsr);
  107.                                 Close(SrcFile);
  108.                                 if OK
  109.                                   then
  110.                                     begin
  111.                                       writeln(USR, SrcName, ' successfully copied.');
  112.                                       if ask('Delete original file')
  113.                                         then
  114.                                           begin
  115.                                             Erase(SrcFile);
  116.                                             writeln(USR, 'Original file deleted.')
  117.                                           end
  118.                                         else writeln(USR, 'Original file retained.')
  119.                                     end
  120.                                   else
  121.                                     begin
  122.                                       SetSect(DstDrv, DstUsr);
  123.                                       Erase(DstFile);
  124.                                       writeln(USR, 'Copy failed.  Partial file deleted.');
  125.                                       SetSect(SetDrv, SetUsr);
  126.                                     end
  127.                               end
  128.                             else writeln(USR, 'Cannot create file in destination area.')
  129.                       end
  130.                     else writeln('File already exists in destination area.')
  131.                 end
  132.               else writeln(USR, 'Destination section ', DstSect, ' not found.')
  133.           end
  134.         else writeln(USR, 'File ', SrcName, ' not found.');
  135.       SetSect(HomDrv, HomUsr)
  136.     end;
  137.  
  138.   begin { extended_commands }
  139.     repeat
  140.       ch_sel := select('Extended command', 'CopyDeleteQuit');
  141.       case ch_sel of
  142.         'C': copy_file;
  143.         'D': delete_file;
  144.         '?': writeln(USR, '<C>opy, <D>elete, <Q>uit')
  145.       end
  146.     until ch_sel = 'Q'
  147.   end;
  148.  
  149.