home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1987 / 09 / errordem.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-08-09  |  1.7 KB  |  58 lines
  1. (* ------------------------------------------------------------------------- *)
  2. (*                           ERRORDEM.PAS                                    *)
  3. (*                    Demonstration der Fehlerabfangung                      *)
  4.  
  5. PROGRAM ErrorDemo;
  6.  
  7. {$I ERROR.INC}                          (* Fehlerbehandlungs-Modul einbinden *)
  8.  
  9. (* ------------------------------------------------------------------------- *)
  10. (*  Fehlerbehandlung: Rumpf der FORWARD-deklarierten Prozedur in ERROR.INC   *)
  11. (*                    Entsprechend eigenen Wuenschen zu gestalten!           *)
  12.  
  13. PROCEDURE Errorhandler;
  14.  
  15.    TYPE HexStrg = STRING[4];
  16.  
  17.    FUNCTION HexByte (b :BYTE) :HexStrg;
  18.       CONST HexDigit :ARRAY [0..15] OF CHAR = '0123456789ABCDEF';
  19.     BEGIN
  20.       HexByte := HexDigit[b SHR 4] + HexDigit[b AND $0F]
  21.     END;
  22.  
  23.  
  24.    FUNCTION HexWord (w :INTEGER) :HexStrg;
  25.     BEGIN
  26.       HexWord := HexByte (w SHR 8) + HexByte (w AND $FF)
  27.     END;
  28.  
  29.  BEGIN
  30.    CASE ErrorType OF
  31.       0: Write ('Abbruch durch ^C');
  32.       1: Write ('I/O-Fehler ',HexByte(ErrorNr));
  33.       2: Write ('Laufzeit-Fehler ',HexByte(ErrorNr));
  34.    END;
  35.    WriteLn (' bei PC=',HexWord(ErrorPC));
  36.  END;
  37.  
  38. (* ------------------------------------------------------------------------- *)
  39. (*             Hauptprogramm mit vorsaetzlich eingebauten Fehlern            *)
  40.  
  41. VAR  i,k :INTEGER;
  42.      y   :REAL;
  43.  
  44. BEGIN
  45.   WriteLn;
  46.   FOR i:=1 TO 2 DO
  47.   BEGIN
  48.     IF i=1 THEN
  49.       InitErrorCheck            (* erster Durchlauf: Fehler selbst behandeln *)
  50.     ELSE
  51.       OldErrorCheck;              (* zweiter Durchlauf: bei Fehler abbrechen *)
  52.     y := Sqr(1e20);
  53.     y := 1/0;
  54.     y := Sqrt(-1) + Ln(-1);
  55.     k := Round(123456.0) + Trunc (98765.4);
  56.   END
  57. END.
  58.