--- ibx/trunk/runtime/IBEvents.pas	2013/02/28 16:56:14	16
+++ ibx/trunk/runtime/IBEvents.pas	2013/12/28 19:22:24	17
@@ -1,535 +1,535 @@
-{************************************************************************}
-{                                                                        }
-{       Borland Delphi Visual Component Library                          }
-{       InterBase Express core components                                }
-{                                                                        }
-{       Copyright (c) 1998-2000 Inprise Corporation                      }
-{                                                                        }
-{    InterBase Express is based in part on the product                   }
-{    Free IB Components, written by Gregory H. Deatz for                 }
-{    Hoagland, Longo, Moran, Dunst & Doukas Company.                     }
-{    Free IB Components is used under license.                           }
-{                                                                        }
-{    The contents of this file are subject to the InterBase              }
-{    Public License Version 1.0 (the "License"); you may not             }
-{    use this file except in compliance with the License. You            }
-{    may obtain a copy of the License at http://www.Inprise.com/IPL.html }
-{    Software distributed under the License is distributed on            }
-{    an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either              }
-{    express or implied. See the License for the specific language       }
-{    governing rights and limitations under the License.                 }
-{    The Original Code was created by InterBase Software Corporation     }
-{       and its successors.                                              }
-{    Portions created by Inprise Corporation are Copyright (C) Inprise   }
-{       Corporation. All Rights Reserved.                                }
-{    Contributor(s): Jeff Overcash                                       }
-{                                                                        }
-{    IBX For Lazarus (Firebird Express)                                  }
-{    Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
-{    Portions created by MWA Software are copyright McCallum Whyman      }
-{    Associates Ltd 2011                                                 }
-{                                                                        }
-{************************************************************************}
-
-{
-  This unit has been almost completely re-written as the original code was
-  not that robust - and I am not even sure if it worked. The IBPP C++ implementation
-  was used for guidance and inspiration. A permanent thread is used to receive
-  events from the asynchronous event handler. This then uses "Synchronize" to
-  process the event in the main thread.
-
-  Note that an error will occur if the TIBEvent's Registered property is set to
-  true before the Database has been opened.
-}
-
-unit IBEvents;
-
-{$Mode Delphi}
-
-interface
-
-uses
-{$IFDEF WINDOWS }
-  Windows,
-{$ELSE}
-  unix,
-{$ENDIF}
-  Classes, Graphics, Controls,
-  Forms, Dialogs, IBHeader, IBExternals, IB, IBDatabase;
-
-const
-  MaxEvents = 15;
-
-type
-
-  TEventAlert = procedure( Sender: TObject; EventName: string; EventCount: longint;
-                           var CancelAlerts: Boolean) of object;
-
-  { TIBEvents }
-
-  TIBEvents = class(TComponent)
-  private
-    FIBLoaded: Boolean;
-    FBase: TIBBase;
-    FEvents: TStrings;
-    FOnEventAlert: TEventAlert;
-    FEventHandler: TObject;
-    FRegistered: boolean;
-    FDeferredRegister: boolean;
-    procedure EventChange(sender: TObject);
-    function GetDatabase: TIBDatabase;
-    function GetDatabaseHandle: TISC_DB_HANDLE;
-    procedure SetDatabase( value: TIBDatabase);
-    procedure ValidateDatabase( Database: TIBDatabase);
-    procedure DoBeforeDatabaseDisconnect(Sender: TObject);
-    procedure DoAfterDatabaseConnect(Sender: TObject);
-  protected
-    procedure Notification( AComponent: TComponent; Operation: TOperation); override;
-    procedure SetEvents( value: TStrings);
-    procedure SetRegistered( value: boolean);
-
-  public
-    constructor Create( AOwner: TComponent); override;
-    destructor Destroy; override;
-    procedure RegisterEvents;
-    procedure UnRegisterEvents;
-    property DatabaseHandle: TISC_DB_HANDLE read GetDatabaseHandle;
-    property DeferredRegister: boolean read FDeferredRegister write FDeferredRegister;
-  published
-    property Database: TIBDatabase read GetDatabase write SetDatabase;
-    property Events: TStrings read FEvents write SetEvents;
-    property Registered: Boolean read FRegistered write SetRegistered;
-    property OnEventAlert: TEventAlert read FOnEventAlert write FOnEventAlert;
-  end;
-
-
-implementation
-
-uses
-  IBIntf, syncobjs;
-
-type
-
-  TEventHandlerStates = (
-    stIdle,           {Events not monitored}
-    stHasEvb,         {Event Block Allocated but not queued}
-    stQueued,         {Waiting for Event}
-    stSignalled       {Event Callback signalled Event}
-   );
-
-  { TEventHandler }
-
-  TEventHandler = class(TThread)
-  private
-    FOwner: TIBEvents;
-    FCriticalSection: TCriticalSection;   {protects race conditions in stQueued state}
-    {$IFDEF WINDOWS}
-    {Make direct use of Windows API as TEventObject don't seem to work under
-     Windows!}
-    FEventHandler: THandle;
-    {$ELSE}
-    FEventWaiting: TEventObject;
-    {$ENDIF}
-    FState: TEventHandlerStates;
-    FEventBuffer: PChar;
-    FEventBufferLen: integer;
-    FEventID: ISC_LONG;
-    FRegisteredState: Boolean;
-    FResultBuffer: PChar;
-    FEvents: TStringList;
-    FSignalFired: boolean;
-    procedure QueueEvents;
-    procedure CancelEvents;
-    procedure HandleEventSignalled(length: short; updated: PChar);
-    procedure DoEventSignalled;
-  protected
-    procedure Execute; override;
-  public
-    constructor Create(Owner: TIBEvents);
-    destructor Destroy; override;
-    procedure Terminate;
-    procedure RegisterEvents(Events: TStrings);
-    procedure UnregisterEvents;
-  end;
-
- {This procedure is used for the event call back - note the cdecl }
-
-procedure IBEventCallback( ptr: pointer; length: short; updated: PChar); cdecl;
-begin
-  if (ptr = nil) or (length = 0) or (updated = nil) then
-    Exit;
-  { Handle events asynchronously in second thread }
-  TEventHandler(ptr).HandleEventSignalled(length,updated);
-end;
-
-
-
-{ TEventHandler }
-
-procedure TEventHandler.QueueEvents;
-var
-  callback: pointer;
-  DBH: TISC_DB_HANDLE;
-begin
-  if FState <> stHasEvb then
-    Exit;
-  FCriticalSection.Enter;
-  try
-    callback := @IBEventCallback;
-    DBH := FOwner.DatabaseHandle;
-    if (isc_que_events( StatusVector, @DBH, @FEventID, FEventBufferLen,
-                     FEventBuffer, TISC_CALLBACK(callback), PVoid(Self)) <> 0) then
-      IBDatabaseError;
-    FState := stQueued
-  finally
-    FCriticalSection.Leave
-  end;
-end;
-
-procedure TEventHandler.CancelEvents;
-var
-  DBH: TISC_DB_HANDLE;
-begin
-  if FState in [stQueued,stSignalled] then
-  begin
-    FCriticalSection.Enter;
-    try
-      DBH := FOwner.DatabaseHandle;
-      if (isc_Cancel_events( StatusVector, @DBH, @FEventID) <> 0) then
-          IBDatabaseError;
-      FState := stHasEvb;
-    finally
-      FCriticalSection.Leave
-    end;
-  end;
-
-  if FState = stHasEvb then
-  begin
-    isc_free( FEventBuffer);
-    FEventBuffer := nil;
-    isc_free( FResultBuffer);
-    FResultBuffer := nil;
-    FState := stIdle
-  end;
-  FSignalFired := false
-end;
-
-procedure TEventHandler.HandleEventSignalled(length: short; updated: PChar);
-begin
-  FCriticalSection.Enter;
-  try
-    if FState <> stQueued then
-      Exit;
-    Move(Updated[0], FResultBuffer[0], Length);
-    FState := stSignalled;
-    {$IFDEF WINDOWS}
-    SetEVent(FEventHandler);
-    {$ELSE}
-    FEventWaiting.SetEvent;
-    {$ENDIF}
-  finally
-    FCriticalSection.Leave
-  end;
-end;
-
-procedure TEventHandler.DoEventSignalled;
-var
-  i: integer;
-  CancelAlerts: boolean;
-  Status: array[0..19] of ISC_LONG; {Note in 64 implementation the ibase.h implementation
-                                     is different from Interbase 6.0 API documentatoin}
-begin
-    if FState <> stSignalled then
-      Exit;
-    isc_event_counts( @Status, FEventBufferLen, FEventBuffer, FResultBuffer);
-    CancelAlerts := false;
-    if not FSignalFired then
-      FSignalFired := true   {Ignore first time}
-    else
-    if assigned(FOwner.FOnEventAlert)  then
-    begin
-      for i := 0 to FEvents.Count - 1 do
-      begin
-        try
-        if (Status[i] <> 0) and not CancelAlerts then
-            FOwner.FOnEventAlert( self, FEvents[i], Status[i], CancelAlerts);
-        except
-          Application.HandleException( nil);
-        end;
-      end;
-    end;
-    FState := stHasEvb;
-  if  CancelAlerts then
-      CancelEvents
-    else
-      QueueEvents
-end;
-
-procedure TEventHandler.Execute;
-begin
-  while not Terminated do
-  begin
-    {$IFDEF WINDOWS}
-    WaitForSingleObject(FEventHandler,INFINITE);
-    {$ELSE}
-    FEventWaiting.WaitFor(INFINITE);
-    {$ENDIF}
-
-    if not Terminated and (FState = stSignalled) then
-      Synchronize(DoEventSignalled)
-  end;
-end;
-
-
-
-constructor TEventHandler.Create(Owner: TIBEvents);
-var
-  PSa : PSecurityAttributes;
-{$IFDEF WINDOWS}
-  Sd : TSecurityDescriptor;
-  Sa : TSecurityAttributes;
-begin
-  InitializeSecurityDescriptor(@Sd,SECURITY_DESCRIPTOR_REVISION);
-  SetSecurityDescriptorDacl(@Sd,true,nil,false);
-  Sa.nLength := SizeOf(Sa);
-  Sa.lpSecurityDescriptor := @Sd;
-  Sa.bInheritHandle := true;
-  PSa := @Sa;
-{$ELSE}
-begin
-  PSa:= nil;
-{$ENDIF}
-  inherited Create(true);
-  FOwner := Owner;
-  FState := stIdle;
-  FCriticalSection := TCriticalSection.Create;
-  {$IFDEF WINDOWS}
-  FEventHandler := CreateEvent(PSa,false,true,nil);
-  {$ELSE}
-  FEventWaiting := TEventObject.Create(PSa,false,true,FOwner.Name+'.Events');
-  {$ENDIF}
-  FEvents := TStringList.Create;
-  FreeOnTerminate := true;
-  Resume
-end;
-
-destructor TEventHandler.Destroy;
-begin
-  if assigned(FCriticalSection) then FCriticalSection.Free;
-  {$IFDEF WINDOWS}
-  CloseHandle(FEventHandler);
-  {$ELSE}
-  if assigned(FEventWaiting) then FEventWaiting.Free;
-  {$ENDIF}
-  if assigned(FEvents) then FEvents.Free;
-  inherited Destroy;
-end;
-
-procedure TEventHandler.Terminate;
-begin
-  inherited Terminate;
-  {$IFDEF WINDOWS}
-  SetEvent(FEventHandler);
-  {$ELSE}
-  FEventWaiting.SetEvent;
-  {$ENDIF}
-  CancelEvents;
-end;
-
-procedure TEventHandler.RegisterEvents(Events: TStrings);
-var
-  i: integer;
-  EventNames: array of PChar;
-begin
-  UnregisterEvents;
-
-  if Events.Count = 0 then
-    exit;
-
-  setlength(EventNames,MaxEvents);
-  try
-    for i := 0 to Events.Count-1 do
-      EventNames[i] := PChar(Events[i]);
-    FEvents.Assign(Events);
-    FEventBufferlen := isc_event_block(@FEventBuffer,@FResultBuffer,
-                        Events.Count,
-                        EventNames[0],EventNames[1],EventNames[2],
-                        EventNames[3],EventNames[4],EventNames[5],
-                        EventNames[6],EventNames[7],EventNames[8],
-                        EventNames[9],EventNames[10],EventNames[11],
-                        EventNames[12],EventNames[13],EventNames[14]
-                        );
-    FState := stHasEvb;
-    FRegisteredState := true;
-    QueueEvents
-  finally
-    SetLength(EventNames,0)
-  end;
-end;
-
-procedure TEventHandler.UnregisterEvents;
-begin
-  if FRegisteredState then
-  begin
-    CancelEvents;
-    FRegisteredState := false;
-  end;
-end;
-
-{ TIBEvents }
-
-procedure TIBEvents.ValidateDatabase( Database: TIBDatabase);
-begin
-  if not assigned( Database) then
-    IBError(ibxeDatabaseNameMissing, [nil]);
-  if not Database.Connected then
-    IBError(ibxeDatabaseClosed, [nil]);
-end;
-
-constructor TIBEvents.Create( AOwner: TComponent);
-begin
-  inherited Create( AOwner);
-  FIBLoaded := False;
-  CheckIBLoaded;
-  FIBLoaded := True;
-  FBase := TIBBase.Create(Self);
-  FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect;
-  FBase.AfterDatabaseConnect := DoAfterDatabaseConnect;
-  FEvents := TStringList.Create;
-  with TStringList( FEvents) do
-  begin
-    OnChange := EventChange;
-    Duplicates := dupIgnore;
-  end;
-  FEventHandler := TEventHandler.Create(self)
-end;
-
-destructor TIBEvents.Destroy;
-begin
-  if FIBLoaded then
-  begin
-    UnregisterEvents;
-    SetDatabase(nil);
-    TStringList(FEvents).OnChange := nil;
-    FBase.Free;
-    FEvents.Free;
-  end;
-  if assigned(FEventHandler) then
-    TEventHandler(FEventHandler).Terminate;
-  FEventHandler := nil;
-  inherited Destroy;
-end;
-
-
-
-procedure TIBEvents.EventChange( sender: TObject);
-begin
-  { check for blank event }
-  if TStringList(Events).IndexOf( '') <> -1 then
-    IBError(ibxeInvalidEvent, [nil]);
-  { check for too many events }
-  if Events.Count > MaxEvents then
-  begin
-    TStringList(Events).OnChange := nil;
-    Events.Delete( MaxEvents);
-    TStringList(Events).OnChange := EventChange;
-    IBError(ibxeMaximumEvents, [nil]);
-  end;
-  if Registered then
-    TEventHandler(FEventHandler).RegisterEvents(Events);
-end;
-
-procedure TIBEvents.Notification( AComponent: TComponent;
-                                        Operation: TOperation);
-begin
-  inherited Notification( AComponent, Operation);
-  if (Operation = opRemove) and (AComponent = FBase.Database) then
-  begin
-    UnregisterEvents;
-    FBase.Database := nil;
-  end;
-end;
-
-procedure TIBEvents.RegisterEvents;
-begin
-  ValidateDatabase( Database);
-  if csDesigning in ComponentState then FRegistered := true
-  else
-  begin
-    if not FBase.Database.Connected then
-      FDeferredRegister := true
-    else
-    begin
-      TEventHandler(FEventHandler).RegisterEvents(Events);
-      FRegistered := true;
-    end;
-  end;
-end;
-
-procedure TIBEvents.SetEvents( value: TStrings);
-begin
-  FEvents.Assign( value);
-end;
-
-procedure TIBEvents.SetDatabase( value: TIBDatabase);
-begin
-  if value <> FBase.Database then
-  begin
-    if Registered then UnregisterEvents;
-    if assigned( value) and value.Connected then ValidateDatabase( value);
-    FBase.Database := value;
-    if (FBase.Database <> nil) and FBase.Database.Connected then
-      DoAfterDatabaseConnect(FBase.Database)
-  end;
-end;
-
-function TIBEvents.GetDatabase: TIBDatabase;
-begin
-  Result := FBase.Database
-end;
-
-procedure TIBEvents.SetRegistered( value: Boolean);
-begin
-  FDeferredRegister := false;
-  if not assigned(FBase) or (FBase.Database = nil) then
-  begin
-    FDeferredRegister := value;
-    Exit;
-  end;
-
-  if value then RegisterEvents else UnregisterEvents;
-end;
-
-procedure TIBEvents.UnregisterEvents;
-begin
-  FDeferredRegister := false;
-  if not FRegistered then
-    Exit;
-  if csDesigning in ComponentState then
-    FRegistered := false
-  else
-  begin
-    TEventHandler(FEventHandler).UnRegisterEvents;
-    FRegistered := false;
-  end;
-end;
-
-procedure TIBEvents.DoBeforeDatabaseDisconnect(Sender: TObject);
-begin
-  UnregisterEvents;
-end;
-
-procedure TIBEvents.DoAfterDatabaseConnect(Sender: TObject);
-begin
-  if FDeferredRegister then
-    Registered := true
-end;
-
-function TIBEvents.GetDatabaseHandle: TISC_DB_HANDLE;
-begin
-  ValidateDatabase(FBase.Database);
-  Result := FBase.Database.Handle;
-end;
-
-
-end.
+{************************************************************************}
+{                                                                        }
+{       Borland Delphi Visual Component Library                          }
+{       InterBase Express core components                                }
+{                                                                        }
+{       Copyright (c) 1998-2000 Inprise Corporation                      }
+{                                                                        }
+{    InterBase Express is based in part on the product                   }
+{    Free IB Components, written by Gregory H. Deatz for                 }
+{    Hoagland, Longo, Moran, Dunst & Doukas Company.                     }
+{    Free IB Components is used under license.                           }
+{                                                                        }
+{    The contents of this file are subject to the InterBase              }
+{    Public License Version 1.0 (the "License"); you may not             }
+{    use this file except in compliance with the License. You            }
+{    may obtain a copy of the License at http://www.Inprise.com/IPL.html }
+{    Software distributed under the License is distributed on            }
+{    an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either              }
+{    express or implied. See the License for the specific language       }
+{    governing rights and limitations under the License.                 }
+{    The Original Code was created by InterBase Software Corporation     }
+{       and its successors.                                              }
+{    Portions created by Inprise Corporation are Copyright (C) Inprise   }
+{       Corporation. All Rights Reserved.                                }
+{    Contributor(s): Jeff Overcash                                       }
+{                                                                        }
+{    IBX For Lazarus (Firebird Express)                                  }
+{    Contributor: Tony Whyman, MWA Software http://www.mwasoftware.co.uk }
+{    Portions created by MWA Software are copyright McCallum Whyman      }
+{    Associates Ltd 2011                                                 }
+{                                                                        }
+{************************************************************************}
+
+{
+  This unit has been almost completely re-written as the original code was
+  not that robust - and I am not even sure if it worked. The IBPP C++ implementation
+  was used for guidance and inspiration. A permanent thread is used to receive
+  events from the asynchronous event handler. This then uses "Synchronize" to
+  process the event in the main thread.
+
+  Note that an error will occur if the TIBEvent's Registered property is set to
+  true before the Database has been opened.
+}
+
+unit IBEvents;
+
+{$Mode Delphi}
+
+interface
+
+uses
+{$IFDEF WINDOWS }
+  Windows,
+{$ELSE}
+  unix,
+{$ENDIF}
+  Classes, Graphics, Controls,
+  Forms, Dialogs, IBHeader, IBExternals, IB, IBDatabase;
+
+const
+  MaxEvents = 15;
+
+type
+
+  TEventAlert = procedure( Sender: TObject; EventName: string; EventCount: longint;
+                           var CancelAlerts: Boolean) of object;
+
+  { TIBEvents }
+
+  TIBEvents = class(TComponent)
+  private
+    FIBLoaded: Boolean;
+    FBase: TIBBase;
+    FEvents: TStrings;
+    FOnEventAlert: TEventAlert;
+    FEventHandler: TObject;
+    FRegistered: boolean;
+    FDeferredRegister: boolean;
+    procedure EventChange(sender: TObject);
+    function GetDatabase: TIBDatabase;
+    function GetDatabaseHandle: TISC_DB_HANDLE;
+    procedure SetDatabase( value: TIBDatabase);
+    procedure ValidateDatabase( Database: TIBDatabase);
+    procedure DoBeforeDatabaseDisconnect(Sender: TObject);
+    procedure DoAfterDatabaseConnect(Sender: TObject);
+  protected
+    procedure Notification( AComponent: TComponent; Operation: TOperation); override;
+    procedure SetEvents( value: TStrings);
+    procedure SetRegistered( value: boolean);
+
+  public
+    constructor Create( AOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure RegisterEvents;
+    procedure UnRegisterEvents;
+    property DatabaseHandle: TISC_DB_HANDLE read GetDatabaseHandle;
+    property DeferredRegister: boolean read FDeferredRegister write FDeferredRegister;
+  published
+    property Database: TIBDatabase read GetDatabase write SetDatabase;
+    property Events: TStrings read FEvents write SetEvents;
+    property Registered: Boolean read FRegistered write SetRegistered;
+    property OnEventAlert: TEventAlert read FOnEventAlert write FOnEventAlert;
+  end;
+
+
+implementation
+
+uses
+  IBIntf, syncobjs;
+
+type
+
+  TEventHandlerStates = (
+    stIdle,           {Events not monitored}
+    stHasEvb,         {Event Block Allocated but not queued}
+    stQueued,         {Waiting for Event}
+    stSignalled       {Event Callback signalled Event}
+   );
+
+  { TEventHandler }
+
+  TEventHandler = class(TThread)
+  private
+    FOwner: TIBEvents;
+    FCriticalSection: TCriticalSection;   {protects race conditions in stQueued state}
+    {$IFDEF WINDOWS}
+    {Make direct use of Windows API as TEventObject don't seem to work under
+     Windows!}
+    FEventHandler: THandle;
+    {$ELSE}
+    FEventWaiting: TEventObject;
+    {$ENDIF}
+    FState: TEventHandlerStates;
+    FEventBuffer: PChar;
+    FEventBufferLen: integer;
+    FEventID: ISC_LONG;
+    FRegisteredState: Boolean;
+    FResultBuffer: PChar;
+    FEvents: TStringList;
+    FSignalFired: boolean;
+    procedure QueueEvents;
+    procedure CancelEvents;
+    procedure HandleEventSignalled(length: short; updated: PChar);
+    procedure DoEventSignalled;
+  protected
+    procedure Execute; override;
+  public
+    constructor Create(Owner: TIBEvents);
+    destructor Destroy; override;
+    procedure Terminate;
+    procedure RegisterEvents(Events: TStrings);
+    procedure UnregisterEvents;
+  end;
+
+ {This procedure is used for the event call back - note the cdecl }
+
+procedure IBEventCallback( ptr: pointer; length: short; updated: PChar); cdecl;
+begin
+  if (ptr = nil) or (length = 0) or (updated = nil) then
+    Exit;
+  { Handle events asynchronously in second thread }
+  TEventHandler(ptr).HandleEventSignalled(length,updated);
+end;
+
+
+
+{ TEventHandler }
+
+procedure TEventHandler.QueueEvents;
+var
+  callback: pointer;
+  DBH: TISC_DB_HANDLE;
+begin
+  if FState <> stHasEvb then
+    Exit;
+  FCriticalSection.Enter;
+  try
+    callback := @IBEventCallback;
+    DBH := FOwner.DatabaseHandle;
+    if (isc_que_events( StatusVector, @DBH, @FEventID, FEventBufferLen,
+                     FEventBuffer, TISC_CALLBACK(callback), PVoid(Self)) <> 0) then
+      IBDatabaseError;
+    FState := stQueued
+  finally
+    FCriticalSection.Leave
+  end;
+end;
+
+procedure TEventHandler.CancelEvents;
+var
+  DBH: TISC_DB_HANDLE;
+begin
+  if FState in [stQueued,stSignalled] then
+  begin
+    FCriticalSection.Enter;
+    try
+      DBH := FOwner.DatabaseHandle;
+      if (isc_Cancel_events( StatusVector, @DBH, @FEventID) <> 0) then
+          IBDatabaseError;
+      FState := stHasEvb;
+    finally
+      FCriticalSection.Leave
+    end;
+  end;
+
+  if FState = stHasEvb then
+  begin
+    isc_free( FEventBuffer);
+    FEventBuffer := nil;
+    isc_free( FResultBuffer);
+    FResultBuffer := nil;
+    FState := stIdle
+  end;
+  FSignalFired := false
+end;
+
+procedure TEventHandler.HandleEventSignalled(length: short; updated: PChar);
+begin
+  FCriticalSection.Enter;
+  try
+    if FState <> stQueued then
+      Exit;
+    Move(Updated[0], FResultBuffer[0], Length);
+    FState := stSignalled;
+    {$IFDEF WINDOWS}
+    SetEVent(FEventHandler);
+    {$ELSE}
+    FEventWaiting.SetEvent;
+    {$ENDIF}
+  finally
+    FCriticalSection.Leave
+  end;
+end;
+
+procedure TEventHandler.DoEventSignalled;
+var
+  i: integer;
+  CancelAlerts: boolean;
+  Status: array[0..19] of ISC_LONG; {Note in 64 implementation the ibase.h implementation
+                                     is different from Interbase 6.0 API documentatoin}
+begin
+    if FState <> stSignalled then
+      Exit;
+    isc_event_counts( @Status, FEventBufferLen, FEventBuffer, FResultBuffer);
+    CancelAlerts := false;
+    if not FSignalFired then
+      FSignalFired := true   {Ignore first time}
+    else
+    if assigned(FOwner.FOnEventAlert)  then
+    begin
+      for i := 0 to FEvents.Count - 1 do
+      begin
+        try
+        if (Status[i] <> 0) and not CancelAlerts then
+            FOwner.FOnEventAlert( self, FEvents[i], Status[i], CancelAlerts);
+        except
+          Application.HandleException( nil);
+        end;
+      end;
+    end;
+    FState := stHasEvb;
+  if  CancelAlerts then
+      CancelEvents
+    else
+      QueueEvents
+end;
+
+procedure TEventHandler.Execute;
+begin
+  while not Terminated do
+  begin
+    {$IFDEF WINDOWS}
+    WaitForSingleObject(FEventHandler,INFINITE);
+    {$ELSE}
+    FEventWaiting.WaitFor(INFINITE);
+    {$ENDIF}
+
+    if not Terminated and (FState = stSignalled) then
+      Synchronize(DoEventSignalled)
+  end;
+end;
+
+
+
+constructor TEventHandler.Create(Owner: TIBEvents);
+var
+  PSa : PSecurityAttributes;
+{$IFDEF WINDOWS}
+  Sd : TSecurityDescriptor;
+  Sa : TSecurityAttributes;
+begin
+  InitializeSecurityDescriptor(@Sd,SECURITY_DESCRIPTOR_REVISION);
+  SetSecurityDescriptorDacl(@Sd,true,nil,false);
+  Sa.nLength := SizeOf(Sa);
+  Sa.lpSecurityDescriptor := @Sd;
+  Sa.bInheritHandle := true;
+  PSa := @Sa;
+{$ELSE}
+begin
+  PSa:= nil;
+{$ENDIF}
+  inherited Create(true);
+  FOwner := Owner;
+  FState := stIdle;
+  FCriticalSection := TCriticalSection.Create;
+  {$IFDEF WINDOWS}
+  FEventHandler := CreateEvent(PSa,false,true,nil);
+  {$ELSE}
+  FEventWaiting := TEventObject.Create(PSa,false,true,FOwner.Name+'.Events');
+  {$ENDIF}
+  FEvents := TStringList.Create;
+  FreeOnTerminate := true;
+  Resume
+end;
+
+destructor TEventHandler.Destroy;
+begin
+  if assigned(FCriticalSection) then FCriticalSection.Free;
+  {$IFDEF WINDOWS}
+  CloseHandle(FEventHandler);
+  {$ELSE}
+  if assigned(FEventWaiting) then FEventWaiting.Free;
+  {$ENDIF}
+  if assigned(FEvents) then FEvents.Free;
+  inherited Destroy;
+end;
+
+procedure TEventHandler.Terminate;
+begin
+  inherited Terminate;
+  {$IFDEF WINDOWS}
+  SetEvent(FEventHandler);
+  {$ELSE}
+  FEventWaiting.SetEvent;
+  {$ENDIF}
+  CancelEvents;
+end;
+
+procedure TEventHandler.RegisterEvents(Events: TStrings);
+var
+  i: integer;
+  EventNames: array of PChar;
+begin
+  UnregisterEvents;
+
+  if Events.Count = 0 then
+    exit;
+
+  setlength(EventNames,MaxEvents);
+  try
+    for i := 0 to Events.Count-1 do
+      EventNames[i] := PChar(Events[i]);
+    FEvents.Assign(Events);
+    FEventBufferlen := isc_event_block(@FEventBuffer,@FResultBuffer,
+                        Events.Count,
+                        EventNames[0],EventNames[1],EventNames[2],
+                        EventNames[3],EventNames[4],EventNames[5],
+                        EventNames[6],EventNames[7],EventNames[8],
+                        EventNames[9],EventNames[10],EventNames[11],
+                        EventNames[12],EventNames[13],EventNames[14]
+                        );
+    FState := stHasEvb;
+    FRegisteredState := true;
+    QueueEvents
+  finally
+    SetLength(EventNames,0)
+  end;
+end;
+
+procedure TEventHandler.UnregisterEvents;
+begin
+  if FRegisteredState then
+  begin
+    CancelEvents;
+    FRegisteredState := false;
+  end;
+end;
+
+{ TIBEvents }
+
+procedure TIBEvents.ValidateDatabase( Database: TIBDatabase);
+begin
+  if not assigned( Database) then
+    IBError(ibxeDatabaseNameMissing, [nil]);
+  if not Database.Connected then
+    IBError(ibxeDatabaseClosed, [nil]);
+end;
+
+constructor TIBEvents.Create( AOwner: TComponent);
+begin
+  inherited Create( AOwner);
+  FIBLoaded := False;
+  CheckIBLoaded;
+  FIBLoaded := True;
+  FBase := TIBBase.Create(Self);
+  FBase.BeforeDatabaseDisconnect := DoBeforeDatabaseDisconnect;
+  FBase.AfterDatabaseConnect := DoAfterDatabaseConnect;
+  FEvents := TStringList.Create;
+  with TStringList( FEvents) do
+  begin
+    OnChange := EventChange;
+    Duplicates := dupIgnore;
+  end;
+  FEventHandler := TEventHandler.Create(self)
+end;
+
+destructor TIBEvents.Destroy;
+begin
+  if FIBLoaded then
+  begin
+    UnregisterEvents;
+    SetDatabase(nil);
+    TStringList(FEvents).OnChange := nil;
+    FBase.Free;
+    FEvents.Free;
+  end;
+  if assigned(FEventHandler) then
+    TEventHandler(FEventHandler).Terminate;
+  FEventHandler := nil;
+  inherited Destroy;
+end;
+
+
+
+procedure TIBEvents.EventChange( sender: TObject);
+begin
+  { check for blank event }
+  if TStringList(Events).IndexOf( '') <> -1 then
+    IBError(ibxeInvalidEvent, [nil]);
+  { check for too many events }
+  if Events.Count > MaxEvents then
+  begin
+    TStringList(Events).OnChange := nil;
+    Events.Delete( MaxEvents);
+    TStringList(Events).OnChange := EventChange;
+    IBError(ibxeMaximumEvents, [nil]);
+  end;
+  if Registered then
+    TEventHandler(FEventHandler).RegisterEvents(Events);
+end;
+
+procedure TIBEvents.Notification( AComponent: TComponent;
+                                        Operation: TOperation);
+begin
+  inherited Notification( AComponent, Operation);
+  if (Operation = opRemove) and (AComponent = FBase.Database) then
+  begin
+    UnregisterEvents;
+    FBase.Database := nil;
+  end;
+end;
+
+procedure TIBEvents.RegisterEvents;
+begin
+  ValidateDatabase( Database);
+  if csDesigning in ComponentState then FRegistered := true
+  else
+  begin
+    if not FBase.Database.Connected then
+      FDeferredRegister := true
+    else
+    begin
+      TEventHandler(FEventHandler).RegisterEvents(Events);
+      FRegistered := true;
+    end;
+  end;
+end;
+
+procedure TIBEvents.SetEvents( value: TStrings);
+begin
+  FEvents.Assign( value);
+end;
+
+procedure TIBEvents.SetDatabase( value: TIBDatabase);
+begin
+  if value <> FBase.Database then
+  begin
+    if Registered then UnregisterEvents;
+    if assigned( value) and value.Connected then ValidateDatabase( value);
+    FBase.Database := value;
+    if (FBase.Database <> nil) and FBase.Database.Connected then
+      DoAfterDatabaseConnect(FBase.Database)
+  end;
+end;
+
+function TIBEvents.GetDatabase: TIBDatabase;
+begin
+  Result := FBase.Database
+end;
+
+procedure TIBEvents.SetRegistered( value: Boolean);
+begin
+  FDeferredRegister := false;
+  if not assigned(FBase) or (FBase.Database = nil) then
+  begin
+    FDeferredRegister := value;
+    Exit;
+  end;
+
+  if value then RegisterEvents else UnregisterEvents;
+end;
+
+procedure TIBEvents.UnregisterEvents;
+begin
+  FDeferredRegister := false;
+  if not FRegistered then
+    Exit;
+  if csDesigning in ComponentState then
+    FRegistered := false
+  else
+  begin
+    TEventHandler(FEventHandler).UnRegisterEvents;
+    FRegistered := false;
+  end;
+end;
+
+procedure TIBEvents.DoBeforeDatabaseDisconnect(Sender: TObject);
+begin
+  UnregisterEvents;
+end;
+
+procedure TIBEvents.DoAfterDatabaseConnect(Sender: TObject);
+begin
+  if FDeferredRegister then
+    Registered := true
+end;
+
+function TIBEvents.GetDatabaseHandle: TISC_DB_HANDLE;
+begin
+  ValidateDatabase(FBase.Database);
+  Result := FBase.Database.Handle;
+end;
+
+
+end.