home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol291 / ioerror.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-12-22  |  2.8 KB  |  82 lines
  1. {$I-,R-}
  2. program TestIOCheck;
  3. {
  4.        The routine IOCheck, along with the global declarations
  5.        IOFlag and IOErr, should be placed in any program where you
  6.        want to handle your own I/O error checking.
  7. }
  8. {***************************** Please Note **************************
  9.  
  10.        The main routine in this program is just a sample of what you
  11.        can do with TestIOCheck.  This sample simply assigns a new file
  12.        ReWrites it and then tries to read from it - which is illegal.
  13.        The error this routine generates is somewhat explanatory of what
  14.        error has actually occured.  Try it - and modify it.  It can be
  15.        a real added benifit to programs you write yourself using files!
  16.  
  17. *********************************************************************}
  18.  
  19. const
  20.   IOVal                : Integer = 0;
  21.   IOErr                : Boolean = False;
  22. var
  23.   InFile               : Text;
  24.   Line                 : string[80];
  25.  
  26. procedure IOCheck;
  27. {
  28.        This routine sets IOErr equal to IOresult, then sets
  29.        IOFlag accordingly.  It also prints out a message on
  30.        the 24th line of the screen, then waits for the user
  31.        to hit any character before proceding.
  32. }
  33. var
  34.   Ch                   : Char;
  35. begin
  36.   IOVal := IOresult;
  37.   IOErr := (IOVal <> 0);
  38.   GotoXY(1,24); ClrEol;        { Clear error line in any case }
  39.   if IOErr then begin
  40.     Write(Chr(7));
  41.     case IOVal of
  42.       $01  :  Write('File does not exist');
  43.       $02  :  Write('File not open for input');
  44.       $03  :  Write('File not open for output');
  45.       $04  :  Write('File not open');
  46.       $05  :  Write('Can''t read from this file');
  47.       $06  :  Write('Can''t write to this file');
  48.       $10  :  Write('Error in numeric format');
  49.       $20  :  Write('Operation not allowed on a logical device');
  50.       $21  :  Write('Not allowed in direct mode');
  51.       $22  :  Write('Assign to standard files not allowed');
  52.       $90  :  Write('Record length mismatch');
  53.       $91  :  Write('Seek beyond end of file');
  54.       $99  :  Write('Unexpected end of file');
  55.       $F0  :  Write('Disk write error');
  56.       $F1  :  Write('Directory is full');
  57.       $F2  :  Write('File size overflow');
  58.       $FF  :  Write('File disappeared')
  59.     else      Write('Unknown I/O error:  ',IOVal:3)
  60.     end;
  61.     Read(Kbd,Ch)
  62.   end
  63. end; { of proc IOCheck }
  64.  
  65. procedure PutLineNum(LineNum : Integer);
  66. {
  67.        This routine tells you which line is being executed,
  68.        so that you can see which statement is causing which
  69.        error.
  70. }
  71. begin
  72.   GotoXY(1,1); ClrEol;
  73.   Write('Executing line #',LineNum)
  74. end; { of proc PutLineNum }
  75.  
  76. begin
  77.   PutLineNum(1); Assign(InFile,'dummy');     IOCheck;
  78.   PutLineNum(2); Rewrite(InFile);            IOCheck;
  79.   PutLineNum(3); Read(Infile,Line);          IOCheck;
  80.   PutLineNum(4); Close(Infile);              IOCheck
  81. end. { of program TestIOCheck }
  82.