home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue50 / Except / TestExceptNotifyUnit1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-09-06  |  1.9 KB  |  84 lines
  1. unit TestExceptNotifyUnit1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     AVBtn: TButton;
  12.     RaiseBtn: TButton;
  13.     NonExceptionBtn: TButton;
  14.     QuitBtn: TButton;
  15.     procedure FormCreate(Sender: TObject);
  16.     procedure FormDestroy(Sender: TObject);
  17.     procedure AVBtnClick(Sender: TObject);
  18.     procedure RaiseBtnClick(Sender: TObject);
  19.     procedure NonExceptionBtnClick(Sender: TObject);
  20.     procedure QuitBtnClick(Sender: TObject);
  21.   end;
  22.  
  23. var
  24.   Form1: TForm1;
  25.  
  26. implementation
  27.  
  28. uses
  29.   HVExceptNotify;
  30.  
  31. {$R *.DFM}
  32.  
  33. procedure NotifyException(ExceptObj: TObject; ExceptAddr: pointer; OSException: boolean);
  34. const
  35.   Recursive: boolean = false;
  36. begin
  37.   // We have to be careful what we are doing in here -
  38.   // if an exception is raised, we could get endless recursive behaviour
  39.   if not Recursive then
  40.   begin
  41.     Recursive := true;
  42.     if ExceptObj is Exception then
  43.       ShowMessage(Format('Notified of exception %s at %p'#13#10'"%s"',
  44.         [ExceptObj.ClassName, ExceptAddr, Exception(ExceptObj).Message]))
  45.     else
  46.       ShowMessage(Format('Notified of exception %s at %p',
  47.         [ExceptObj.ClassName, ExceptAddr]));
  48.     Recursive := false;
  49.   end;
  50. end;
  51.  
  52. procedure TForm1.FormCreate(Sender: TObject);
  53. begin
  54.   HVExceptNotify.ExceptNotify := NotifyException;
  55. end;
  56.  
  57. procedure TForm1.FormDestroy(Sender: TObject);
  58. begin
  59.   HVExceptNotify.ExceptNotify := nil;
  60. end;
  61.  
  62. procedure TForm1.AVBtnClick(Sender: TObject);
  63. begin
  64.   SysUtils.StrLen(nil);
  65. end;
  66.  
  67. procedure TForm1.RaiseBtnClick(Sender: TObject);
  68. begin
  69.   SysUtils.StrToInt('');
  70. end;
  71.  
  72. procedure TForm1.NonExceptionBtnClick(Sender: TObject);
  73. begin
  74.   // Any object type can be raised as en exception
  75.   raise TPersistent.Create;
  76. end;
  77.  
  78. procedure TForm1.QuitBtnClick(Sender: TObject);
  79. begin
  80.   Close;
  81. end;
  82.  
  83. end.
  84.