Category : Pascal Source Code
Archive   : JPDOOR32.ZIP
Filename : TRAPEXIT.PAS

 
Output of file : TRAPEXIT.PAS contained in archive : JPDOOR32.ZIP

{$F+}

(* This exit procedure may be used to trap HALT codes. If defined in the
main body of your program (DoorExit := TrapExit), this procedure will be
called whenever your program encounters a HALT code or runtime error.

As shown below, if ErrorAddr <> NIL (no runtime error has occurred) the
runtime error information is displayed to the local console and is also
written to a file called PROG_ERR.LOG. You may wish to change the name
of this error log file to something more fitting to your program.

If ErrorAddr = NIL then this code assumes that no runtime error has
occurred but rather that a HALT code has been encountered. You could
conceivably handle all your HALT functions within the TRAPEXIT procedure.
However, in this demonstration, we can see that we are passing the HALT
code onto the TERMINATE procedure which is located within your program's
code.
*)

PROCEDURE TrapExit;

VAR
ErrFile : TEXT ;


FUNCTION Error_message(Code: INTEGER): STRING;
{return message text for a given runtime error code}
VAR
Class: STRING;
Msg: STRING;
BEGIN
CASE Code OF
1.. 99: Class := 'DOS ERROR :';
100..149: Class := 'I/O ERROR :';
150..199: Class := 'CRITICAL ERROR :';
200..249: Class := 'FATAL ERROR :';
ELSE Class := 'UNKNOWN ERROR :';
END;

CASE Code OF
2: Msg := 'File not found';
3: Msg := 'Path not found';
4: Msg := 'Too many open files';
5: Msg := 'File access denied';
6: Msg := 'Bad file handle';
12: Msg := 'Bad file access code';
15: Msg := 'Bad drive number';
16: Msg := 'Can''t remove current dir';
17: Msg := 'Can''t rename across drives';

100: Msg := 'Disk read error, read past eof on Typed File';
101: Msg := 'Disk write error';
102: Msg := 'File not assigned';
103: Msg := 'File not open';
104: Msg := 'File not open for input';
105: Msg := 'File not open for output';
106: Msg := 'Bad numeric format';

150: Msg := 'Disk is write-protected';
151: Msg := 'Unknown diskette unit';
152: Msg := 'Drive not ready';
153: Msg := 'Unknown command';
154: Msg := 'CRC error in data';
155: Msg := 'Bad drive request structure length';
156: Msg := 'Disk seek error';
157: Msg := 'Unknown diskette type';
158: Msg := 'Sector not found';
159: Msg := 'Printer out of paper';
160: Msg := 'Device write fault';
161: Msg := 'Device read fault';
162: Msg := 'Hardware failure';

200: Msg := 'Division by zero';
201: Msg := 'Range check';
202: Msg := 'Stack overflow';
203: Msg := 'Heap overflow'+' (Not enough memory to run)';
204: Msg := 'Bad pointer operation';
205: Msg := 'Floating point overflow';
206: Msg := 'Floating point underflow';
207: Msg := 'Bad floating point operation';

ELSE STR(Code,Msg);
END;

Error_message := Class + Msg;
END;

FUNCTION Exit_message(Code: INTEGER): STRING;
{return message text for a given exit code}
VAR
Msg: STRING;
BEGIN
CASE Code OF
0: Msg := 'Normal Termination';
1: Msg := 'Carrier Lost';
2: Msg := 'Time Limit Exceeded';
3: Msg := 'User Inactivity Timeout';
4: Msg := 'Cannot Find Dorinfo1.def';
5: Msg := 'Cannot Find ExitInfo.Bbs';
6: Msg := 'Directory Change/Read Error';
7: Msg := 'CTS Timeout';
8: Msg := 'Forced Exit via RAXIT Semaphore';
9: Msg := 'Cannot Find Door.Sys';
ELSE STR(Code,Msg);
END;
Exit_Message := Msg;
END;


FUNCTION Itoh(W: Word): STRING;
{hex conversion}
CONST
Hex: ARRAY[0..15] OF CHAR = '0123456789ABCDEF';
VAR
H: STRING[4];
BEGIN
H[0] := CHR(4);
H[1] := Hex[(W SHR 12) AND $0f];
H[2] := Hex[(W SHR 8) AND $0f];
H[3] := Hex[(W SHR 4) AND $0f];
H[4] := Hex[W AND $0f];
Itoh := H;
END;

BEGIN
IF ErrorAddr = NIL THEN
Begin
If ExitCode = 0 then
Begin
Terminate(0) ;
Exit;
End;
ASSIGN(ErrFile,'PROG_ERR.LOG') ;
IF EXIST('PROG_ERR.LOG') THEN APPEND(ErrFile) ELSE
Begin
REWRITE(ErrFile) ;
If ProductName <> '' then
Begin
Writeln(ErrFile,'Error Log Generated by ',ProductName);
Writeln(ErrFile,' ');
End;
End;
WRITELN('Date : ',DateStr,' At ',TimeStr);
WRITELN('Program Termination');
WRITELN('Node : ',ThisNode);
WRITELN(Exit_Message(Exitcode));

WRITELN(ErrFile,'Date : ',DateStr,' At ',TimeStr);
WRITELN(ErrFile,'Program Termination');
WRITELN(ErrFile,'Node : ',ThisNode);
WRITELN(ErrFile,Exit_Message(Exitcode));
flush(ErrFile) ;
Close(ErrFile) ;

Terminate(ExitCode);
Delay(1000);
End ELSE
BEGIN
ASSIGN(ErrFile,'PROG_ERR.LOG') ;
IF EXIST('PROG_ERR.LOG') THEN APPEND(ErrFile) ELSE REWRITE(ErrFile) ;
WRITELN('Date : ',DateStr,' At ',TimeStr);
WRITELN('Run-time error occurred');
WRITELN('Node : ',ThisNode);
WRITELN('Exitcode = ', exitcode);
WRITELN(Error_Message(Exitcode));
WRITELN('Address of error:');
WRITELN(' Segment: ', ItoH(seg(erroraddr^)));
WRITELN(' Offset: ', ItoH(ofs(erroraddr^))) ;


WRITELN(ErrFile,'Date : ',DateStr,' At ',TimeStr);
WRITELN(ErrFile,'Run-time error occurred');
WRITELN(ErrFile,'Node : ',ThisNode);
WRITELN(ErrFile,'Exitcode = ', exitcode);
WRITELN(ErrFile,Error_Message(Exitcode));
WRITELN(ErrFile,'Address of error:');
WRITELN(ErrFile,' Segment: ', ItoH(seg(erroraddr^)));
WRITELN(ErrFile,' Offset: ', ItoH(ofs(erroraddr^))) ;
flush(ErrFile) ;
Close(ErrFile) ;
END ;
ErrorAddr := NIL ;
END ;
{$F-}