home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
C!T ROM 2
/
ctrom_ii_b.zip
/
ctrom_ii_b
/
PROGRAM
/
PASCAL
/
STRLIST
/
CRITERR.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-03-11
|
3KB
|
132 lines
{ Plug-in Critical error handler. By Wilbert van Leijen }
Unit CritErr;
Interface
{$IFNDEF VER60 }
*** Version 6.0 of Turbo Pascal required ***
{$ENDIF }
Const
mClass = 90;
mAction = 103;
mLocus = 110;
Var
ExtError : Record { Do NOT change ordering of fields }
Code : Word;
Locus : Byte;
Action : Byte;
Class : Byte;
end;
Procedure GetExtendedError;
Function ExtErrorString(i : Integer) : String;
Implementation
uses Dos;
Var
SaveInt24,
ExitSave : Pointer;
{$S- }
{ Returns some information about an Extended Error Code
Add 90 to the index to get the error class message
Add 103 to the index to get the suggested action message
Add 110 to the index to get the error locus message }
Function ExtErrorString(i : Integer) : String; External;
{$L ERRORSTR.OBJ }
{ Get Extended Error function from DOS. Returns information in the
ExtError structure }
Procedure GetExtendedError; Assembler;
ASM
MOV AH, 59h
XOR BX, BX
INT 21h
CLD
MOV DX, SEG @Data
MOV ES, DX
MOV DI, Offset [ExtError]
{ Store extended error code }
STOSW
{ Store error locus }
MOV AL, CH
STOSB
XCHG AX, BX
{ Store error class and suggested action }
STOSW
end; { GetExtendedError }
{ Critical error interrupt handler, returning extended error }
Procedure Int24Handler; Assembler;
ASM
STI
{ Remove DOS INT 24h handler flags and return address }
ADD SP, 6
{ Get INT 21h AX register, add 150 to the error code
(this will be the value stored in InOutRes) }
POP AX
AND DI, 1Fh
ADD DI, 150
{ DI=error code, undefined for DOS functions not using file handles }
CMP AH, 39h
JAE @1
MOV DI, -1
{ Save error code }
@1: PUSH DI
PUSH CS
CALL Near Ptr GetExtendedError
{ Restore registers, and signal 'Retry' in copy of AX on stack }
MOV BP, SP
OR Byte Ptr [BP+22], 1
POP AX
POP BX
POP CX
POP DX
POP SI
POP DI
POP BP
POP DS
POP ES
IRET
end; { Int24Handler }
Procedure ExitCritErr; Far;
Begin
ExitProc := ExitSave;
SetIntVec($24, SaveInt24);
end; { ExitCritErr }
Begin { CritErr }
ExitSave := ExitProc;
ExitProc := @ExitCritErr;
GetIntVec($24, SaveInt24);
SetIntVec($24, @Int24Handler);
end. { CritErr }