home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / t_power / int24.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-02-02  |  8.4 KB  |  235 lines
  1. {$I-,R-,S-,V-}
  2.  
  3. unit Int24;
  4.  
  5. { A unit for trapping DOS critical errors (INT 24) for retries
  6.  
  7.   Version 1.01 - 01/02/1987 - First general release
  8.  
  9.   Scott Bussinger
  10.   Professional Practice Systems
  11.   110 South 131st Street
  12.   Tacoma, WA  98444
  13.   (206)531-8944
  14.   Compuserve 72247,2671 }
  15.  
  16. {Activate the following define to use the Turbo Professional units}
  17. {.$DEFINE TPROF}
  18.  
  19. interface
  20.  
  21. uses Dos,
  22.  
  23. {$IFDEF TPROF}                                   { You must DEFINE TPROF to use the Turbo Professional routines }
  24.      TPCrt;
  25. {$ELSE}
  26.      Crt,FastWr,Cursors;
  27. {$ENDIF}
  28.  
  29. var CriticalProc: pointer;                       { Address of special critical error handler }
  30.  
  31. implementation
  32.  
  33. const Attr = $70;
  34.  
  35. var ExitSave: pointer;
  36.     OldInt24: pointer;
  37.     CurrentCriticalProc: pointer;
  38.  
  39. procedure CallUserHandler(var Retry: boolean;ErrorCode: word;var DeviceName: string);
  40.   inline($FF/$1E/>CurrentCriticalProc);          { CALL DWORD [>CurrentCriticalProc] }
  41.  
  42. procedure JmpOldISR(OldISR: pointer);
  43.   inline($5B/                   {  pop bx             ;BX = Ofs(OldIsr)}
  44.          $58/                   {  pop ax             ;AX = Seg(OldIsr)}
  45.          $87/$5E/$0E/           {  xchg bx,[bp+14]    ;Switch old BX and Ofs(OldIsr)}
  46.          $87/$46/$10/           {  xchg ax,[bp+16]    ;Switch old AX and Seg(OldIsr)}
  47.          $89/$EC/               {  mov sp,bp          ;Restore SP}
  48.          $5D/                   {  pop bp             ;Restore BP}
  49.          $07/                   {  pop es             ;Restore ES}
  50.          $1F/                   {  pop ds             ;Restore DS}
  51.          $5F/                   {  pop di             ;Restore DI}
  52.          $5E/                   {  pop si             ;Restore SI}
  53.          $5A/                   {  pop dx             ;Restore DX}
  54.          $59/                   {  pop cx             ;Restore CX}
  55.          $CB);                  {  retf               ;Chain to OldIsr, leaving CS and IP params on the stack}
  56.  
  57. {$F+}
  58. procedure Int24Handler(Flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP: integer); interrupt;
  59.   { Interrupt handler for the critical error interrupt }
  60.   type DeviceHeader = record
  61.          Next: pointer;
  62.          Attributes: word;
  63.          StrategyAddr: word;
  64.          InterruptAddr: word;
  65.          Name: array[1..8] of char
  66.          end;
  67.   var DeviceName: string[8];
  68.       Retry: boolean;
  69.       SaveCriticalProc: pointer;
  70.   begin
  71.   if (AX and $8000) = 0
  72.    then
  73.     DeviceName := chr(lo(AX)+ord('A')) + ':'     { Pass the drive name to user error handler }
  74.    else
  75.     with DeviceHeader(ptr(BP,SI)^) do
  76.       if (Attributes and $8000) = 0
  77.        then
  78.         DeviceName := ''                         { Bad memory image of FAT - no device name available }
  79.        else
  80.         DeviceName := copy(Name,1,pred(pos(' ',Name+' '))); { Get name of character device }
  81.  
  82.   Retry := false;
  83.   SaveCriticalProc := CriticalProc;
  84.   while CriticalProc <> nil do                   { Allow for a chain of user critical error handlers }
  85.     begin
  86.     CurrentCriticalProc := CriticalProc;
  87.     CriticalProc := nil;
  88.     CallUserHandler(Retry,lo(DI),DeviceName)
  89.     end;
  90.   CriticalProc := SaveCriticalProc;
  91.   if Retry
  92.    then
  93.     AX := 1
  94.    else
  95.     JmpOldISR(OldInt24)
  96.   end;
  97.  
  98. procedure DefaultCriticalHandler(var Retry: boolean;ErrorCode: word;var DeviceName: string);
  99.   { Default critical error handler for retrying on errors }
  100.   const ErrorDesc: array[0..12] of string[18] = ('', { List of generic descriptions of critical errors }
  101.                                                  'Unknown unit',
  102.                                                  '',
  103.                                                  'Unknown command',
  104.                                                  'Data error (CRC)',
  105.                                                  'Bad request length',
  106.                                                  'Seek error',
  107.                                                  'Unknown media type',
  108.                                                  'Sector not found',
  109.                                                  '',
  110.                                                  'Write fault',
  111.                                                  'Read fault',
  112.                                                  'General failure');
  113.         ScreenSize = 2000;
  114.   var CurrentAttr: byte;
  115.       CurrentLine: integer;
  116.       I: integer;
  117.       Key: char;
  118.       SaveCheckBreak: boolean;
  119. {$IFDEF TPROF}
  120.       SaveCursorLoc: word;
  121.       SaveCursorSize: word;
  122. {$ELSE}
  123.       SaveCursorSize: CursorSize;
  124.       SaveX: byte;
  125.       SaveY: byte;
  126. {$ENDIF}
  127.       SaveScreen: array[1..ScreenSize] of word;  { A place to save a copy of the screen temporarily }
  128.       SaveTextAttr: byte;
  129.  
  130.   procedure OutLine(Line: string);
  131.     { Output a line to the screen }
  132.     begin
  133.     if odd(length(Line)) then
  134.       Line := ' ' + Line;
  135.     while length(Line) < 44 do
  136.       Line := ' ' + Line + ' ';
  137.     FastWrite('║'+Line+'║',CurrentLine,18,Attr);
  138.     inc(CurrentLine)
  139.     end;
  140.  
  141.   begin
  142.   if not Retry then                              { See if another handler has already decided to retry the error }
  143.     begin                                        { Save screen and put up a warning message }
  144. {$IFDEF TPROF}
  145.     GetCursorState(SaveCursorLoc,SaveCursorSize); { Save current display }
  146.     MoveScreen(mem[VideoSegment:0],SaveScreen,ScreenSize);
  147. {$ELSE}
  148.     GetCursor(SaveCursorSize);
  149.     GetCursorLoc(SaveX,SaveY);
  150.     MoveFromScreen(mem[BaseOfScreen:0],SaveScreen,ScreenSize);
  151. {$ENDIF}
  152.     SaveTextAttr := TextAttr;
  153.     SaveCheckBreak := CheckBreak;
  154.     CheckBreak := false;
  155.     TextBackground(Black);
  156.     ClrScr;                                    { Display the error message }
  157.     CurrentLine := 10;
  158.     FastWrite('╔════════════════════════════════════════════╗',9,18,Attr);
  159.     OutLine('');
  160.     case ErrorCode of                            { Check for obvious problems }
  161.       0: begin
  162.          OutLine('You cannot write to the disk in drive '+DeviceName);
  163.          OutLine('because it has a write protect tab');
  164.          OutLine('attached.  Remove the tab to continue.')
  165.          end;
  166.       2: if DeviceName[2] = ':'                  { Problem with a drive or device }
  167.           then
  168.            begin
  169.            OutLine('Drive '+DeviceName+' is not ready.');
  170.            OutLine('Check the disk and close the door.')
  171.            end
  172.           else
  173.            OutLine('Printer is not ready.  Check device '+DeviceName);
  174.       9: OutLine('Printer ('+DeviceName+') is out of paper.');
  175.       else begin                                 { Handle bizarre errors more generically }
  176.            if DeviceName[2] = ':'
  177.             then
  178.              OutLine('Error with disk drive '+DeviceName)
  179.             else
  180.              OutLine('Check the printer. ('+DeviceName+')');
  181.            OutLine('');
  182.            OutLine('Problem is '+ErrorDesc[ErrorCode]);
  183.            end
  184.       end;
  185.     OutLine('');
  186.     OutLine('Hit ''A'' or CTRL BREAK to abort operation');
  187.     OutLine('or the SPACE BAR to try again.');
  188.     FastWrite('╚════════════════════════════════════════════╝',CurrentLine,18,Attr);
  189.  
  190.     for I := 1 to 3 do                           { Whistle at user }
  191.       begin
  192.       sound(800);
  193.       delay(100);
  194.       sound(600);
  195.       delay(100)
  196.       end;
  197.     NoSound;
  198.     while KeyPressed do                          { Clear keyboard buffer }
  199.       Key := ReadKey;
  200.     Key := ReadKey;
  201. {$IFDEF TPROF}
  202.     MoveScreen(SaveScreen,mem[VideoSegment:0],ScreenSize); { Restore display }
  203.     RestoreCursorState(SaveCursorLoc,SaveCursorSize);
  204. {$ELSE}
  205.     MoveToScreen(SaveScreen,mem[BaseOfScreen:0],ScreenSize); { Restore display }
  206.     SetCursor(SaveCursorSize);
  207.     SetCursorLoc(SaveX,SaveY);
  208. {$ENDIF}
  209.     TextAttr := SaveTextAttr;
  210.     CheckBreak := SaveCheckBreak;
  211.     case upcase(Key) of                          { Either retry operation or return an error depending on key hit }
  212.       ^C,^[,'A','Q': ;
  213.       else Retry := true                         { Since CriticalProc not restored, no more handlers will be called }
  214.       end;
  215.     while KeyPressed do                          { Clear keyboard buffer }
  216.       Key := ReadKey
  217.     end
  218.   end;
  219.  
  220. procedure ExitHandler;
  221.   { Restore the original Int24 handler }
  222.   begin
  223.   ExitProc := ExitSave;
  224.   SetIntVec($24,OldInt24)
  225.   end;
  226. {$F-}
  227.  
  228. begin
  229. ExitSave := ExitProc;
  230. ExitSave := @ExitHandler;
  231. CriticalProc := @DefaultCriticalHandler;
  232. GetIntVec($24,OldInt24);
  233. SetIntVec($24,@Int24Handler)
  234. end.
  235.