home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / DESIGN.ZIP / ERR.INC < prev    next >
Encoding:
Text File  |  1988-12-26  |  3.2 KB  |  99 lines
  1. function ToHex(J : word) : String10;
  2.     const
  3.       HexCheck : array[0..15] of char = '0123456789ABCDEF';
  4.  
  5.     var
  6.       I : word;
  7.  
  8.     begin {ToHex}
  9.  
  10.       ToHex[0] := Chr(4);
  11.       for I := 0 to 3 do
  12.     begin
  13.       ToHex[4 - I] := HexCheck[J and $000F];
  14.       J := J shr 4
  15.     end
  16.  
  17.     end;  {ToHex}
  18.  
  19.  
  20.  
  21. {$F+} Procedure CustomExit; {$F-}
  22. Var
  23.    i   : Integer;
  24.    Msg : String80;
  25. Begin
  26.    if ErrorAddr <> NIL then
  27.    Begin
  28.       Make_Window(10,8,70,18,White,Red);
  29.       if ExitCode = 160 then
  30.       begin
  31.          Writeln;
  32.          Write(#7,'     Printer off line. Press ENTER: ');
  33.          Readln;
  34.          ErrorAddr := NIL;      { Cancel runtime error }
  35.          ExitCode  := 0;
  36.          For i := 1 to 5 do
  37.          Remove_Window;
  38.          Main(1)
  39.       end else
  40.       begin
  41.          Close(d); { Close file in case of fatal error. }
  42.          Writeln(#7,' A problem has developed.');
  43.          Writeln(' Address = ',ToHex(Seg(ErrorAddr^)),
  44.          ':',ToHex(Ofs(ErrorAddr^)));
  45.          Case ExitCode of
  46.               2 : Msg := 'File not found';
  47.               3 : Msg := 'Path not found';
  48.               4 : Msg := 'Too many open files';
  49.               5 : Msg := 'File access denied';
  50.               6 : Msg := 'Invalid file handle or damaged file';
  51.              12 : Msg := 'Invalid drive number';
  52.              15 : Msg := 'Invalid drive';
  53.              17 : Msg := 'Cannot rename across drives';
  54.             100 : Msg := 'Disk read error';
  55.             101 : Msg := 'Disk write error';
  56.             102 : Msg := 'File not assigned';
  57.             103 : Msg := 'File not open';
  58.             105 : Msg := 'File not open for output';
  59.             106 : Msg := 'Invalid numeric format';
  60.             150 : Msg := 'Disk is write protected';
  61.             152 : Msg := 'Drive not ready';
  62.             153 : Msg := 'Unknown command';
  63.             154 : Msg := 'CRC error in data';
  64.             155 : Msg := 'Bad drive request structure length';
  65.             156 : Msg := 'Disk seek error';
  66.             157 : Msg := 'Unknown media type';
  67.             158 : Msg := 'Sector not found';
  68.             159 : Msg := 'Printer out of paper';
  69.             160 : Msg := 'Device write fault';
  70.             161 : Msg := 'Device read fault';
  71.             162 : Msg := 'Hardware failure';
  72.             200 : Msg := 'Division by zero';
  73.             202 : Msg := 'Stack overflow error';
  74.             203 : Msg := 'Heap overflow error';
  75.             205 : Msg := 'Floating point overflow';
  76.             206 : Msg := 'Floating pint underflow';
  77.             207 : Msg := 'Invalid floating point operation';
  78.             else
  79.             Msg := 'Undefined error';
  80.          End; { Case }
  81.  
  82.          Writeln(' ', Msg+'.');
  83.          Writeln(' Code    = ',ExitCode);
  84.          Writeln;
  85.          Write(' Press ENTER: ');
  86.          Readln;
  87.          ErrorAddr := NIL;      { Cancel runtime error }
  88.          ExitCode  := 0;
  89.          for i := 1 to 5 do
  90.          Remove_Window;
  91.          Open_File; { Reopen file }
  92.          Main(1);
  93.       end;
  94.       ErrorAddr := NIL;      { Cancel runtime error }
  95.       ExitCode  := 0;
  96.    End; { If }
  97.    ExitProc := SavedExitProc; { Restore saved ExitProc pointer }
  98. End; { CustomExit }
  99.