{ ROSSYX.INC - Remote Operating System Sysop Sub-system Extended Commands }

overlay procedure extended_commands;
{ Extended sysop functions - second password required }
  var
    ch_sel: char;

  procedure delete_file;
  { Delete file from disk }
    var
      DelName: FileName;
      DelFile: file;
    begin
      DelName := correct_fn(prompt('Name of file to delete', 12, 'ES'));
      if DelName <> ''
        then
          begin
            Assign(DelFile, DelName);
            SetSect(SetDrv, SetUsr);
            {$I-} Reset(DelFile) {$I+};             { Ensure file exists }
            OK := (IOresult = 0);
            if OK
              then
                begin
                  if ask('Are you sure')
                    then
                      begin
                        Close(DelFile);
                        Erase(DelFile);
                        writeln(USR, DelName, ' deleted.')
                      end
                end
              else writeln(USR, DelName, ' not found.');
            SetSect(HomDrv, HomUsr)
          end
    end;

  procedure copy_file;
  { Copy file from one file area to another }
    var
      DstDrv, DstUsr, Remaining: integer;
      DstSect, SrcName: FileName;
      SrcFile, DstFile: file;

    procedure do_copy;
      const
        BufSize = 4;
        BufBytSize = 512;                     { BufSize * 128 }
      var
        NoOfRecsToRead: Integer;
        Buffer: array[1..BufBytSize] of Byte;
      begin
        while OK and (Remaining > 0) do
          begin
            if BufSize <= Remaining
              then NoOfRecsToRead := BufSize
              else NoOfRecsToRead := Remaining;
            SetSect(SetDrv, SetUsr);
            {$I-} BlockRead(SrcFile, Buffer, NoOfRecsToRead) {$I+};
            OK := (IOresult = 0);
            if OK
              then
                begin
                  SetSect(DstDrv, DstUsr);
                  {$I-} BlockWrite(DstFile, Buffer, NoOfRecsToRead) {$I+};
                  OK := (IOresult = 0);
                  if OK
                    then Remaining := Remaining - NoOfRecsToRead
                    else writeln(USR, 'Write failed.')
                end
              else writeln(USR, 'Read failed.')
          end
      end;

    begin { copy_file }
      SrcName := correct_fn(prompt('Name of file to copy', 12, 'ES'));
      Assign(SrcFile, SrcName);
      SetSect(SetDrv, SetUsr);
      {$I-} Reset(SrcFile) {$I+};           { Ensure file exists }
      OK := (IOresult = 0);
      if OK
        then
          begin
            Remaining := FileSize(SrcFile);
            DstSect := prompt('Destination file area', 10, 'ES');
            FindSect(DstSect, DstDrv, DstUsr, OK);
            if OK
              then
                begin
                  Assign(DstFile, SrcName);
                  SetSect(DstDrv, DstUsr);
                  {$I-} Reset(DstFile) {$I+};    { Ensure file doesn't already exist }
                  OK := (IOresult <> 0);
                  if OK
                    then
                      begin
                        {$I-} Rewrite(DstFile) {$I+};
                        OK := (IOresult = 0);
                          if OK
                            then
                              begin
                                do_copy;
                                SetSect(DstDrv, DstUsr);
                                {$I-} Close(DstFile) {$I+};
                                OK := OK and (IOresult = 0);
                                SetSect(SetDrv, SetUsr);
                                Close(SrcFile);
                                if OK
                                  then
                                    begin
                                      writeln(USR, SrcName, ' successfully copied.');
                                      if ask('Delete original file')
                                        then
                                          begin
                                            Erase(SrcFile);
                                            writeln(USR, 'Original file deleted.')
                                          end
                                        else writeln(USR, 'Original file retained.')
                                    end
                                  else
                                    begin
                                      Erase(DstFile);
                                      writeln(USR, 'Copy failed.  Partial file deleted.')
                                    end
                              end
                            else writeln(USR, 'Cannot create file in destination area.')
                      end
                    else writeln('File already exists in destination area.')
                end
              else writeln(USR, 'Destination section ', DstSect, ' not found.')
          end
        else writeln(USR, 'File ', SrcName, ' not found.');
      SetSect(HomDrv, HomUsr)
    end;

  begin { extended_commands }
    repeat
      ch_sel := select('Extended command', 'CopyDeleteQuit');
      case ch_sel of
        'C': copy_file;
        'D': delete_file;
        '?': writeln(USR, '<C>opy, <D>elete, <Q>uit')
      end
    until ch_sel = 'Q'
  end;