home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 15 / CDACTUAL15.iso / cdactual / program / pascal / IOFUNC.ZIP / VIOERR.LIB < prev    next >
Encoding:
Text File  |  1986-04-12  |  3.7 KB  |  71 lines
  1. {           ╔═══╦══════════════════════════════════════════════╦═══╗
  2.             ║   ║         Pascal Library by Scott Wade         ║   ║
  3.             ║   ║           715 FM 1959      Apt 310           ║   ║
  4.             ║   ║           Houston, TX 77034                  ║   ║
  5.      ┌──────╨───╨──────────────────────────────────────────────╨───╨──────┐
  6.      │  This  group of routines is contributed to public domain,  and no  │
  7.      │  one can possibly get any commercial value out of them since they  │
  8.      │  must be used in other programs. I require that if these are used  │
  9.      │  as is in  any  program,  that this banner remain with the source  │
  10.      │  code of the program.  I would appreciate any comments or sugges-  │
  11.      │  tions on improvements, & am curious to hear how these are used.   │
  12.      │  You can leave a message for me on these BBS's:                    │
  13.      │          Ziggy's  821-1391         ScoreBoard  583-7848            │
  14.      │          TBL-COMM 661-9040         Test-Mode   660-9252            │
  15.      └────────────────────────────────────────────────────────────────────┘
  16.  VIOERR.LIB v1.0   File/device IO err trap and message generator
  17.  v1.0: 10/ 1/85 : Original. Returns errflag, errmessage and errnumber if any
  18.        disk IO error occurs. Must be executed immediately after disk IO call.
  19.  v1.1  12/ 7/85 : Put remark statements in the right place & added to msg 02.
  20.  v1.2   4/ 6/86 : Function vTrueIfErr added.  This will print the errmsg, if
  21.        there is one, and returns True if IOErrVal is non-zero.
  22.  
  23.                                                                   }(**)
  24. procedure vIOerr(var IOErrMsg : Buffer ;var IOErrVal : Integer ;
  25.                  var IOErr    : Boolean );
  26. begin
  27.    IOErrVal   := IOresult;
  28.    IOErr      := (IOErrVal <> 0);
  29.    if IOErr then begin
  30.       case IOErrVal of
  31.          $01  :  IOErrMsg := 'File does not exist.';
  32.          $02  :  IOErrMsg := 'File not open for input, or does not exist.';
  33.          $03  :  IOErrMsg := 'File not open for output.';
  34.          $04  :  IOErrMsg := 'File not open.';
  35.          $05  :  IOErrMsg := 'Can''t read from this file.';
  36.          $06  :  IOErrMsg := 'Can''t write to this file.';
  37.          $10  :  IOErrMsg := 'Error in numeric format.';
  38.          $20  :  IOErrMsg := 'Operation not allowed on a logical device.';
  39.          $21  :  IOErrMsg := 'Not allowed in direct mode.';
  40.          $22  :  IOErrMsg := 'Assign to standard files not allowed.';
  41.          $90  :  IOErrMsg := 'Record length mismatch.';
  42.          $91  :  IOErrMsg := 'Seek beyond end of file.';
  43.          $99  :  IOErrMsg := 'Unexpected end of file.';
  44.          $F0  :  IOErrMsg := 'Disk write error.';
  45.          $F1  :  IOErrMsg := 'Directory is full.';
  46.          $F2  :  IOErrMsg := 'File size overflow.';
  47.          $FF  :  IOErrMsg := 'File disappeared.'
  48.       else
  49.          begin
  50.             Str( IOErrVal:3, IOErrMsg);
  51.             IOErrMsg := ConCat('Unknown I/O error:  ', IOErrMsg);
  52.          end{ Case Else Begin };
  53.       end{ Case };
  54.    end{ If IOErr };
  55. end{ IOCheck };
  56.  
  57. Function vTrueIfErr( IOErrVal: integer; IOErrMsg : Buffer ): Boolean ;{
  58. NOTE:  This uses writeln, not yPrnt, so yPrnt programs must set wX to 1
  59.        following this, IF it returns True!   An alternative is to call:
  60.                            yPrnt( wX, '^')
  61.        to force a <CR> before the function call, then don't even worry
  62.        about it afterwards, except to take an errexit if it's True.   }
  63. begin
  64.    If IOErrVal > 0 then begin
  65.       writeln( IOErrMsg );
  66.       vTrueIfErr := True
  67.    end else vTrueIfErr := False ;
  68. end{ F vTrueIfErr };
  69.  
  70. { End of vIOErr.LIB
  71. *****************************************************************************}