UNIT _RunError;

     {*****************************************************************}
     {*******  RunError.pas (c)2001 Dutra Lacerda <dulac@ip.pt> *******}
     {*******     RunTime Error Trap Unit for general Usage     *******}
     {*******  Adapted from "Mastering TurboPascal 5.5" by SWAN *******}
     {*****************************************************************}

INTERFACE

Procedure CustomExitInit;
Procedure CustomExitDone;
Function ErrorMSG( Err : integer ): string;

IMPLEMENTATION

VAR
  SavedExitProc : Pointer;

Function ErrorMSG( Err : integer ): string;
  Begin
  case Err of
      1 : ErrorMSG := 'Invalid function number ';
      2 : ErrorMSG := 'File not found ';
      3 : ErrorMSG := 'Path not found ';
      4 : ErrorMSG := 'To many open files ';
      5 : ErrorMSG := 'File access denied ';
      6 : ErrorMSG := 'Invalid file handle ';
     12 : ErrorMSG := 'Invalid file access code ';
     15 : ErrorMSG := 'Invalid drive number ';
     16 : ErrorMSG := 'Cannot remove current directory ';
     17 : ErrorMSG := 'Cannot rename across drives ';
     18 : ErrorMSG := 'No more files ';
    100 : ErrorMSG := 'Disk read error ';
    101 : ErrorMSG := 'Disk write error ';
    102 : ErrorMSG := 'File not assigned ';
    103 : ErrorMSG := 'File not open ';
    104 : ErrorMSG := 'File not open for input ';
    105 : ErrorMSG := 'File not open for output ';
    106 : ErrorMSG := 'Invalid numeric format ';
    150 : ErrorMSG := 'Disk is write protected ';
    151 : ErrorMSG := 'Bad drive request struct length ';
    152 : ErrorMSG := 'Drive not ready ';
    154 : ErrorMSG := 'CRC error in data ';
    156 : ErrorMSG := 'Disk seek error ';
    157 : ErrorMSG := 'Unknown media type ';
    158 : ErrorMSG := 'Sector not found ';
    159 : ErrorMSG := 'Printer out of paper ';
    160 : ErrorMSG := 'Device write fault ';
    161 : ErrorMSG := 'Device read fault ';
    162 : ErrorMSG := 'Hardware failure ';
    200 : ErrorMSG := 'Division by zero ';
    201 : ErrorMSG := 'Range check error ';
    202 : ErrorMSG := 'Stack overflow error ';
    203 : ErrorMSG := 'Heap overflow error ';
    204 : ErrorMSG := 'Invalid pointer operation ';
    205 : ErrorMSG := 'Floating point overflow ';
    206 : ErrorMSG := 'Floating point underflow ';
    207 : ErrorMSG := 'Invalid floating point operation ';
    208 : ErrorMSG := 'Overlay manager not installed ';
    209 : ErrorMSG := 'Overlay file read error ';
    210 : ErrorMSG := 'Object not initialized ';
    211 : ErrorMSG := 'Call to abstract method ';
    212 : ErrorMSG := 'Stream registration error ';
    213 : ErrorMSG := 'Collection index out of range ';
    214 : ErrorMSG := 'Collection overflow error ';
    215 : ErrorMSG := 'Arithmetic overflow error ';
    216 : ErrorMSG := 'General Protection fault ';
    254 : ErrorMSG := 'Invalid File ';
    255 : ErrorMSG := 'Ctrl-Break pressed ';
  else
    ErrorMSG := 'Not defined!';
    end; {CASE}
  End;

{$F+}
Procedure CustomExit;
  { * THIS procedure MUST BE FAR called  * }
  {   This happens naturally with a UNIT   }
  {   PUBLIC procedure, Not with PRIVATE   }
  {   procedures as this one. Use the $F   }
  Begin
    ExitProc  := SavedExitProc;

  If (ErrorAddr = NIL)  and  (ExitCode <> 0) then
    begin
    WriteLn;
    WriteLn( 'Program halted!' );
    WriteLn( 'Error ', ExitCode, ' = ', ErrorMSG(ExitCode) );
    end;

  If (ErrorAddr <> NIL) and (ExitCode = 0) then
    begin
    WriteLn;
    WriteLn( 'Program halted!' );
    WriteLn( 'You pressed Ctrl-C' );
    end;

  If (ErrorAddr <> NIL) and (ExitCode <> 0) then
    begin
    WriteLn;
    WriteLn(#9, #9, 'ÕÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͸');
    WriteLn(#9, #9, '³ ±±±±±±±±±±± Run-Time Error Trap ±±±±±±±±±±± ³');
    WriteLn(#9, #9, 'ÆÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͵');
    WriteLn(#9, #9, '³ *> An unexpected problem has developed...   ³');
    WriteLn(#9, #9, '³                                             ³');
    WriteLn(#9, #9, '³ -> PLEASE write down the following NUMBERS  ³');
    WriteLn(#9, #9, '³    and transmit them with NAME and VERSION  ³');
    WriteLn(#9, #9, '³    of this program to one of the following  ³');
    WriteLn(#9, #9, '³    E-Mail addresses:                        ³');
    WriteLn(#9, #9, '³                                             ³');
    WriteLn(#9, #9, '³     (1st) : dulac@ip.pt                     ³');
    WriteLn(#9, #9, '³     (2nd) : dutra.lacerda@mail.telepac.pt   ³');
    WriteLn(#9, #9, '³                                             ³');
    WriteLn(#9, #9, 'ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
    WriteLn(#9, #9, '  Address = ', seg(ErrorAddr^), ':', ofs(ErrorAddr^), '            ' );
    WriteLn(#9, #9, '    Error = ', ErrorMSG(ExitCode), '           ');
    WriteLn(#9, #9, '     Code = ', ExitCode, '                     ');
    WriteLn(#9, #9, 'ÕÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͸');
    WriteLn(#9, #9, '³ ±±±±±±± Thank You for your support! ±±±±±±± ³');
    WriteLn(#9, #9, 'ÔÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ;');

    ErrorAddr := NIL;
    ExitCode  := 0;
    end;
  end;
{$F-}

Procedure CustomExitInit;
  begin
  SavedExitProc := ExitProc;
  ExitProc      := @CustomExit;
  end;

Procedure CustomExitDone;
  begin
  ExitProc      := SavedExitProc;
  end;


{ *** UNIT INIT *** }

BEGIN
END.