ftp.barnyard.co.uk/2015.02.ftp.barnyard.co.uk.tar/ftp.barnyard.co.uk/cpm/walnut-creek-CDROM/MBUG/MBUG041.ARC/FILE-IO.MOD

Text File | 1979-12-31 | 6KB | 171 lines

{ GENERALITY : Borland turbo pascal
  APPLICATION AREA : file input / output
  MODULE DESCRIPTION : prompts user to enter the name of a file to be opened
  MODULE NAME : file-io.mod (file input / output module)
  PROCEDURE DESCRIPTIONS :
    io_error_message - displays on the output device the input / output error
      message corresponding to the turbo pascal input / output error message
      number given
    open_input - prompt user to enter the name of a file which is then opened
      for input
    open_output - prompt user to enter the name of a file which is then opened
      for output
  NECESSARY MODULES : none
  NECESSARY DECARATION : the source program must include a type declaration of
     the type file_type eg. TYPE file_type = text;
  SOURCE LANGUAGE : Borland turbo pascal (ver 2)
  WRITTEN : 25 December 1985 - G. Irlam
  LAST MODIFIED : 27 December 1985 - G. Irlam

  COMMENTS :
    Reason for language implementation dependance - standard pascal does not
      allow the testing of the success of an attempted file opening. However
      other portions of code are also non-standard, this is because of
      lazyness.
    A word of warning on turbo pacal input / output. The use of a logical
      device (eg. CON:, TRM:, ..) as an input file will often cause problems.
      The behaviour of these logical devices differs from the standard text
      input file type in that a call to eoln or eof will return its status
      based on the last key pressed prior to the call (normally the status is
      dependent upon the next character to be processed). I am not aware of an
      easy solution to this problem. A normal pascal compiler gets around this
      problem by not returning from an eoln or eof call on an interactive
      device until the next character is known. It is conceivable that a
      similar action could be implemented through use of the keypressed
      function (and possibly buffering) prior to each such call. I have not
      tried this, instead I avoid the use of the logical devices in
      application programs which normally expect input from a disk file and
      do more than simple readlns.}

  TYPE
    fname = string [80];

  PROCEDURE io_error_message (error_number : byte; f_name : fname);

    VAR
      file_name : fname;
      i : integer;

    PROCEDURE name_at_end;
      { Write f_name to output and then a full stop. }

      BEGIN
        IF f_name <> '' THEN
          write (' ', file_name);
        writeln ('.')
      END;

    BEGIN
      write ('IO error -  ');
      IF f_name = '' THEN
        file_name := 'File'
        { Default file name. }
      ELSE
        BEGIN
          file_name := f_name;
          FOR i := 1 TO length (file_name) DO
            file_name [i] := upcase (file_name [i])
        END;
      { Write error message. }
      CASE error_number OF
        $01 :
          writeln (file_name, ' does not exist.');
        $02 :
          writeln (file_name, ' not open for input.');
        $03 :
          writeln (file_name, ' not open for output.');
        $04 :
          writeln (file_name, ' not open.');
        $10 :
          writeln ('Error in numeric format.');
        $20 :
          writeln ('Operation not allowed on a logical device.');
        $21 :
          BEGIN
            write ('Operation not allowed on untyped file');
            name_at_end
          END;
        $22 :
          writeln ('Reassignment of a standard file illegal.');
        $90 :
          BEGIN
            write ('Record length does not match that of file');
            name_at_end
          END;
        $91 :
          BEGIN
            write ('Seek attempted beyond end of file');
            name_at_end
          END;
        $99 :
          writeln (file_name, ' ends unexpectedly.');
        $F0 :
          writeln ('Disk can not be written to.');
        $F1 :
          writeln ('Directory full.');
        $F2 :
          writeln (file_name, ' over-flowed disk space.');
        $FF :
          writeln (file_name, ' has disappeared.')
      END
    END;

PROCEDURE open_input (VAR f : file_type);

  VAR
    io_error : byte;
    filename : string [80];

  BEGIN
    REPEAT
      write ('Enter input filename : ');
      readln (filename);
      assign (f, filename);
{$I-}
      reset (f);
{$I+}
      io_error := ioresult;
      IF io_error > 0 THEN
        io_error_message (io_error, filename)
    UNTIL io_error = 0;
  END;

PROCEDURE open_output (VAR f : file_type);

  VAR
    io_error : byte;
    filename : string [80];
    ch : char;
    i  : integer;

  BEGIN
    REPEAT
      REPEAT
        write ('Enter output filename : ');
        readln (filename);
        assign (f, filename);
{$I-}
        rename (f, filename);
{$I+}
        ch := 'y';
        IF ioresult = 0 THEN
          BEGIN
            FOR i := 1 TO length (filename) DO
              filename [i] := upcase (filename [i]);
            writeln (filename, ' already exists.');
            write ('Overwrite (Y/N)? ');
            REPEAT
              read (kbd, ch)
            UNTIL ch IN ['Y', 'y', 'N', 'n'];
            writeln (upcase (ch))
          END
      UNTIL ch IN ['Y', 'y'];
{$I-}
      rewrite (f);
{$I+}
      io_error := ioresult;
      IF io_error > 0 THEN
        io_error_message (io_error, filename)
    UNTIL io_error = 0
  END;