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

    RUNTIME.PAS  in EXEC.SWG     0040 03/03 79/89   89%
    es}
    {
      Including this unit in your program should replace all the runtime
      errors with messages that are a bit more helpful than "Runtime error
      202". No special calls are necessary, just include it on your "uses"
      line.
    }

    Unit RunTime;

    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 when error occurs }
        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 DOS SWAG index] [Back to Main SWAG index] [Original]