dave@tygra.ddmi.com (David Conrad) (01/07/91)
I've received many email requests for this, so I'm posting it
here in comp.lang.pascal. The following is my Runtime Error
unit which turns runtime error message of the form:
Runtime error 205 at 24C0:00E1.
into error messages of the form:
Fatal error: Floating point overflow at 24C0:00E1.
The lines:
Assign (output,'');
Rewrite (output);
...
Close (output);
in procedure SwanSong are not really necessary, but are there to insure
that the string is written to the stdout file handle and not directly to
the screen. You could remove this, or change the first line to:
Assign (output,'CON:');
to force the output to go to the console even if stdout is redirected.
Other changes might be to make sure that the screen is in text mode
and on page one, or that some strange window hasn't been defined.
(E.g. window (1,1,2,2); .)
Cut the following out and place it into the file runtmerr.pas. Note that
in uses another unit, tools. The source for tools follows the source for
runtmerr. To use this unit, do just that:
Program RunErrTest;
Uses RunTmErr;
Const zero : integer = 0;
begin
writeln (1 / zero);
end.
Copyright: I, David R. Conrad, assert that I am the sole author of these
programs, and I hereby place them into the Public Domain. These programs
cannot be copyrighted. Not by me, not by you, not by anyone. They may
be freely copied, and it would be unethical to charge any price for them
beyond a small, reasonable fee for shipping and handling should they be
made available through the mail.
Have fun. And if there are additional error codes in TP 6.0, I'd be
grateful if someone could post the numbers and the exact text of the
error messages so I could extend this unit to cover them. (By exact
text I mean the text displayed by the IDE if the program
Begin
RunError (211);
End.
is run under it. The last error message in 5.5 is 210 'Object not
initialized'. Thanks.)
BEGIN--cut here--cut here
{$A+,B-,D-,E-,F-,I-,L-,N-,O-,R-,S+,V-}
Unit RunTmErr;
{by David R. Conrad January, 1991 Public Domain}
Interface
Uses Tools;
Function ErrorMsg (Err : Integer) : String;
Function ErrorTyp (Err : Integer) : String;
Implementation
Const
min = 1;
max = 210;
Function ErrorMsg (Err : Integer) : String;
begin
case Err of
1 : ErrorMsg := 'Invalid DOS function code';
2 : ErrorMsg := 'File not found';
3 : ErrorMsg := 'Path not found';
4 : ErrorMsg := 'Too 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';
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 := 'Unknown unit';
152 : ErrorMsg := 'Drive not ready';
153 : ErrorMsg := 'Unknown command';
154 : ErrorMsg := 'CRC error in data';
155 : ErrorMsg := 'Bad drive request structure length';
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';
else
ErrorMsg := 'Runtime error';
end;
end;
Function ErrorTyp (Err : Integer) : String;
begin
case Err of
min..17 : ErrorTyp := 'DOS';
100..106 : ErrorTyp := 'I/O';
150..162 : ErrorTyp := 'Critical';
200..max : ErrorTyp := 'Fatal';
else
ErrorTyp := 'Error';
end;
end;
var
ExitSave : Pointer;
{$F+}
Procedure SwanSong;
begin
ExitProc := ExitSave;
If (ErrorAddr <> nil) and (ExitCode >= min) and (ExitCode <= max) then
begin
assign (output,'');
rewrite (output);
writeln (ErrorTyp(ExitCode),' error: ',ErrorMsg(ExitCode)
,' at ',PtrStr(ErrorAddr),'.');
ErrorAddr := nil;
close (output);
end;
end;
{$F-}
begin
ExitSave := ExitProc;
ExitProc := @SwanSong;
end.
END--cut here--cut here
The following is an abbreviated version of my tools.pas file,
containing only those routines needed by runtmerr.pas. Many
of my programs begin with the line `uses tools', so, as you can
see, they are quite advanced. :-) I wish pascal allowed
#defines like c so I could have:
#define does uses
uses tools;
does windows;
:-) Cut out the following and place it in the file tools.pas.
BEGIN--cut here--cut here
{$A+,B-,D-,E-,F-,I+,L-,N-,O-,R-,S+,V-}
Unit Tools;
{by David R. Conrad January, 1991 Public Domain}
Interface
Const
hexit : array[0..15] of char = ('0','1','2','3','4','5','6','7','8','9',
'A','B','C','D','E','F');
Function HexW (W : Word) : String;
Function PtrStr (P : Pointer) : String;
Implementation
Function HexW (W : Word) : String;
var
v,x,y,z : integer;
begin
v := hi(w) shr 4;
x := hi(w) and $0F;
y := lo(w) shr 4;
z := lo(w) and $0F;
HexW := hexit[v] + hexit[x] + hexit[y] + hexit[z];
end;
Function PtrStr (P : Pointer) : String;
type
PtrRec = record
offset,segment : word;
end;
begin
PtrStr := HexW(PtrRec(P).segment) + ':' + HexW(PtrRec(P).offset);
end;
End.
END--cut here--cut here
--
David R. Conrad | "The good book says it's better to give than
dave@tygra.ddmi.com | to receive,
uunet!tygra!dave | I do my best to do my part.
Moore Software | Nothing in my pockets, I've got nothing up
432 Alter Rd. | my sleeve,
Detroit, MI | I keep my magic in my heart."
48215-3105 USA | -- Triumph
--
= CAT-TALK Conferencing Network, Computer Conferencing and File Archive =
- 1-313-343-0800, 300/1200/2400/9600 baud, 8/N/1. New users use 'new' -
= as a login id. AVAILABLE VIA PC-PURSUIT!!! (City code "MIDET") =
E-MAIL Address: dave@DDMI.COM