[fpc-pascal]error messages

[Adam Naumowicz]

On Tue, 19 Sep 2000, Sidney Cave wrote:

> Thanks to Adam Naumowicz for the hint on using
> ExitProc for generating descriptive error messages. I
> gave that a try and it seems to work fine. This was my
> first attempt at writing a unit, and some of this was
> by trial and error. If anyone who is interested would
> please let me know if I did anything wrong, I would
> appreciate it.
> 
> Also, is there a procedure for forcing a program to
> generate an error of a given type? I took a look at
> the docs and could not find anything. It may be there,
> but I just don't know what it is called to even to run
> a search. I would hesitate to call this little project
> done until I could test it by forcing all of the
> various errors. As it stands, I only checked two or
> three.
> 
> Sid Cave
> ======================================
> unit ErrorMsg;
> interface
> implementation
> var
>   OldExitProc:pointer;
> 
> procedure ErrorMessage;
> begin
>   if ErrorAddr <> nil then
>     begin
>       case ExitCode of
>         1: writeln ('Invalid function number.');
>         2: writeln ('File not found.');
>         3: writeln ('Path not found.');
>         4: writeln ('Too many open files.');
>         5: writeln ('File access denied.');
>         6: writeln ('Invalid file handle.');
>         12: writeln ('Invalid file access code.');
>         15: writeln ('Invalid drive number.');
>         16: writeln ('Cannot remove current
> directory.');
>         17: writeln ('Cannot rename across drives');
>         100: writeln ('Disk read error.');
>         101: writeln ('Disk write error.');
>         102: writeln ('File not assigned.');
>         103: writeln ('File not open.');
>         104: writeln ('File not open for input.');
>         105: writeln ('File not open for output.');
>         106: writeln ('Invalid numeric format.');
>         150: writeln ('Disk is write-protected.');
>         151: writeln ('Bad drive request struct
> length.');
>         152: writeln ('Drive not ready.');
>         154: writeln ('CRC error in data.');
>         156: writeln ('Disk seek error.');
>         157: writeln ('Unknown media type.');
>         158: writeln ('Sector not found.');
>         159: writeln ('Printer out of paper.');
>         160: writeln ('Device write fault.');
>         161: writeln ('Device read fault.');
>         162: writeln ('Hardware failure.');
>         200: writeln ('Division by zero.');
>         201: writeln ('Range check error.');
>         202: writeln ('Stack overflow error.');
>         203: writeln ('Heap overflow error.');
>         204: writeln ('Invalid pointer operation');
>         205: writeln ('Floating point overflow.');
>         206: writeln ('Floating point underflow.');
>         207: writeln ('Invalid floating point
> operation.');
>         210: writeln ('Object not initialized.');
>         211: writeln ('Call to abstract method.');
>         212: writeln ('Stream registration error.');
>         213: writeln ('Collection index out of
> range.');
>         214: writeln ('Collection overflow error.');
>         216: writeln ('General protection fault.');
>         217: writeln ('Unhandled exception
> occurred.');
>         227: writeln ('Assertion failed error.');
>         else writeln ('Unknown error.');
>       end;
>     end;
>   Exitproc:=OldExitProc;
> end;
> 
> begin
>   OldExitProc:=ExitProc;
>   ExitProc:=@ErrorMessage;
> end.
> ===================================
> 
> 
> =====
> Sid Cave
> mailto:zcave at yahoo.com

I don't know if in this situation it is really importent or being just a
programming prejudice (at least old good TP help says so), that the first
statement in your exit procedure should reinstall the saved one. So maybe
you should place your ExitProc:=OldExitProc at the beginning of
ErrorMessage.
If you want to test your program just try calling RunError with all error
codes.

Adam Naumowicz

--------------------------------------
WWW: http://math.uwb.edu.pl/~adamn/
--------------------------------------