home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / dos.swg / 0028_IOResult Codes.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-05-25  |  3.5 KB  |  88 lines
  1.  
  2. unit CustExit;
  3. (*--------------------------------------------------------------------------
  4.      Original source code by David Drzyzga, FidoNet 1:2619/209, SysOp of
  5.          =>> CUTTER JOHN'S <<= (516) 234-1737 [HST/DS/v32bis/v32ter]
  6.                   Offered to the public domain 04-04-1994
  7. ---------------------------------------------------------------------------*)
  8. interface
  9. implementation
  10. uses
  11.   Crt;
  12. var
  13.   ExitAddress : pointer;
  14. {$F+}
  15. procedure ErrorExit;
  16. {$F-}
  17. begin
  18.   if ErrorAddr <> Nil then begin
  19.     NormVideo;
  20.     ClrScr;
  21.     Writeln('Program terminated with error number ', ExitCode:3, '.');
  22.       case ExitCode of
  23.         1..18     : write( ^G + 'DOS ERROR: ');
  24.         100..106  : write( ^G + 'I/O ERROR: ');
  25.         150..162,
  26.         200..216  : write( ^G + 'CRITICAL ERROR: ');
  27.       end;
  28.       Case ExitCode of
  29.           1 : Writeln('Invalid function number.');
  30.           2 : Writeln('File not found.');
  31.           3 : Writeln('Path not found.');
  32.           4 : Writeln('Too many open files.');
  33.           5 : Writeln('File access denied.');
  34.           6 : Writeln('Invalid file handle.');
  35.          12 : Writeln('Invalid file access code.');
  36.          15 : Writeln('Invalid drive number.');
  37.          16 : Writeln('Cannot remove current directory.');
  38.          17 : Writeln('Cannot rename across drives.');
  39.          18 : Writeln('No More Files.');
  40.         100 : Writeln('Disk read error.');
  41.         101 : Writeln('Disk write error.');
  42.         102 : Writeln('File not assigned.');
  43.         103 : Writeln('File not open.');
  44.         104 : Writeln('File not open for input.');
  45.         105 : Writeln('File not open for output.');
  46.         106 : Writeln('Invalid numeric format.');
  47.         150 : Writeln('Disk is write-protected.');
  48.         151 : Writeln('Unknown unit.');
  49.         152 : Writeln('Drive not ready.');
  50.         153 : Writeln('Unknown command.');
  51.         154 : Writeln('CRC error in data.');
  52.         155 : Writeln('Bad drive request structure length.');
  53.         156 : Writeln('Disk seek error.');
  54.         157 : Writeln('Unknown media type.');
  55.         158 : Writeln('Sector not found.');
  56.         159 : Writeln('Printer out of paper.');
  57.         160 : Writeln('Device write fault.');
  58.         161 : Writeln('Device read fault.');
  59.         162 : Writeln('Hardware failure.');
  60.         200 : Writeln('Division by zero.');
  61.         201 : Writeln('Range check error.');
  62.         202 : Writeln('Stack overflow error.');
  63.         203 : Writeln('Heap overflow error.');
  64.         204 : Writeln('Invalid pointer operation.');
  65.         205 : Writeln('Floating point overflow.');
  66.         206 : Writeln('Floating point underflow.');
  67.         207 : Writeln('Invalid floating point operation.');
  68.         208 : Writeln('Overlay manager not installed.');
  69.         209 : Writeln('Overlay file read error.');
  70.         210 : Writeln('Object not initialized.');
  71.         211 : Writeln('Call to abstract method.');
  72.         212 : Writeln('Stream registration error.');
  73.         213 : Writeln('Collection index out of range.');
  74.         214 : Writeln('Collection overflow error.');
  75.         215 : Writeln('Arithmetic overflow error.');
  76.         216 : Writeln('General Protection fault.');
  77.       else
  78.         Writeln( ^G + 'Unknown Error.');
  79.       end; { Case }
  80.     ErrorAddr := Nil;
  81.   end;
  82.   Exitproc := ExitAddress;   { Restore original exit address }
  83. end; { ErrorExit }
  84. begin
  85.   ExitAddress := ExitProc;   { Save original exit address    }
  86.   ExitProc    := @ErrorExit; { Install custom exit procedure }
  87. end. { Unit CustExit }
  88.