home *** CD-ROM | disk | FTP | other *** search
/ Crack It! / Crack It!.iso / CONTENT / JSTEST / JST300D.EXE / ERROR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-09-26  |  3.2 KB  |  127 lines
  1. {
  2.  ***
  3.  
  4.  ERROR.PAS
  5.  Error-related Routines
  6.  (C)Copyright Gerard Paul Java 1996
  7.  
  8.  Unit Source File
  9.  
  10.  
  11.  This unit contains routines that display the error box and sound the error
  12.  tones, an error message function based on Turbo Pascal's runtime error
  13.  codes, and a routine to abort the program in case of error at startup.
  14.  
  15.  ***
  16. }
  17.  
  18. {$A+,B-,F-,I-,N-,R-,S-,V-}
  19.  
  20. unit Error;
  21.  
  22. interface
  23. type
  24.   ErrStrType = string[50];
  25.  
  26. const
  27.   Instruct = TRUE;
  28.   DontInstruct = FALSE;
  29.  
  30. var
  31.   ErrBoxAttr,
  32.   ErrMsgAttr: byte;
  33.  
  34. procedure ErrSound;
  35. procedure ErrBox(ErrMsg,ContMsg  : ErrStrType;
  36.                  Instruc         : boolean);
  37. procedure ErrAbort(ErrMsg: string);
  38. function ErrMsg(Code: word): ErrStrType;
  39.  
  40. implementation
  41. uses
  42.   Crt,
  43.   Instruc,
  44.   ScreenRt,
  45.   SysRt;
  46.  
  47.  
  48. {--------------------------------------------------------------------------
  49.  ErrSound: Sounds error tones.
  50.  --------------------------------------------------------------------------}
  51.  
  52. procedure ErrSound;
  53. begin
  54.   Sound(900);Delay(60);                            { Sound error tones. }
  55.   Sound(500);Delay(60);
  56.   NoSound;
  57. end;
  58.  
  59.  
  60. {---------------------------------------------------------------------------
  61.  ErrBox: Displays an error box and sounds the error tones.
  62.  ---------------------------------------------------------------------------}
  63.  
  64. procedure ErrBox(ErrMsg,ContMsg  : ErrStrType;
  65.                  Instruc         : boolean);
  66. begin
  67.   Window(1,1,80,25);
  68.  
  69.   if Instruc then
  70.     JustSeeBox;
  71.  
  72.   TextAttr := ErrBoxAttr;
  73.   DrawBox(14,11,67,14,DoubleLine);                                 { Draw red box. }
  74.   Window(16,12,73,14);                                  { Set new window. }
  75.   TextAttr := ErrMsgAttr;Writeln(ErrMsg);               { Write messages. }
  76.   TextColor(15);Write(ContMsg);
  77.   ErrSound;
  78. end; { proc }
  79.  
  80.  
  81. {----------------------------------------------------------------------------
  82.  ErrAbort: Displays an error message and terminates the program after issuing
  83.  error tones and Esc is pressed.
  84.  ----------------------------------------------------------------------------}
  85.  
  86. procedure ErrAbort(ErrMsg: string);
  87. begin { proc }
  88.   ErrBox(ErrMsg,'Press Esc to abort',DontInstruct);
  89.   repeat until GetKeyNoExt = Esc;
  90.   TerminateProg(1);
  91. end; { proc }
  92.  
  93. function ErrMsg(Code: word): ErrStrType;
  94. var
  95.   ErrorMessage: ErrStrType;
  96.   ErrCode: string[2];
  97.  
  98. begin
  99.   case Code of
  100.     2: ErrorMessage := 'file not found';
  101.     3: ErrorMessage := 'path not found';
  102.     4: ErrorMessage := 'too many open files';
  103.     5: ErrorMessage := 'access to file denied';
  104.     101: ErrorMessage := 'disk full';
  105.     150: ErrorMessage := 'disk write-protected';
  106.     151: ErrorMessage := 'unknown unit';
  107.     152: ErrorMessage := 'drive not ready';
  108.     154: ErrorMessage := 'CRC error in data';
  109.     156: ErrorMessage := 'disk seek error';
  110.     157: ErrorMessage := 'unknown media type';
  111.     158: ErrorMessage := 'sector not found';
  112.     159: ErrorMessage := 'printer out of paper';
  113.     160: ErrorMessage := 'device write fault';
  114.     161: ErrorMessage := 'device read fault';
  115.     162: ErrorMessage := 'hardware failure';
  116.   else
  117.     begin
  118.       Str(Code,ErrCode);
  119.       ErrorMessage := 'code '+ErrCode;
  120.     end;
  121.   end;
  122.  
  123.   ErrMsg := 'Error: '+ErrorMessage;
  124. end;
  125.  
  126. end.
  127.