[Back to EXEC SWAG index]  [Back to Main SWAG index]  [Original]

{
I have not found this type of unit in the SWAG and thought you might
wish to include it. It has been useful to me.

Brent Herring
Systems Analyst
University of Central Arkansas
brenth@cc1.uca.edu
}

Unit RunTime;

{
  Including this unit in your program should replace all the runtime
  errors with messages that are a bit more helpful than "Runtime
  error 202". Especially helpful when trying to help someone else
  debug a program that you wrote (as if you would write a program
  with a mistake).
}

INTERFACE

Function Hex(Value:byte):string;

IMPLEMENTATION

var OldExit:pointer;

{====================================================================}
Function Hex(Value:byte):string;

const HexTable:array[0..15] of Char=('0','1','2','3','4','5','6','7',
                                     '8','9','A','B','C','D','E','F');

var HexStr : string;

begin
  HexStr[2]:=HexTable[Value and $0F];        { Convert low nibble }
  HexStr[1]:=HexTable[Value and $F0 div 16]; { Convert high nibble }
  HexStr[0]:=#2; { Set Stringlength }
  Hex:=HexStr;
end;
{====================================================================}
{ Try to handle all possible errors }

Procedure RunTimeExitProc;Far;

var Message : string;

begin
  if ErrorAddr<>Nil then { If error occurs }
    begin
        case ExitCode of { Pick the appropriate message }
            2:Message:='File not found ';
            3:Message:='Path not found ';
            4:Message:='Too many open files ';
            5:Message:='File access denied ';
            6:Message:='Invalid file handle ';
            8:Message:='Insufficient memory ';
           12:Message:='Invalid file access code ';
           15:Message:='Invalid drive number ';
           16:Message:='Cannot remove current directory ';
           17:Message:='Cannot rename across drives ';
          100:Message:='Disk read error ';
          100:Message:='Disk write error ';
          102:Message:='File not assigned ';
          103:Message:='File not open ';
          104:Message:='File not open for input ';
          105:Message:='File not open for output ';
          106:Message:='Invalid numeric format ';
          150:Message:='Disk is write-protected ';
          151:Message:='Unknown unit ';
          152:Message:='Drive not ready ';
          153:Message:='Unknown command ';
          154:Message:='CRC error in data ';
          155:Message:='Bad drive request structure length ';
          156:Message:='Disk seek error ';
          157:Message:='Unknown media type ';
          158:Message:='Sector not found ';
          159:Message:='Printer out of paper ';
          160:Message:='Device write fault ';
          161:Message:='Device read fault ';
          162:Message:='Hardware failure ';
          200:Message:='Division by zero ';
          201:Message:='Range check error ';
          202:Message:='Stack overflow error ';
          203:Message:='Heap overflow error ';
          204:Message:='Invalid pointer operation ';
          205:Message:='Floating-point overflow ';
          206:Message:='Floating-point underflow ';
          207:Message:='Invalid floating-point operation ';
          208:Message:='Overlay manager not installed ';
          209:Message:='Overlay file read error ';
          210:Message:='Object not initialized ';
          211:Message:='Call to abstract method ';
          212:Message:='Stream register error ';
          213:Message:='Collection index out of range ';
          214:Message:='Collection overflow error ';
        end;
      writeln('Error:',ExitCode,
              'Segment:',Hex(seg(ErrorAddr^)),
              ' Offset:',Hex(ofs(ErrorAddr^)),
              ' ',Message);
      ErrorAddr:=nil;
      ExitCode:=1;   { End program with errorlevel 1 }
    end;
  ExitProc:=OldExit; { Restore the original exit procedure }
end;
{====================================================================}
begin
  OldExit:=ExitProc;          { Save the original exit procedure }
  ExitProc:=@RunTimeExitProc; { Insert the RunTime exit procedure }
end.

[Back to EXEC SWAG index]  [Back to Main SWAG index]  [Original]