{ ROSRCV.INC - Remote Operating System File Receive Routines }

overlay procedure RecvXmodem;
{ Receive a file using Xmodem protocol }
  const
    maxerr = 10;
  var
    i, block, mm, ss: integer;
    XfrName: FileName;
    XfrFile: untype_file;

  procedure RecvFile;
    var
      CRCmode, timeout, EndOfFile: boolean;
      ch: byte;
      errcnt: integer;

    procedure RecvBlock;
      var
        blocknum, blockcpl: byte;
        mv, vv: integer;
      begin
        blocknum := GetByte(1, timeout);    { Get header }
        blockcpl := not GetByte(1, timeout);
        for i := 1 to 128 do                { Get block }
          Buffer[i] := GetByte(1, timeout);
        mv := GetByte(1, timeout);          { Get verification byte(s) }
        if CRCmode
          then mv := swap(mv) or GetByte(1, timeout);
        OK := (blocknum = blockcpl);
        if OK
          then
            begin
              OK := (blocknum = lo(block));
              if OK
                then
                  begin
                    vv := 0;
                    if CRCmode
                      then
                        begin
                          for i := 1 to 128 do
                            updcrc(vv, Buffer[i]);
                          updcrc(vv, 0);
                          updcrc(vv, 0)
                        end
                      else
                        begin
                          for i := 1 to 128 do
                            vv := vv + Buffer[i];
                          vv := lo(vv)
                        end;
                    OK := (mv = vv);
                    if OK
                      then
                        begin
                          {$I-} blockwrite(XfrFile, Buffer, BufBlocks) {$I+};
                          OK := (IOresult = 0)
                        end
                      else if CRCmode
                        then write('  ++ CRC failed')
                        else write('  ++ Checksum failed')
                  end
                else OK := (blocknum = pred(lo(block)))
            end
          else write('  ++ Block complement mismatch')
      end;

    begin { RecvFile }
      writeln(USR, XfrName, ' will be received in a private area.');
      writeln(USR, diskfree, 'k disk space available.  Please cancel if file is too large.');
      writeln(USR, 'To cancel, type CTRL-X repeatedly.');
      writeln(USR, 'Ready to receive...');
      EndOfFile := FALSE;
      CRCmode := TRUE;
      errcnt := 0;
      block := 1;
      delay(6000);
      repeat
        ch := GetByte(10, timeout);
        case chr(ch) of
          SOH: RecvBlock;
          EOT: EndOfFile := TRUE;
          CAN: begin
                 OK := FALSE;
                 EndOfFile := TRUE
               end;
          else begin
                 OK := FALSE;
                 if timeout
                   then write('  ++ Timeout')
                   else write('  ++ Received ', ch, ', not SOH')
               end
        end;
        if OK
          then
            begin
              if block = 1
                then if CRCmode
                       then writeln('CRC mode selected.')
                       else writeln('Checksum mode selected.');
              write(CR, 'Received block ', block);
              errcnt := 0;
              block := succ(block);
              PutByte(ord(ACK))
            end
          else
            begin
              errcnt := succ(errcnt);
              writeln('.  Error ', errcnt, ' in block ', block, '. ++');
              if block = 1
                then
                  begin
                    if errcnt >= 2                    { Try twice with CRC }
                      then CRCmode := not CRCmode;    {  then alternate mode }
                    if CRCmode
                      then PutByte($7F and ord('C'))
                      else PutByte(ord(NAK))
                  end
                else PutByte(ord(NAK))
            end
      until EndOfFile or (errcnt >= maxerr);
      ch := GetByte(2, timeout);
      writeln(USR)
    end;

  begin { RecvXmodem }
    XfrName := compress(prompt('File name: ', 12, 'ES'));
    writeln(USR);
    delete(XfrName, 1, pos(':', XfrName));
    i := pos('.', XfrName);
    if (i = 1) or (i > 9) or ((i = 0) and (length(XfrName) > 8))
      then writeln(USR, XfrName, ' is an invalid file name, please select another.')
    else if XfrName <> ''
      then
        begin
          log(4, XfrName);
          SetSect(RcvDrv, RcvUsr);
          Assign(XfrFile, XfrName);
          {$I-} Reset(XfrFile) {$I+};       { Ensure file doesn't already exist }
          OK := (IOresult <> 0);
          if OK
            then
              begin
                {$I-} Rewrite(XfrFile) {$I+};    { Try to open file }
                OK := (IOresult = 0);
                if OK
                  then
                    begin
                      RecvFile;
                      Close(XfrFile);
                      if OK
                        then hide_release(XfrName, 'H')
                        else
                          begin
                            Erase(XfrFile);
                            writeln(USR, 'Transfer cancelled.  Incomplete file deleted.')
                          end
                    end
                  else writeln(USR, 'Cannot create ', XfrName, '.')
              end
            else
              begin
                Close(XfrFile);
                writeln(USR, XfrName, ' already exists, please select another name.')
              end;
          SetSect(HomDrv, HomUsr);
          if OK
            then
              begin
                log(7, '');
                send_time(block, mm, ss);
                extra_time := extra_time + mm;
                user_rec.upload := succ(user_rec.upload);
                writeln(USR, 'Transfer complete.');
                writeln(USR, 'Please enter a one line description of your file:');
                writeln(USR);
                writeln(USR, '|------------------------------------------------|');
                with nwin_rec do
                  begin
                    status := 0;
                    name := XfrName;
                    GetTAD(t);
                    user := user_loc;
                    descr := prompt('', 50, 'E');
                    writeln(USR)
                  end;
                seek(nwin_file, FileSize(nwin_file));
                write(nwin_file, nwin_rec);
                writeln(USR, 'Thanks, ', user_rec.fn, '!')
              end
            else log(8, '')
        end
  end;