home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / MISCTI10.ZIP / TI114.ASC < prev    next >
Encoding:
Text File  |  1988-05-12  |  9.5 KB  |  294 lines
  1.  
  2.  
  3.  
  4. The  following example routines are public domain  programs  that
  5. have  been uploaded to our Forum on CompuServe.  As a courtesy to
  6. our  users  that  do not have  immediate  access  to  CompuServe,
  7. Technical Support distributes these routines free of charge.
  8.  
  9. However,  because these routines are public domain programs,  not
  10. developed by Borland International,  we are unable to provide any
  11. technical support or assistance using these routines. If you need
  12. assistance   using   these   routines,    or   are   experiencing
  13. difficulties,  we  recommend  that you log  onto  CompuServe  and
  14. request  assistance  from the Forum members that developed  these
  15. routines.
  16.  
  17. Thanks to Marshall Brain for the original code for this routine.
  18.  
  19. These routines provide a method for Turbo Pascal programs to trap
  20. MS-DOS  interrupt 24.   INT 24 is called by DOS when a  "critical
  21. error" occurs, and it normally prints the familiar "Abort, Retry,
  22. Ignore?" message.
  23.  
  24. With  the INT 24 handler installed,  errors of this type will  be
  25. passed  on to Turbo Pascal as an error.   If I/O checking is  on,
  26. this  will  cause  a  program crash.   If I/O  checking  is  off,
  27. IOResult will return an error code.  The global variable INT24Err
  28. will  be  true if an INT 24 error  has  occurred.   The  variable
  29. INT24ErrorCode  will  contain the INT 24 error code as  given  by
  30. DOS.   These  errors can be found in the DOS Technical  Reference
  31. Manual.   They  correspond  to  the error codes returned  by  the
  32. function INT24Result, with an offset of 256.  INT24Result is used
  33. like IOResult,  and calls IOResult.  It then checks INT24Err, and
  34. if it is true, returns INT24ErrorCode+256, instead.
  35.  
  36. In most cases,  INT24Result should be used, because INT24Err must
  37. be set back to false,  and DOS sometimes restores its normal  INT
  38. 24 handler after an error.
  39. -------------------------------------------------------------------
  40. **Note:  Turbo's  normal  IOResult codes (and Turbo Access  error
  41. codes) for MS-DOS DO NOT correspond to I/O error numbers given in
  42. Appendix  I of the Turbo Pascal manual,  or error codes given  in
  43. the  I/O error nn,  PC=aaaa/Program aborted message.   Here is  a
  44. table  of  correspondence  (all numbers are  in  hexadecimal  and
  45. (decimal)):
  46.  
  47.  ----------    -----------------------------------------------
  48.    00 (0)      00 (0)     none
  49.    01 (1)      90 (144)   record length mismatch
  50.    02 (2)      01 (1)     file does not exist
  51.    03 (3)      F1 (241)   directory is full
  52.    04 (4)      FF (255)   file disappeared
  53.    05 (5)      02 (2)     file not open for input
  54.    06 (6)      03 (3)     file not open for output
  55.    07 (7)      99 (153)   unexpected end of file
  56.    08 (8)      F0 (240)   disk write error
  57.    09 (9)      10 (16)    error in numeric format
  58.    0A (10)     99 (153)   unexpected end of file
  59.    0B (11)     F2 (242)   file size overflow
  60.    0C (12)     99 (153)   unexpected end of file
  61.    0D (13)     F0 (240)   disk write error
  62.    0E (14)     91 (145)   seek beyond end of file
  63.    0F (15)     04 (4)     file not open
  64.    10 (16)     20 (32)    operation not allowed on a logical
  65. device
  66.    11 (17)     21 (33)    not allowed in direct mode
  67.    12 (18)     22 (34)    assign to standard files is not allowed
  68.    90 (144)    90 (144)   record length mismatch
  69.  
  70.  
  71. program CriticalError;
  72.  
  73. Const INT24Err     : Boolean=False;
  74.       INT24ErrCode : Byte=0;
  75.       OldINT24     : Array [1..2] Of Integer=(0,0);
  76.  
  77. Var RegisterSet    : Record Case Integer Of
  78.                        1: (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags:
  79. Integer);
  80.                        2: (AL,AH,BL,BH,CL,CH,DL,DH: Byte);
  81.                      End;
  82.  
  83. Procedure INT24;
  84.   Const FCBFuncs: Array [1..6] Of Byte=(14,15,21,22,27,28);
  85.   Begin
  86.     { To understand this routine, you will need to read the
  87. description of
  88.       Interrupt 24h in the DOS manual.  It also helps to examine
  89. and trace the
  90.       generated code under DEBUG. }
  91.     Inline($0E/$0E/$1F/$07/$C6/$06/ INT24Err
  92. /$01/$89/$EC/$83/$C4/$08/
  93.            $89/$F8/$A2/ INT24ErrCode /$58/$B9/$06/$00/$BF/
  94. FCBFuncs /$F2/
  95.            $AE/$75/$04/$B0/$01/$EB/$08/$3C/$39/$B0/$FF/$72/$02/$B0/$83/
  96.            $5B/$59/$5A/$5E/$5F/$89/$E5/$80/$4E/$0A/$01/$5D/$1F/$07/$CF);
  97. {   Turbo:  PUSH BP                    (Save caller's stack frame
  98.             MOV  BP,SP                   Set up this procedure's
  99. stack frame
  100.             PUSH BP                     ?)
  101.     Inline: PUSH CS
  102.             PUSH CS
  103.             POP  DS                    Set DS and ES temporarily
  104. to CS
  105.             POP  ES
  106.             MOV  BYTE [INT24Err],1     Set INT24Err to True 
  107. (CS:)
  108.             MOV  SP,BP                 Get correct SP;  ADD:
  109. Discard saved
  110.             ADD  SP,8                    BP, INT 24h return
  111. address & flags
  112.             MOV  AX,DI                 Get INT 24h error code
  113.             MOV  [INT24ErrCode],AL     Save it in INT24ErrCode
  114.             POP  AX                    Get initial DOS call
  115. number
  116.             MOV  CX,6                  Search for it in FCBFuncs:
  117. is this one
  118.             MOV  DI,Offset FCBFuncs      of the FCB functions
  119. that requires an
  120.             REPNZ SCASB                  error code of 01 in AL?
  121.             JNZ  .1
  122.             MOV  AL,1                  Yes: set it
  123.             JMP  .2
  124.  
  125.  .1      CMP  AL,39h                No: is it an FCB function
  126. that requires
  127.          MOV  AL,0FFh                 AL=FFh (function <39h)? 
  128. Yes: set it.
  129.          JB   .2
  130.          MOV  AL,83h                No: handle call, return error
  131. 83h, call
  132.                                       failed via INT 24h.
  133.                                     The error code (1, FFh or
  134. 83h) is
  135.                                       returned to the Turbo
  136. runtime routine
  137.                                       that called DOS, making it
  138. look like
  139.                                       a simple DOS error.  Turbo
  140. handles
  141.                                       the I/O error.
  142.  .2      POP  BX                    Pop the rest of the registers
  143. saved by
  144.          POP  CX                      the initial INT 21h.
  145.          POP  DX
  146.          POP  SI
  147.          POP  DI
  148.          MOV  BP,SP
  149.          OR   Byte Ptr [BP+0Ah],1   Set the carry flag in the
  150. saved Flags reg.
  151.          POP  BP
  152.          POP  DS
  153.          POP  ES
  154.          IRET                       Return to next instruction:
  155. all regs.
  156.                                       restored, AL=error code,
  157. carry set. }
  158. End;
  159.  
  160.  
  161. Procedure INT24On;  {Enable INT 24 trapping}
  162. Begin
  163.   INT24Err:=False;
  164.   With RegisterSet Do
  165.   Begin
  166.     AX:=$3524;
  167.     MsDos(RegisterSet);
  168.     If (OldINT24[1] Or OldINT24[2]) = 0 Then
  169.     Begin
  170.       OldINT24[1]:=ES;
  171.       OldINT24[2]:=BX;
  172.     End;
  173.     DS:=CSeg;
  174.     DX:=Ofs(INT24);
  175.     AX:=$2524;
  176.     MsDos(RegisterSet);
  177.   End;
  178. End;
  179.  
  180. Procedure INT24Off;  {Disable INT 24 trapping.  Should be done at
  181. the
  182.                       end of the program, if you plan to be
  183. running
  184.                       the program from within the Turbo
  185. compiler.}
  186. Begin
  187.   INT24Err:=False;
  188.   If OldINT24[1]<>0 Then
  189.     With RegisterSet Do
  190.     Begin
  191.       DS:=OldINT24[1];
  192.       DX:=OldINT24[2];
  193.       AX:=$2524;
  194.       MsDos(RegisterSet);
  195.     End;
  196.   OldINT24[1]:=0;
  197.   OldINT24[2]:=0;
  198. End;
  199.  
  200. Function INT24Result: Integer;
  201. Var I : Integer;
  202.  
  203. Begin
  204.   I:=IOResult;
  205.   If INT24Err Then
  206.  
  207.   Begin
  208.     I:=I+256*(INT24ErrCode+1);
  209.     INT24On;
  210.   End;
  211.  
  212.  
  213.   INT24Result:=I;
  214. End;
  215.  
  216.  
  217. {  INT24Result returns all the regular Turbo IOResult codes if no
  218.    critical  error has occurred.   If a critical error,  then the
  219.    following  values are added to the error code from Turbo (each
  220.    is 256 times the INT24ErrorCode value returned by DOS):
  221.  
  222.     512:  Unknown unit                  [internal dos error]
  223.     768:  Drive not ready               [drive door open or bad
  224. drive]
  225.    1024:  Unknown command               [internal dos error]
  226.    1280:  Data error (CRC)              [bad sector or drive]
  227.    1536:  Bad request structure length  [internal dos error]
  228.    1792:  Seek error                    [bad disk or drive]
  229.    2048:  Unknown media type            [bad disk or drive]
  230.    2304:  Sector not found              [bad disk or drive]
  231.    2560:  Printer out of paper          [anything that the
  232. printer
  233.                                          might signal]
  234.    2816:  Write fault                   [character device not
  235. ready]
  236.    3072   Read fault                    [character device not
  237. ready]
  238.    3328:  General failure               [several meanings]
  239.   If you need the IOResult part, use
  240.     I:=INT24Result and 255; [masks out the INT 24 code]
  241.   For the INT 24 code, use
  242.     I:=INT24Result Shr8;    [same as Div 256, except faster]
  243.   INT24Result clears both error codes, so you must assign it  to
  244.   a variable if you want to extract both codes:
  245.     J:=INT24Result;
  246.     Writeln('Turbo IOResult  = ',J And 255);
  247.     Writeln('DOS INT 24 code = ',J Shr 8); }
  248.  
  249.  
  250. { Main program }
  251. { Run this with printer off (or no printer), and nothing in drive
  252. A }
  253.  
  254. Var F : File;
  255.     I : Integer;
  256.  
  257. Procedure PrinterTest;
  258. Begin
  259.   WriteLn(LST,'test');
  260.  
  261.   I:=INT24Result;
  262.   If I<>0 Then
  263.     WriteLn('Printer error: ',I)
  264.   Else
  265.     WriteLn('Printer OK');
  266. End;
  267.  
  268. Procedure FileTest;
  269. Begin
  270.   Assign(F,'A:FILE');
  271.   {$I-}
  272.   Reset(F);
  273.   {$I+}
  274.   I:=INT24Result;
  275.   If I<>0 Then
  276.     WriteLn('Open failure on A:FILE :  INT24Result=',I)
  277.   Else
  278.   begin
  279.     WriteLn('A:FILE exists');
  280.     Close(F);
  281.   end;
  282. End;
  283.  
  284. Begin
  285.   INT24On;
  286.   PrinterTest;
  287.   FileTest;
  288.   PrinterTest;
  289.   INT24Off;
  290.   FileTest;
  291.   PrinterTest;
  292. End.
  293.  
  294.