home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 December / simtel1292_SIMTEL_1292_Walnut_Creek.iso / msdos / computpc / comp8802.arc / ERRORPRF.PAS < prev    next >
Pascal/Delphi Source File  |  1987-05-02  |  4KB  |  114 lines
  1. {$I-}
  2. Program Error_proof;
  3. {        Programmer : Doug Burger         1 May 87
  4.          Purpose    : Set up a way for Turbo Pascal programs to
  5.                       detect when a critical error occurs
  6.  
  7.   The following assembler code works as follows:
  8.   Execution of the code begins when MS-DOS encounters a
  9.   critical error, i.e. when the disk drive door is left open.
  10.  
  11.   1.  The return address (IP & CS), flags, and AX register are removed from
  12.       the stack.  The address is the return point within the Int 21h code.
  13.   2.  The error code in DI is converted into an MS-DOS System extended
  14.       error code and put in AX.
  15.   3.  The user's registers at the time of the original Int 21h call
  16.       are restored.
  17.   4.  The error code is put into a Turbo variable, whose address is
  18.       added to the code in the initialization procedure.
  19.   5.  FF is put into AL as an error flag similar to the older
  20.       functions.
  21.   6.  The Interrupt Flag is set; the Carry Flag is set as an error
  22.       flag of the newer functions occurred.
  23.   7.  Execution returns to the original caller of Int 21h.  The original
  24.       flags are not returned in order for the Carry Flag to be effective.
  25. }
  26. const int24 : array[1..27] of byte = ($83,$C4,$08,  {   add  SP,8            }
  27.                                      $8B,$C7,       {   mov  AX,DI           }
  28.                                      $05,$13,$00,   {   add  AX,19d          }
  29.                                      $5B,           {   pop  BX              }
  30.                                      $59,           {   pop  CX              }
  31.                                      $5A,           {   pop  DX              }
  32.                                      $5E,           {   pop  SI              }
  33.                                      $5F,           {   pop  DI              }
  34.                                      $5D,           {   pop  BP              }
  35.                                      $1F,           {   pop  DS              }
  36.                                      $07,           {   pop  ES              }
  37.                                      $A3,$00,$00,   {   mov  errcode,AX      }
  38.                                      $B8,$FF,$00,   {   mov  AX,00FFh        }
  39.                                      $FB,           {   sti                  }
  40.                                      $F9,           {   stc                  }
  41.                                      $CA,$02,$00);  {   ret  2               }
  42.  
  43. type registers = record
  44.                     AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : integer;
  45.                  end;
  46.  
  47. var errcode : integer;               { The MS-DOS error code will go here }
  48.     old24seg,old24ofs : integer;
  49.  
  50.     outfile : text;
  51.     errornum : integer;
  52.  
  53. Procedure Enable24;
  54. var R : registers;
  55. begin
  56.    errcode:=0;
  57.    R.AX:=$3524;                       { Get Interrupt Vector }
  58.    intr($21,R);
  59.    old24seg:=R.ES;                    { save the old vector for later restore }
  60.    old24ofs:=R.BX;
  61.    int24[18]:=ofs(errcode) and $FF;   { put the variable address in the code }
  62.    int24[19]:=(ofs(errcode) and $FF00) shr 8;
  63.    R.AX:=$2524;                       { set the Int 24h vector to new code }
  64.    R.DS:=seg(int24);
  65.    R.DX:=ofs(int24);
  66.    intr($21,R);
  67. end;
  68.  
  69. Procedure Disable24;
  70. var R : registers;
  71. begin
  72.    R.AX:=$2524;                       { Set Interrupt Vector }
  73.    R.DS:=old24seg;                    { Restore the orignal vectors }
  74.    R.DX:=old24ofs;
  75.    intr($21,R);
  76. end;
  77.  
  78. Function Extended_Error:integer;
  79. begin
  80.    Extended_Error:=errcode;
  81.    errcode:=0;
  82. end;
  83.  
  84. begin
  85.    ClrScr;
  86.    Enable24;
  87.    assign(outfile,'b:test');
  88.    writeln('Critical Error Trapping':51);writeln;
  89.    writeln('Open the drive door for failing the Open File call (Press RET)');
  90.    readln;
  91.    rewrite(outfile);
  92.    errornum:=IOResult;
  93.    if errornum<>0  then
  94.    begin
  95.       writeln('Create File failed');
  96.       writeln('"Normal" error is ',errornum);
  97.       writeln('Extended error code is ',Extended_Error);
  98.       Disable24;
  99.       halt;
  100.    end;
  101.    write(outfile,'This is a little something for the buffer.');
  102.    writeln('Open the drive door for failing the Close File call (Press RET)');
  103.    readln;
  104.    close(outfile);
  105.    errornum:=IOResult;
  106.    if errornum<>0  then
  107.    begin
  108.       writeln('Close File failed');
  109.       writeln('"Normal" error is ',errornum);
  110.       writeln('Extended error code is ',Extended_Error);
  111.    end;
  112.    Disable24;
  113. end.
  114.