home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol291 / errors.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-12-22  |  3.2 KB  |  82 lines
  1. { This routine provides english error messages when a program aborts
  2.   due to runtime or IO errors.  To use this routine you must place the
  3.   line :
  4.               ErrorPtr := Ofs(Error);  (* PC/MS-Dos*)
  5.          or   ErrorPtr := Addr(Error); (* CP/M*)
  6.  
  7.   in your main program }
  8.  
  9.  
  10.  
  11. Procedure Error(ErrorNumber, ErrorAddress : Integer);
  12. Type
  13.   Str30   = String[32];
  14. Const
  15.   RtErrNums : array[1..11] of Integer = ($01,$02,$03,$04,$10,$11,$90,$91,
  16.                                        $92,$F0,$FF);
  17.   IOErrNums : array[1..16] of Integer = ($01,$02,$03,$04,$10,$20,$21,$22,
  18.                                        $90,$91,$99,$F0,$F1,$F2,$F3,$FF);
  19.  
  20.   RtErrMess : Array[1..12] of Str30 = ('Floating Point Overflow',
  21.                                        'Division by Zero Attempted',
  22.                                        'Square Root Argument Error',
  23.                                        'Logarithm Argument error',
  24.                                        'String Length Error',
  25.                                        'Invalid String Index',
  26.                                        'Index out of range',
  27.                                        'Scalar or Subrange out of Range',
  28.                                        'Out of Integer Range',
  29.                                        'Overlay File Not Found',
  30.                                        'Heap/Stack collision',
  31.                                        'Unknown Error');
  32.   IOErrMess : Array[1..17] of Str30 = ('File Does Not Exist',
  33.                                        'File Not Open for Input',
  34.                                        'File Not Open for Output',
  35.                                        'File Not Open',
  36.                                        'Error In Numeric Format',
  37.                                        'Operation Not Allowed',
  38.                                        'Not Allowed in Direct Mode',
  39.                                        'Assign to Std Files not allowed',
  40.                                        'Record Length Mismatch',
  41.                                        'Seek Beyond End of File',
  42.                                        'Unexpected End of File',
  43.                                        'Disk Write Error',
  44.                                        'Directory is Full',
  45.                                        'File Size OverFlow',
  46.                                        'Too Many Open Files',
  47.                                        'File Disappeared',
  48.                                        'Unknown Error');
  49.  
  50. Var
  51.   MessNo,I,J : Integer;
  52.   Message    : Str30;
  53. Begin
  54.   J := Lo(ErrorNumber);
  55.   If ErrorNumber > 500  then
  56.     Begin
  57.       MessNo := 12;
  58.       For I  := 1 to 11 do
  59.         If J = RtErrNums[I] then MessNo := I;
  60.       Message := RtErrMess[MessNo];
  61.     End
  62.   Else  If ErrorNumber < 500  then
  63.     Begin
  64.       MessNo := 17;
  65.       For I  := 1 to 16 do
  66.         If J = IOErrNums[I] then MessNo := I;
  67.       Message := IOErrMess[MessNo];
  68.     End;
  69.  
  70.   Gotoxy(1,24);
  71.   Writeln(^G^G^G);
  72.   If ErrorNumber > 500 then
  73.     Writeln(' *** Runtime Error #',J,' Encountered ! ')
  74.   Else
  75.     Writeln(' *** IO Error #',J,' Encountered ! ');
  76.   Writeln(' *** ',Message);
  77.   Writeln(' *** Please call Joe Ryburn at Extension 354 for help ');
  78.   Writeln(' *** Thank you ');
  79.   Writeln;
  80.   Halt
  81. End;
  82.