--- Merging r21323 into '.':

U    packages/fcl-db/fpmake.pp
A    packages/fcl-db/src/sqldb/interbase/fbeventmonitor.pp
C    packages/fcl-db/src/sqldb/interbase/Makefile.fpc
U    packages/fcl-db/src/sqldb/interbase/fpmake.inc
C    packages/fcl-db/src/sqldb/interbase/Makefile
A    packages/fcl-db/examples/fbeventstest.pp
--- Merging r21324 into '.':
C    packages/fcl-db/fpmake.pp
U    packages/fcl-db/src/sqldb/postgres/Makefile.fpc
A    packages/fcl-db/src/sqldb/postgres/pqeventmonitor.pp
U    packages/fcl-db/src/sqldb/postgres/fpmake.inc
C    packages/fcl-db/src/sqldb/postgres/Makefile
A    packages/fcl-db/examples/pqeventstest.pp
--- Merging r21325 into '.':
U    packages/fcl-db/src/sqldb/mssql/mssqlconn.pp
--- Merging r21326 into '.':
G    packages/fcl-db/fpmake.pp
--- Merging r21364 into '.':
U    packages/fcl-db/src/base/bufdataset.pas
--- Merging r21365 into '.':
U    packages/fcl-db/tests/testdbbasics.pas
--- Merging r21373 into '.':
G    packages/fcl-db/src/base/bufdataset.pas
--- Merging r21490 into '.':
U    packages/fcl-db/src/export/fpcsvexport.pp
--- Merging r21491 into '.':
U    packages/fcl-db/src/sdf/sdfdata.pp
--- Merging r21540 into '.':
U    packages/fcl-db/src/sqldb/mysql/mysqlconn.inc
--- Merging r21583 into '.':
U    packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp
Summary of conflicts:
  Text conflicts: 4

# revisions: 21323,21324,21325,21326,21364,21365,21373,21490,21491,21540,21583
r21323 | michael | 2012-05-18 14:13:48 +0200 (Fri, 18 May 2012) | 1 line
Changed paths:
   A /trunk/packages/fcl-db/examples/fbeventstest.pp
   M /trunk/packages/fcl-db/fpmake.pp
   M /trunk/packages/fcl-db/src/sqldb/interbase/Makefile
   M /trunk/packages/fcl-db/src/sqldb/interbase/Makefile.fpc
   A /trunk/packages/fcl-db/src/sqldb/interbase/fbeventmonitor.pp
   M /trunk/packages/fcl-db/src/sqldb/interbase/fpmake.inc

* Add Event notification component from Ludo Brands (22060)
r21324 | michael | 2012-05-18 14:19:09 +0200 (Fri, 18 May 2012) | 1 line
Changed paths:
   A /trunk/packages/fcl-db/examples/pqeventstest.pp
   M /trunk/packages/fcl-db/fpmake.pp
   M /trunk/packages/fcl-db/src/sqldb/postgres/Makefile
   M /trunk/packages/fcl-db/src/sqldb/postgres/Makefile.fpc
   M /trunk/packages/fcl-db/src/sqldb/postgres/fpmake.inc
   A /trunk/packages/fcl-db/src/sqldb/postgres/pqeventmonitor.pp

* Add PostGres Event notification component from Ludo Brands (22060)
r21325 | michael | 2012-05-18 14:26:17 +0200 (Fri, 18 May 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/mssql/mssqlconn.pp

* Patch to improve error message from LacaK2 (Bug ID 22061)
r21326 | michael | 2012-05-18 15:58:36 +0200 (Fri, 18 May 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/fpmake.pp

* No resource files for event monitor components
r21364 | marco | 2012-05-23 06:57:36 +0200 (Wed, 23 May 2012) | 3 lines
Changed paths:
   M /trunk/packages/fcl-db/src/base/bufdataset.pas

 * Patch from Ludo Brands implementing TCustomBufdataset.lookup
   Mantis #22099
r21365 | marco | 2012-05-23 08:49:49 +0200 (Wed, 23 May 2012) | 2 lines
Changed paths:
   M /trunk/packages/fcl-db/tests/testdbbasics.pas

 * Patch from Mantis #22105 by Lacak2 that improves oldvalue testing.
r21373 | marco | 2012-05-23 14:37:02 +0200 (Wed, 23 May 2012) | 2 lines
Changed paths:
   M /trunk/packages/fcl-db/src/base/bufdataset.pas

 * Fixed gotcha in r21364. SQL Null instead of nil. Mantis #22108 by Ludo
r21490 | michael | 2012-06-05 20:35:22 +0200 (Tue, 05 Jun 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/export/fpcsvexport.pp

* Applied patch from Reinier Olislaghers to quote memo fields (bug 19759)
r21491 | michael | 2012-06-05 20:43:55 +0200 (Tue, 05 Jun 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/sdf/sdfdata.pp

* Fixed bug #19376: when quoting, quote character should be doubled
r21540 | michael | 2012-06-08 10:33:28 +0200 (Fri, 08 Jun 2012) | 1 line
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

* Patch from Ludo Brands to fix memory leak (bug 22228)
r21583 | marco | 2012-06-12 15:36:07 +0200 (Tue, 12 Jun 2012) | 3 lines
Changed paths:
   M /trunk/packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

 * Let gettablenames with TRUE as second param succeed, out of compatibility
   Patch from Lacak2 Mantis #22255

git-svn-id: branches/fixes_2_6@21965 -

.gitattributes

@@ -1794,6 +1794,8 @@ packages/fcl-base/texts/fptemplate.txt svneol=native#text/plain
 packages/fcl-db/Makefile svneol=native#text/plain
 packages/fcl-db/Makefile.fpc svneol=native#text/plain
 packages/fcl-db/examples/fbadmindemo.pp svneol=native#text/plain
+packages/fcl-db/examples/fbeventstest.pp svneol=native#text/plain
+packages/fcl-db/examples/pqeventstest.pp svneol=native#text/plain
 packages/fcl-db/fpmake.pp svneol=native#text/plain
 packages/fcl-db/src/Dataset.txt svneol=native#text/plain
 packages/fcl-db/src/README.txt svneol=native#text/plain
@@ -1941,6 +1943,7 @@ packages/fcl-db/src/sqldb/fpmake.pp svneol=native#text/plain
 packages/fcl-db/src/sqldb/interbase/Makefile svneol=native#text/plain
 packages/fcl-db/src/sqldb/interbase/Makefile.fpc svneol=native#text/plain
 packages/fcl-db/src/sqldb/interbase/fbadmin.pp svneol=native#text/plain
+packages/fcl-db/src/sqldb/interbase/fbeventmonitor.pp svneol=native#text/plain
 packages/fcl-db/src/sqldb/interbase/fpmake.inc svneol=native#text/plain
 packages/fcl-db/src/sqldb/interbase/fpmake.pp svneol=native#text/plain
 packages/fcl-db/src/sqldb/interbase/ibconnection.pp svneol=native#text/plain
@@ -1972,6 +1975,7 @@ packages/fcl-db/src/sqldb/postgres/Makefile.fpc svneol=native#text/plain
 packages/fcl-db/src/sqldb/postgres/fpmake.inc svneol=native#text/plain
 packages/fcl-db/src/sqldb/postgres/fpmake.pp svneol=native#text/plain
 packages/fcl-db/src/sqldb/postgres/pqconnection.pp svneol=native#text/plain
+packages/fcl-db/src/sqldb/postgres/pqeventmonitor.pp svneol=native#text/plain
 packages/fcl-db/src/sqldb/sqldb.pp svneol=native#text/plain
 packages/fcl-db/src/sqldb/sqlite/Makefile svneol=native#text/plain
 packages/fcl-db/src/sqldb/sqlite/Makefile.fpc svneol=native#text/plain

packages/fcl-db/examples/fbeventstest.pp

@@ -0,0 +1,151 @@
+program fbeventstest;
+
+{$mode delphi}{$H+}
+
+uses
+  {$IFDEF UNIX}
+  cthreads,
+  {$ENDIF}
+  Classes,sysutils,
+  FBEventMonitor,ibconnection,sqldb;
+
+const
+  MAXEVENTS=35;
+  NUMTESTS=100;
+
+type
+
+  { TMyEventAlert }
+
+  TMyEventAlert=class
+    class procedure OnFBEvent(Sender: TObject; EventName: string; EventCount: longint;
+      var CancelAlerts: boolean);
+  end;
+
+var
+  EvSent,EvReceived:Array [1..MAXEVENTS] of integer;
+  TotalRecieved:integer;
+
+function testNEvents(IBConnection:TIBConnection;n:integer):boolean;
+var
+  EventsM:TFBEventMonitor;
+  i,j,k:integer;
+  IBConnection2:TIBConnection;
+  bExpectEvents:boolean;
+begin
+  IBConnection.Close;
+  //Create second connection to listen on. Events are not sent to current connection.
+  IBConnection2:=TIBConnection.Create(nil);
+  IBConnection2.HostName:=IBConnection.HostName;
+  IBConnection2.DatabaseName:=IBConnection.DatabaseName;
+  IBConnection2.UserName:=IBConnection.UserName;
+  IBConnection2.Password:=IBConnection.Password;
+  for i:=1 to MAXEVENTS do
+    begin
+    EvSent[i]:=0;
+    EvReceived[i]:=0;
+    end;
+  EventsM:=TFBEventMonitor.create(nil);
+  EventsM.Connection:=IBConnection2;
+  for i:=1 to n do
+    EventsM.Events.Add('E'+IntToStr(i));
+  EventsM.OnEventAlert:=TMyEventAlert.OnFBEvent;
+  EventsM.RegisterEvents;
+  i:=NUMTESTS;
+  TotalRecieved:=0;
+  bExpectEvents:=false;
+  Randomize;
+  IBConnection.Open;
+  IBConnection.ExecuteDirect('RECREATE PROCEDURE send_custom(event_name varchar(127)) '+
+     'AS '+
+     'BEGIN '+
+     'POST_EVENT event_name; '+
+     'END ');
+  IBConnection.Transaction.Commit;
+  j:=1+random(i);  //random number of events per transaction
+  while i>0 do
+    begin
+    k:=1+random(n);
+    IBConnection.ExecuteDirect('execute PROCEDURE send_custom(''E'+IntTostr(k)+''');');
+    EvSent[k]:=EvSent[k]+1;
+    if i<j then
+      begin
+      IBConnection.Transaction.Commit;
+      bExpectEvents:=true;
+      j:=1+random(i);
+      end;
+    if bExpectEvents then
+      CheckSynchronize;
+    i:=i-1;
+    end;
+  IBConnection.Transaction.Commit;
+  for i:=1 to 300 do  //3 secs max
+    begin
+    Sleep(10); //wait until everything received
+    CheckSynchronize;
+    if TotalRecieved=NUMTESTS then
+      break;
+    end;
+  result:=true;
+  for i:=1 to n do
+    begin
+    result:=result and (EvSent[i]=EvReceived[i]);
+    end;
+  EventsM.Free;
+  IBConnection2.Free;
+  IBConnection.Close;
+end;
+
+{ TMyEventAlert }
+
+class procedure TMyEventAlert.OnFBEvent(Sender: TObject; EventName: string;
+  EventCount: longint; var CancelAlerts: boolean);
+var i:integer;
+begin
+  i:=StrToInt(copy(EventName,2,2));
+  EvReceived[i]:=EvReceived[i]+EventCount;
+  TotalRecieved:=TotalRecieved+EventCount;
+end;
+
+var
+  IBConnection1:TIBConnection;
+  SQLTransaction1: TSQLTransaction;
+  i:integer;
+
+begin
+  if paramcount=0 then
+    begin
+    WriteLn('Usage:');
+    WriteLn('  '+Paramstr(0) +' database [hostname] [username] [password]');
+    WriteLn('    database : database name.');
+    WriteLn('    hostname : default localhost');
+    WriteLn('    username : default SYSDBA.');
+    WriteLn('    password : default masterkey');
+    exit;
+    end;
+  IBConnection1:=TIBConnection.Create(nil);
+  SQLTransaction1:= TSQLTransaction.Create(nil);
+  IBConnection1.Transaction:=SQLTransaction1;
+  SQLTransaction1.DataBase:=IBConnection1;
+  IBConnection1.Password:='masterkey';
+  IBConnection1.UserName:='SYSDBA';
+  IBConnection1.HostName:='';
+  if paramcount=4 then
+    IBConnection1.Password:=paramstr(4);
+  if paramcount>=3 then
+    IBConnection1.UserName:=paramstr(3);
+  if paramcount>=2 then
+    IBConnection1.HostName:=paramstr(2);
+  IBConnection1.DatabaseName:=paramstr(1);
+  for i:=1 to 16 do
+    begin
+    if testNEvents(IBConnection1,i) then
+      WriteLn(inttostr(i)+' succeeded')
+    else
+      WriteLn(inttostr(i)+' failed. Missed '+ IntToStr(NUMTESTS-TotalRecieved)+' Events');
+    end;
+  SQLTransaction1.Free;
+  IBConnection1.Free;
+  WriteLn('Tests finished.');
+end.
+

packages/fcl-db/examples/pqeventstest.pp

@@ -0,0 +1,114 @@
+program PQEventsTest;
+
+{$mode delphi}{$H+}
+
+uses
+  {$IFDEF UNIX}
+  cthreads,
+  {$ENDIF}
+  Classes,sysutils,
+  PQEventMonitor,pqconnection,sqldb;
+
+const
+  MAXEVENTS=35;
+  NUMTESTS=100;
+
+type
+
+  { TMyEventAlert }
+
+  TMyEventAlert=class
+    class procedure OnPQEvent(Sender: TObject; EventName: string; EventCount: longint;
+      var CancelAlerts: boolean);
+  end;
+
+var
+  EvSent,EvReceived:Array [1..MAXEVENTS] of integer;
+  TotalRecieved:integer;
+
+function testNEvents(PQConnection:TPQConnection;n:integer):boolean;
+var
+  EventsM:TPQEventMonitor;
+  i,j,k:integer;
+begin
+  for i:=1 to MAXEVENTS do
+    begin
+    EvSent[i]:=0;
+    EvReceived[i]:=0;
+    end;
+  EventsM:=TPQEventMonitor.create(nil);
+  EventsM.Connection:=PQConnection;
+  for i:=1 to n do
+    EventsM.Events.Add('E'+IntToStr(i));
+  EventsM.OnEventAlert:=TMyEventAlert.OnPQEvent;
+  EventsM.RegisterEvents;
+  i:=NUMTESTS;
+  TotalRecieved:=0;
+  Randomize;
+  while i>0 do
+    begin
+    k:=1+random(n);
+    PQConnection.ExecuteDirect('NOTIFY E'+IntTostr(k));
+    PQConnection.Transaction.Commit;
+    EvSent[k]:=EvSent[k]+1;
+    EventsM.Poll;
+    i:=i-1;
+    end;
+  for i:=1 to 300 do  //3 secs max
+    begin
+    Sleep(10); //wait until everything received
+    EventsM.Poll;
+    if TotalRecieved=NUMTESTS then
+      break;
+    end;
+  result:=true;
+  for i:=1 to n do
+    begin
+    result:=result and (EvSent[i]=EvReceived[i]);
+    end;
+  EventsM.Free;
+end;
+
+{ TMyEventAlert }
+
+class procedure TMyEventAlert.OnPQEvent(Sender: TObject; EventName: string;
+  EventCount: longint; var CancelAlerts: boolean);
+var i:integer;
+begin
+  i:=StrToInt(copy(EventName,2,2));
+  EvReceived[i]:=EvReceived[i]+EventCount;
+  TotalRecieved:=TotalRecieved+EventCount;
+end;
+
+var
+  PQConnection1:TPQConnection;
+  SQLTransaction1: TSQLTransaction;
+  i:integer;
+
+begin
+  if paramcount<4 then
+    begin
+    WriteLn('Usage:');
+    WriteLn('  '+Paramstr(0) +' database hostname username password');
+    exit;
+    end;
+  PQConnection1:=TPQConnection.Create(nil);
+  SQLTransaction1:= TSQLTransaction.Create(nil);
+  PQConnection1.Transaction:=SQLTransaction1;
+  SQLTransaction1.DataBase:=PQConnection1;
+  PQConnection1.Password:=paramstr(4);
+  PQConnection1.UserName:=paramstr(3);
+  PQConnection1.HostName:=paramstr(2);
+  PQConnection1.DatabaseName:=paramstr(1);
+  for i:=1 to 16 do
+    begin
+    if testNEvents(PQConnection1,i) then
+      WriteLn(inttostr(i)+' succeeded')
+    else
+      WriteLn(inttostr(i)+' failed. Missed '+ IntToStr(NUMTESTS-TotalRecieved)+' Events');
+    end;
+  SQLTransaction1.Free;
+  PQConnection1.Free;
+  WriteLn('Tests finished.');
+end.
+

packages/fcl-db/fpmake.pp

@@ -4,6 +4,15 @@ program fpmake;
 
 uses fpmkunit;
 
+const
+  ParadoxOSes         = [beos,haiku,linux,freebsd,netbsd,openbsd,win32];
+  DatadictOSes        = [beos,haiku,linux,freebsd,win32,win64,wince,darwin,aix];
+  SqldbConnectionOSes = [beos,haiku,linux,freebsd,win32,win64,wince,darwin,iphonesim,netbsd,openbsd,aix];
+  SqliteOSes          = [beos,haiku,linux,freebsd,darwin,iphonesim,solaris,netbsd,openbsd,win32,wince,aix];
+  DBaseOSes           = [beos,haiku,linux,freebsd,darwin,iphonesim,solaris,netbsd,openbsd,win32,win64,wince,aix];
+  MSSQLOSes           = [beos,haiku,linux,freebsd,netbsd,openbsd,win32,win64];
+  SqldbWithoutPostgresOSes = [win64];
+
 Var
   P : TPackage;
   T : TTarget;
@@ -537,6 +546,15 @@ begin
           AddUnit('bufdataset');
           AddUnit('ibconnection');
         end;
+    T:=P.Targets.AddUnit('fbeventmonitor.pp', SqldbConnectionOSes);
+      with T.Dependencies do
+        begin
+          AddUnit('sqldb');
+          AddUnit('db');
+          AddUnit('dbconst');
+          AddUnit('bufdataset');
+          AddUnit('ibconnection');
+        end;
     T:=P.Targets.AddUnit('memds.pp');
     T.ResourceStrings:=true;
       with T.Dependencies do
@@ -627,6 +645,23 @@ begin
           AddUnit('dbconst');
           AddUnit('bufdataset');
         end;
+    T:=P.Targets.AddUnit('pqeventmonitor.pp', SqldbConnectionOSes-SqldbWithoutPostgresOSes);
+      with T.Dependencies do
+        begin
+          AddUnit('sqldb');
+          AddUnit('db');
+          AddUnit('dbconst');
+          AddUnit('bufdataset');
+          AddUnit('pqconnection');
+        end;
+    T:=P.Targets.AddUnit('mssqlconn.pp', MSSQLOSes);
+    with T.Dependencies do
+      begin
+        AddUnit('sqldb');
+        AddUnit('db');
+        AddUnit('dbconst');
+        AddUnit('bufdataset');
+      end;
     T:=P.Targets.AddUnit('sdfdata.pp');
       with T.Dependencies do
         begin

packages/fcl-db/src/base/bufdataset.pas

@@ -514,6 +514,7 @@ type
     procedure CancelUpdates; virtual;
     destructor Destroy; override;
     function Locate(const keyfields: string; const keyvalues: Variant; options: TLocateOptions) : boolean; override;
+    function Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant; override;
     function UpdateStatus: TUpdateStatus; override;
     function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
     procedure AddIndex(const AName, AFields : string; AOptions : TIndexOptions; const ADescFields: string = '';
@@ -3075,6 +3076,27 @@ begin
     end;
 end;
 
+function TCustomBufDataset.Lookup(const KeyFields: string;
+  const KeyValues: Variant; const ResultFields: string): Variant;
+var
+  bm:TBookmark;
+begin
+  result:=Null;
+  bm:=GetBookmark;
+  DisableControls;
+  try
+    if Locate(KeyFields,KeyValues,[]) then
+      begin
+//      CalculateFields(ActiveBuffer); // not needed, done by Locate more than once
+      result:=FieldValues[ResultFields];
+      end;
+    GotoBookmark(bm);
+    FreeBookmark(bm);
+  finally
+    EnableControls;
+  end;
+end;
+
 { TArrayBufIndex }
 
 function TArrayBufIndex.GetBookmarkSize: integer;

packages/fcl-db/src/export/fpcsvexport.pp

@@ -177,7 +177,14 @@ Var
 begin
   S:=FormatField(EF.Field);
   QS:=FormatSettings.QuoteStrings;
-  If (EF.Field.DataType in StringFieldTypes) and (QS<>[]) then
+  {If specified, quote everything that can contain delimiters;
+  leave numeric, date fields alone:}
+  If (
+  (EF.Field.DataType in StringFieldTypes) or
+  (EF.Field.DataType in MemoFieldTypes) or
+  (EF.Field.DataType in BlobFieldTypes)
+  )
+  and (QS<>[]) then
     begin
     If (qsAlways in QS) or HaveSpace(S,QS) or HaveDelimiter(S,QS) then
       begin
@@ -210,6 +217,10 @@ begin
   FHeaderRow:=True;
   FDelimiter:=',';
   FStringQuoteChar:='"';
+  FQuoteStrings:=[qsSpace, qsDelimiter];
+  {Sensible defaults as reading unquoted strings with delimiters/spaces will
+  either fail by creating phantom fields (qsDelimiter) or delete leading or
+  trailing data/spaces (qsSpace)}
 end;
 
 procedure TCSVFormatSettings.Assign(Source: TPersistent);

packages/fcl-db/src/sdf/sdfdata.pp

@@ -1054,7 +1054,10 @@ begin
     // Check for any delimiters occurring in field text
     if ((not QuoteMe) and (StrScan(PChar(Str), FDelimiter) <> nil)) then QuoteMe:=true;
     if (QuoteMe) then
+      begin
+      Str:=Stringreplace(Str,QuoteDelimiter,QuoteDelimiter+QuoteDelimiter,[rfReplaceAll]);
       Str := QuoteDelimiter + Str + QuoteDelimiter;
+      end;
     Result := Result + Str + FDelimiter;
   end;
   p := Length(Result);

packages/fcl-db/src/sqldb/interbase/Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2012/06/03]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2012/06/26]
 #
 default: all
 MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded mipsel-linux
@@ -289,199 +289,199 @@ endif
 override PACKAGE_NAME=fcl-db
 PACKAGEDIR_MAIN:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /fcl-db/Makefile.fpc,$(PACKAGESDIR))))))
 ifeq ($(FULL_TARGET),i386-linux)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-go32v2)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-win32)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-os2)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-freebsd)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-beos)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-haiku)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-netbsd)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-solaris)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-qnx)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-netware)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-openbsd)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-wdosx)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-darwin)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-emx)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-watcom)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-netwlibc)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-wince)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-embedded)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-symbian)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-nativent)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-iphonesim)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),m68k-linux)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),m68k-freebsd)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),m68k-netbsd)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),m68k-amiga)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),m68k-atari)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),m68k-openbsd)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),m68k-palmos)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),m68k-embedded)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),powerpc-linux)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),powerpc-netbsd)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),powerpc-amiga)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),powerpc-macos)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),powerpc-darwin)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),powerpc-morphos)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),powerpc-embedded)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),powerpc-wii)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),sparc-linux)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),sparc-netbsd)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),sparc-solaris)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),sparc-embedded)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),x86_64-linux)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),x86_64-netbsd)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),x86_64-solaris)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),x86_64-openbsd)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),x86_64-win64)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),x86_64-embedded)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),arm-linux)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),arm-palmos)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),arm-darwin)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),arm-wince)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),arm-gba)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),arm-nds)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),arm-embedded)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),arm-symbian)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),powerpc64-linux)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),powerpc64-darwin)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),powerpc64-embedded)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),avr-embedded)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),armeb-linux)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),armeb-embedded)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 ifeq ($(FULL_TARGET),mipsel-linux)
-override TARGET_UNITS+=ibconnection fbadmin
+override TARGET_UNITS+=ibconnection fbadmin  fbeventmonitor
 endif
 override INSTALL_FPCPACKAGE=y
 ifeq ($(FULL_TARGET),i386-linux)

packages/fcl-db/src/sqldb/interbase/Makefile.fpc

@@ -6,7 +6,7 @@
 main=fcl-db
 
 [target]
-units=ibconnection fbadmin
+units=ibconnection fbadmin  fbeventmonitor
 
 [require]
 packages=fcl-xml ibase 

packages/fcl-db/src/sqldb/interbase/fbeventmonitor.pp

@@ -0,0 +1,364 @@
+unit FBEventMonitor;
+
+{ Interbase/Firebird Event monitor
+
+  Copyright (C) 2012 Ludo Brands
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version with the following modification:
+
+  As a special exception, the copyright holders of this library give you
+  permission to link this library with independent modules to produce an
+  executable, regardless of the license terms of these independent modules,and
+  to copy and distribute the resulting executable under terms of your choice,
+  provided that you also meet, for each linked independent module, the terms
+  and conditions of the license of that module. An independent module is a
+  module which is not derived from or based on this library. If you modify
+  this library, you may extend this exception to your version of the library,
+  but you are not obligated to do so. If you do not wish to do so, delete this
+  exception statement from your version.
+
+  This program is distributed in the hope that it will be useful, but WITHOUT
+  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+
+{$mode objfpc}{$H+}
+
+{$Define LinkDynamically}
+
+interface
+
+uses
+  Classes, SysUtils,
+{$IfDef LinkDynamically}
+  ibase60dyn,
+{$Else}
+  ibase60,
+{$EndIf}
+  IBConnection,syncobjs,db,dbconst;
+
+type
+  TEventAlert = procedure(Sender: TObject; EventName: string; EventCount: longint;
+    var CancelAlerts: boolean) of object;
+  TErrorEvent = procedure(Sender: TObject; ErrorCode: integer) of object;
+
+  { TFBEventMonitor }
+
+  TFBEventMonitor=class (TComponent)
+  private
+    FConnection: TIBConnection;
+    FErrorMsg: string;
+    FEvents: TStrings;
+    FEventsThread: TThread;
+    FOnError: TErrorEvent;
+    FOnEventAlert: TEventAlert;
+    FRegistered: Boolean;
+    function GetNativeHandle: PISC_DB_HANDLE;
+    procedure SetConnection(AValue: TIBConnection);
+    procedure SetEvents(AValue: TStrings);
+    procedure SetRegistered(AValue: Boolean);
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure RegisterEvents; virtual;
+    procedure UnRegisterEvents; virtual;
+    property ErrorMsg:string read FErrorMsg;
+    property NativeHandle: PISC_DB_HANDLE read GetNativeHandle;
+  published
+    property Connection: TIBConnection read FConnection write SetConnection;
+    property Events: TStrings read FEvents write SetEvents;
+    property Registered: Boolean read FRegistered write SetRegistered;
+    property OnEventAlert: TEventAlert read FOnEventAlert write FOnEventAlert;
+    property OnError: TErrorEvent read FOnError write FOnError;
+  end;
+
+implementation
+const
+  MAXEVENTSPEREPB=15;      //isc_event_block limitated to 15 events.
+type
+  TEPBpair=record
+    EventBuf:PChar;        //isc_event_block event block
+    ResultBuf:PChar;       //isc_event_block result block
+    Signal:pointer;        //pointer to TFBEventsThread.FSignal
+    Signaled:Boolean;      //this event block is signaled
+    Len:ISC_LONG;          //lenght returned by isc_event_block
+    Count:integer;         //number of events in this event block
+    EventID:ISC_LONG;      //handle of current event returned by isc_que_events
+    bStartup:boolean;      //results are not valid yet, don't generate event
+  end;
+  PEPBpair=^TEPBpair;
+
+  { TFBEventsThread }
+
+  TFBEventsThread=class(TThread)
+  protected
+    FCancelAlerts: Boolean;
+    FCounts: array [0..19] of longint; //FB manual says ISC_STATUS but FB code int32
+    FEPBs: array of TEPBpair;
+    FErrorCode: integer;
+    FEventCount: integer;
+    FEventNumber: integer;
+    FParent:TFBEventMonitor;
+    FSignal:TSimpleEvent;
+    FStatus: array [0..19] of ISC_STATUS;
+    procedure CheckError(Status: PISC_STATUS);
+    procedure DoErrorEvent;
+    procedure DoEventAlert;
+    procedure Execute; override;
+    procedure QueueEvents(DBHandle: pointer; block: integer);
+  public
+    constructor Create(Parent:TFBEventMonitor);
+    procedure DoTerminate;
+  end;
+
+  { THandleIBConnection }
+  // descendant to access protected GetHandle
+  THandleIBConnection=class(TIBConnection)
+  private
+    function GetDBHandle: pointer;
+  public
+    property Handle:pointer read GetDBHandle;
+  end;
+
+procedure event_function(ptr:pointer;len:ushort;updated: pchar);cdecl;
+begin
+  Move(updated^, PEPBpair(ptr)^.ResultBuf^, len);
+  PEPBpair(ptr)^.signaled:=true;
+  TEventObject(PEPBpair(ptr)^.signal^).SetEvent;
+end;
+
+function THandleIBConnection.GetDBHandle: pointer;
+begin
+  result:=GetHandle;
+end;
+
+{ TFBEventsThread }
+
+procedure TFBEventsThread.CheckError(Status: PISC_STATUS);
+var
+  buf : array [0..1023] of char;
+
+begin
+  if ((Status[0] = 1) and (Status[1] <> 0)) then
+  begin
+    FErrorCode := Status[1];
+    FParent.FErrorMsg := '';
+    while isc_interprete(Buf, @Status) > 0 do
+      FParent.FErrorMsg := FParent.FErrorMsg + LineEnding +' -' + StrPas(Buf);
+    if Assigned(FParent.FOnError) then
+      synchronize(@DoErrorEvent);
+  end;
+end;
+
+procedure TFBEventsThread.DoErrorEvent;
+begin
+  FParent.FOnError(FParent,FErrorCode);
+end;
+
+procedure TFBEventsThread.DoEventAlert;
+begin
+  FParent.FOnEventAlert(FParent, FParent.FEvents[FEventNumber],FEventCount, FCancelAlerts);
+end;
+
+procedure TFBEventsThread.Execute;
+var
+  i,j:integer;
+  DBHandle : pointer;
+  bStartup:boolean;
+
+  function P(num:integer):pchar;
+  begin
+    num:=num+i*MAXEVENTSPEREPB;
+    if num<FParent.FEvents.Count then
+      result:=pchar(FParent.FEvents[num])
+    else
+      result:=nil;
+  end;
+
+begin
+  // create event blocks and register events
+  DBHandle:=THandleIBConnection(FParent.Connection).GetDBHandle;
+  SetLength(FEPBs,1+(FParent.FEvents.Count -1) div MAXEVENTSPEREPB);
+  for i:=0 to high(FEPBs) do
+    begin
+    FEPBs[i].Signal:=@FSignal;
+    FEPBs[i].bStartup:=true;
+    FEPBs[i].Count:=FParent.FEvents.Count-i*MAXEVENTSPEREPB;
+    if FEPBs[i].Count > MAXEVENTSPEREPB then
+      FEPBs[i].Count:=MAXEVENTSPEREPB;
+    FEPBs[i].Len := isc_event_block(@FEPBs[i].EventBuf, @FEPBs[i].ResultBuf,
+        word(FEPBs[i].Count),[
+        P(0), P(1),P(2), P(3), P(4),P(5), P(6), P(7),
+        P(8), P(9), P(10), P(11), P(12), P(13), P(14)]);
+    QueueEvents(DBHandle,i);
+    end;
+  FCancelAlerts:=false;
+  bStartup:=true;
+  while not Terminated do
+    begin
+    if FSignal.WaitFor(100)=wrSignaled then
+      begin
+      FSignal.ResetEvent;
+      for i:=0 to high(FEPBs) do
+        if FEPBs[i].Signaled then
+          begin
+          FEPBs[i].Signaled:=false;
+          isc_event_counts(@FCounts[0], Short(FEPBs[i].Len), FEPBs[i].EventBuf, FEPBs[i].ResultBuf);
+          if not FEPBs[i].bStartup and Assigned(FParent.FOnEventAlert) then
+            begin
+            for j:=0 to FEPBs[i].Count-1 do
+              if (FCounts[j]<>0) and not FCancelAlerts then
+                begin
+                FEventNumber:=(i-low(FEPBs))*MAXEVENTSPEREPB+j;
+                FEventCount:=FCounts[j];
+                Synchronize(@DoEventAlert);
+                end;
+            end;
+          FEPBs[i].bStartup:=false;
+          QueueEvents(DBHandle,i);
+          end;
+      end;
+    if terminated or FCancelAlerts or not FParent.Connection.Connected then
+      break;
+  end;
+  // unregister events
+  if FParent.Connection.Connected then   // Don't do this if connection is gone
+    for i:=0 to high(FEPBs) do
+      begin
+      isc_cancel_events(@FStatus[0],@DBHandle,@FEPBs[i].EventID);
+      isc_free(FEPBs[i].EventBuf);   //points to unreachable memory if connection gone
+      isc_free(FEPBs[i].ResultBuf);
+      CheckError(FStatus);
+      end;
+  SetLength(FEPBs,0);
+  FSignal.destroy;
+  FParent.FRegistered :=false;
+end;
+
+procedure TFBEventsThread.QueueEvents(DBHandle:pointer;block: integer);
+begin
+  isc_que_events(@FStatus[0], @DBHandle, @FEPBs[block].EventID, Short(FEPBs[block].Len),
+    FEPBs[block].EventBuf,TISC_CALLBACK(@event_function), @FEPBs[block]);
+  CheckError(FStatus);
+end;
+
+constructor TFBEventsThread.Create(Parent: TFBEventMonitor);
+begin
+  FParent:=Parent;
+  FSignal:=TSimpleEvent.Create();
+  inherited create(false);
+end;
+
+procedure TFBEventsThread.DoTerminate;
+begin
+  if not Terminated then
+    begin
+    Terminate;
+    FSignal.SetEvent;
+    end;
+end;
+
+{ TFBEventMonitor }
+
+
+function TFBEventMonitor.GetNativeHandle: PISC_DB_HANDLE;
+begin
+  result:=THandleIBConnection(FConnection).GetDBHandle;
+end;
+
+
+procedure TFBEventMonitor.SetConnection(AValue: TIBConnection);
+begin
+  if FConnection=AValue then Exit;
+  If not (csDesigning in ComponentState) and FRegistered then
+    begin
+    if assigned(FConnection) then
+      FConnection.RemoveFreeNotification(self); // remove us from the old connection
+    UnRegisterEvents;
+    FConnection:=AValue;
+    if assigned(FConnection) then
+      begin
+      RegisterEvents;
+      end;
+    end
+  else
+    FConnection:=AValue;
+  if assigned(FConnection) then
+    FConnection.FreeNotification(Self); //in case Connection is destroyed before we are
+
+end;
+
+procedure TFBEventMonitor.SetEvents(AValue: TStrings);
+begin
+  FEvents.Assign(AValue);
+end;
+
+procedure TFBEventMonitor.SetRegistered(AValue: Boolean);
+begin
+  FRegistered := AValue;
+  if not (csDesigning in ComponentState) then
+    if AValue then
+      RegisterEvents
+    else
+      UnRegisterEvents;
+end;
+
+constructor TFBEventMonitor.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FEvents:=TStringList.Create;
+  {$IfDef LinkDynamically}
+  InitialiseIBase60;             // stick to library in case connection closes before us
+  {$EndIf}
+end;
+
+destructor TFBEventMonitor.Destroy;
+begin
+  if FRegistered then
+    UnRegisterEvents;
+  if assigned(FConnection) then
+    FConnection.RemoveFreeNotification(self);
+  FEvents.Free;
+  {$IfDef LinkDynamically}
+  ReleaseIBase60;
+  {$EndIf}
+  inherited Destroy;
+end;
+
+procedure TFBEventMonitor.RegisterEvents;
+begin
+  If not assigned(FConnection) then
+    DatabaseError(SErrNoDatabaseAvailable,Self);
+  if not(csDesigning in ComponentState) and not FRegistered and (Events.Count>0) then
+    begin
+    if not Connection.Connected then
+       Connection.Connected:=true;
+    if Connection.Connected then
+      begin
+      FEventsThread:=TFBEventsThread.Create(Self);
+      FEventsThread.FreeOnTerminate:=true;
+      FRegistered :=assigned(FEventsThread);
+      end;
+    end;
+end;
+
+procedure TFBEventMonitor.UnRegisterEvents;
+begin
+  if not (csDesigning in ComponentState) and FRegistered then
+    begin
+    TFBEventsThread(FEventsThread).DoTerminate;
+    FEventsThread.WaitFor;
+    FRegistered :=false;
+    end;
+end;
+
+end.
+

packages/fcl-db/src/sqldb/interbase/fpmake.inc

@@ -12,4 +12,7 @@ T.ResourceStrings:=True;
 T:=Targets.AddUnit('fbadmin');
 T.Dependencies.Add('ibconnection');
 T.ResourceStrings:=True;
+T:=Targets.AddUnit('fbeventmonitor');
+T.Dependencies.Add('ibconnection');
+T.ResourceStrings:=True;
 

packages/fcl-db/src/sqldb/mssql/mssqlconn.pp

@@ -233,6 +233,7 @@ end;
 
 function TMSSQLConnection.CheckError(const Ret: RETCODE): RETCODE;
 var E: EMSSQLDatabaseError;
+    CompName: string;
 begin
   if Ret=FAIL then
   begin
@@ -240,7 +241,8 @@ begin
       case DBErrorNo of
         SYBEFCON: DBErrorStr:='SQL Server connection failed!';
       end;
-    E:=EMSSQLDatabaseError.CreateFmt('%s Error %d: %s'+LineEnding+'%s', [ClassName, DBErrorNo, DBErrorStr, DBMsgStr]);
+    if Self.Name = '' then CompName := Self.ClassName else CompName := Self.Name;
+    E:=EMSSQLDatabaseError.CreateFmt('%s : Error %d : %s'+LineEnding+'%s', [CompName, DBErrorNo, DBErrorStr, DBMsgStr]);
     E.DBErrorCode:=DBErrorNo;
     DBErrorStr:='';
     DBMsgStr:='';

packages/fcl-db/src/sqldb/mysql/mysqlconn.inc

@@ -509,8 +509,16 @@ begin
 end;
 
 procedure TConnectionName.UnPrepareStatement(cursor: TSQLCursor);
+Var
+  C : TCursorName;
+
 begin
-  // do nothing
+  C:=Cursor as TCursorName;
+  if assigned(C.FRes) then  //ExecSQL with dataset returned
+    begin
+    mysql_free_result(C.FRes);
+    C.FRes:=nil;
+    end;
 end;
 
 procedure TConnectionName.FreeFldBuffers(cursor: TSQLCursor);

packages/fcl-db/src/sqldb/postgres/Makefile

@@ -1,8 +1,8 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2011/12/30]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2012/06/26]
 #
 default: all
-MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-solaris x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded mipsel-linux
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded mipsel-linux
 BSDs = freebsd netbsd openbsd darwin
 UNIXs = linux $(BSDs) solaris qnx haiku
 LIMIT83fs = go32v2 os2 emx watcom
@@ -289,193 +289,199 @@ endif
 override PACKAGE_NAME=fcl-db
 PACKAGEDIR_MAIN:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /fcl-db/Makefile.fpc,$(PACKAGESDIR))))))
 ifeq ($(FULL_TARGET),i386-linux)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-go32v2)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-win32)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-os2)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-freebsd)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-beos)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-haiku)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-netbsd)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-solaris)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-qnx)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-netware)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-openbsd)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-wdosx)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-darwin)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-emx)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-watcom)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-netwlibc)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-wince)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-embedded)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-symbian)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-nativent)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-iphonesim)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),m68k-linux)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),m68k-freebsd)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),m68k-netbsd)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),m68k-amiga)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),m68k-atari)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),m68k-openbsd)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),m68k-palmos)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),m68k-embedded)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),powerpc-linux)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),powerpc-netbsd)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),powerpc-amiga)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),powerpc-macos)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),powerpc-darwin)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),powerpc-morphos)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),powerpc-embedded)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),powerpc-wii)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),sparc-linux)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),sparc-netbsd)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),sparc-solaris)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),sparc-embedded)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),x86_64-linux)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
+endif
+ifeq ($(FULL_TARGET),x86_64-netbsd)
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),x86_64-solaris)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
+endif
+ifeq ($(FULL_TARGET),x86_64-openbsd)
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),x86_64-win64)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),x86_64-embedded)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),arm-linux)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),arm-palmos)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),arm-darwin)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),arm-wince)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),arm-gba)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),arm-nds)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),arm-embedded)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),arm-symbian)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),powerpc64-linux)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),powerpc64-darwin)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),powerpc64-embedded)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),avr-embedded)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),armeb-linux)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),armeb-embedded)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),mipsel-linux)
-override TARGET_UNITS+=pqconnection
+override TARGET_UNITS+=pqconnection pqeventmonitor
 endif
 ifeq ($(FULL_TARGET),i386-linux)
 override TARGET_RSTS+=pqconnection
@@ -609,9 +615,15 @@ endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
 override TARGET_RSTS+=pqconnection
 endif
+ifeq ($(FULL_TARGET),x86_64-netbsd)
+override TARGET_RSTS+=pqconnection
+endif
 ifeq ($(FULL_TARGET),x86_64-solaris)
 override TARGET_RSTS+=pqconnection
 endif
+ifeq ($(FULL_TARGET),x86_64-openbsd)
+override TARGET_RSTS+=pqconnection
+endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
 override TARGET_RSTS+=pqconnection
 endif
@@ -799,9 +811,15 @@ endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
 override COMPILER_OPTIONS+=-S2
 endif
+ifeq ($(FULL_TARGET),x86_64-netbsd)
+override COMPILER_OPTIONS+=-S2
+endif
 ifeq ($(FULL_TARGET),x86_64-solaris)
 override COMPILER_OPTIONS+=-S2
 endif
+ifeq ($(FULL_TARGET),x86_64-openbsd)
+override COMPILER_OPTIONS+=-S2
+endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
 override COMPILER_OPTIONS+=-S2
 endif
@@ -1761,12 +1779,24 @@ REQUIRE_PACKAGES_ICONVENC=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_POSTGRES=1
 endif
+ifeq ($(FULL_TARGET),x86_64-netbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_FCL-BASE=1
+REQUIRE_PACKAGES_FCL-XML=1
+REQUIRE_PACKAGES_POSTGRES=1
+endif
 ifeq ($(FULL_TARGET),x86_64-solaris)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_FCL-BASE=1
 REQUIRE_PACKAGES_FCL-XML=1
 REQUIRE_PACKAGES_POSTGRES=1
 endif
+ifeq ($(FULL_TARGET),x86_64-openbsd)
+REQUIRE_PACKAGES_RTL=1
+REQUIRE_PACKAGES_FCL-BASE=1
+REQUIRE_PACKAGES_FCL-XML=1
+REQUIRE_PACKAGES_POSTGRES=1
+endif
 ifeq ($(FULL_TARGET),x86_64-darwin)
 REQUIRE_PACKAGES_RTL=1
 REQUIRE_PACKAGES_UNIVINT=1

packages/fcl-db/src/sqldb/postgres/Makefile.fpc

@@ -7,7 +7,7 @@ main=fcl-db
 
 [target]
 rsts=pqconnection
-units=pqconnection
+units=pqconnection pqeventmonitor
 
 [require]
 packages=fcl-xml postgres

packages/fcl-db/src/sqldb/postgres/fpmake.inc

@@ -9,3 +9,5 @@ Targets.DefaultDir:='db/sqldb/postgres';
 Targets.DefaultOS:=[win32,openbsd,netbsd,freebsd,darwin,linux,haiku];
 T:=Targets.AddUnit('pqconnection');
 T.ResourceStrings:=True;
+T:=Targets.AddUnit('pqeventmonitor');
+T.Dependencies.Add('pqconnection');

packages/fcl-db/src/sqldb/postgres/pqeventmonitor.pp

@@ -0,0 +1,251 @@
+unit PQEventMonitor;
+
+{ PostGresql notification monitor
+
+  Copyright (C) 2012 Ludo Brands
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version with the following modification:
+
+  As a special exception, the copyright holders of this library give you
+  permission to link this library with independent modules to produce an
+  executable, regardless of the license terms of these independent modules,and
+  to copy and distribute the resulting executable under terms of your choice,
+  provided that you also meet, for each linked independent module, the terms
+  and conditions of the license of that module. An independent module is a
+  module which is not derived from or based on this library. If you modify
+  this library, you may extend this exception to your version of the library,
+  but you are not obligated to do so. If you do not wish to do so, delete this
+  exception statement from your version.
+
+  This program is distributed in the hope that it will be useful, but WITHOUT
+  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+
+{$mode objfpc}{$H+}
+{$Define LinkDynamically}
+
+interface
+
+uses
+  Classes, SysUtils,pqconnection,db,dbconst,
+{$IfDef LinkDynamically}
+  postgres3dyn;
+{$Else}
+  postgres3;
+{$EndIf}
+
+
+type
+  TEventAlert = procedure(Sender: TObject; EventName: string; EventCount: longint;
+    var CancelAlerts: boolean) of object;
+  TErrorEvent = procedure(Sender: TObject; ErrorCode: integer) of object;
+
+{ TPQEventMonitor }
+
+  TPQEventMonitor=class (TComponent)
+  private
+    FConnection: TPQConnection;
+    FDBHandle: PPGconn;
+    FErrorMsg: string;
+    FEvents: TStrings;
+    FOnError: TErrorEvent;
+    FOnEventAlert: TEventAlert;
+    FRegistered: Boolean;
+    function GetNativeHandle: pointer;
+    procedure SetConnection(AValue: TPQConnection);
+    procedure SetEvents(AValue: TStrings);
+    procedure SetRegistered(AValue: Boolean);
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure Poll;
+    procedure RegisterEvents; virtual;
+    procedure UnRegisterEvents; virtual;
+    property ErrorMsg:string read FErrorMsg;
+    property NativeHandle: pointer read GetNativeHandle;
+  published
+    property Connection: TPQConnection read FConnection write SetConnection;
+    property Events: TStrings read FEvents write SetEvents;
+    property Registered: Boolean read FRegistered write SetRegistered;
+    property OnEventAlert: TEventAlert read FOnEventAlert write FOnEventAlert;
+    property OnError: TErrorEvent read FOnError write FOnError;
+  end;
+
+
+implementation
+
+ResourceString
+  SErrConnectionFailed = 'Connection to database failed';
+  SErrExecuteFailed = 'Execution of query failed';
+
+{ TPQEventMonitor }
+
+function TPQEventMonitor.GetNativeHandle: pointer;
+begin
+  result:=FDBHandle;
+end;
+
+
+procedure TPQEventMonitor.SetConnection(AValue: TPQConnection);
+begin
+  if FConnection=AValue then Exit;
+  If not (csDesigning in ComponentState) and FRegistered then
+    begin
+    if assigned(FConnection) then
+      FConnection.RemoveFreeNotification(self); // remove us from the old connection
+    UnRegisterEvents;
+    FConnection:=AValue;
+    if assigned(FConnection) then
+      begin
+      RegisterEvents;
+      end;
+    end
+  else
+    FConnection:=AValue;
+  if assigned(FConnection) then
+    FConnection.FreeNotification(Self); //in case Connection is destroyed before we are
+end;
+
+procedure TPQEventMonitor.SetEvents(AValue: TStrings);
+begin
+  FEvents.Assign(AValue);
+end;
+
+procedure TPQEventMonitor.SetRegistered(AValue: Boolean);
+begin
+  FRegistered := AValue;
+  if not (csDesigning in ComponentState) then
+    if AValue then
+      RegisterEvents
+    else
+      UnRegisterEvents;
+end;
+
+constructor TPQEventMonitor.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FEvents:=TStringList.Create;
+  {$IfDef LinkDynamically}
+  InitialisePostgres3;             // stick to library in case connection closes before us
+  {$EndIf}
+end;
+
+destructor TPQEventMonitor.Destroy;
+begin
+  if FRegistered then
+    UnRegisterEvents;
+  if assigned(FConnection) then
+    FConnection.RemoveFreeNotification(self);
+  FEvents.Free;
+  {$IfDef LinkDynamically}
+  ReleasePostgres3;
+  {$EndIf}
+  inherited Destroy;
+end;
+
+procedure TPQEventMonitor.Poll;
+var
+  notify:PpgNotify;
+  CancelAlerts:boolean;
+begin
+  if FConnection.Connected and FRegistered and (PQconsumeInput(FDBHandle)=1) then
+    begin
+    CancelAlerts:=false;
+    repeat
+      notify:=PQnotifies(FDBHandle);
+      if assigned(notify) then
+        begin
+        if assigned(OnEventAlert) then
+          OnEventAlert(Self,notify^.relname,1,CancelAlerts);
+        PQfreemem(notify);
+        end;
+    until not assigned(notify) or CancelAlerts;
+    if CancelAlerts then
+      UnRegisterEvents;
+    end;
+end;
+
+procedure TPQEventMonitor.RegisterEvents;
+var
+  i:Integer;
+  sConn: String;
+  res: PPGresult;
+  msg:string;
+  notify:PpgNotify;
+  CancelAlerts:boolean;
+begin
+  If not assigned(FConnection) then
+    DatabaseError(SErrNoDatabaseAvailable,Self);
+  if not(csDesigning in ComponentState) and not FRegistered and (Events.Count>0) then
+    begin
+    sConn := '';
+    if (FConnection.UserName <> '') then sConn := sConn + ' user=''' + FConnection.UserName + '''';
+    if (FConnection.Password <> '') then sConn := sConn + ' password=''' + FConnection.Password + '''';
+    if (FConnection.HostName <> '') then sConn := sConn + ' host=''' + FConnection.HostName + '''';
+    if (FConnection.DatabaseName <> '') then sConn := sConn + ' dbname=''' + FConnection.DatabaseName + '''';
+    if (FConnection.Params.Text <> '') then sConn := sConn + ' '+FConnection.Params.Text;
+
+    FDBHandle := PQconnectdb(pchar(sConn));
+    if (PQstatus(FDBHandle) <> CONNECTION_OK) then
+      begin
+      msg := PQerrorMessage(FDBHandle);
+      PQFinish(FDBHandle);
+      DatabaseError(sErrConnectionFailed + ' (TPQEventMonitor: ' + Msg + ')',self);
+      end;
+    for i:=0 to Events.Count-1 do
+      begin
+      res := PQexec(FDBHandle,pchar('LISTEN '+ Events[i]));
+      if (PQresultStatus(res) <> PGRES_COMMAND_OK) then
+        begin
+        msg := PQerrorMessage(FDBHandle);
+        PQclear(res);
+        PQFinish(FDBHandle);
+        FDBHandle:=nil;
+        DatabaseError(SErrExecuteFailed + ' (TPQEventMonitor: ' + Msg + ')',self);
+        end
+      else
+        PQclear(res);
+      end;
+    FRegistered :=true;
+    end;
+end;
+
+procedure TPQEventMonitor.UnRegisterEvents;
+var
+  i: Integer;
+  res: PPGresult;
+  msg:string;
+begin
+  if not (csDesigning in ComponentState) and FRegistered then
+    begin
+    for i:=0 to Events.Count-1 do
+      begin
+      res := PQexec(FDBHandle,pchar('unlisten '+ Events[i]));
+      if (PQresultStatus(res) <> PGRES_COMMAND_OK) then
+        begin
+        msg := PQerrorMessage(FDBHandle);
+        PQclear(res);
+        PQFinish(FDBHandle);
+        FDBHandle:=nil;
+        DatabaseError(SErrExecuteFailed + ' (TPQEventMonitor: ' + Msg + ')',self);
+        end
+      else
+        PQclear(res);
+      end;
+    PQFinish(FDBHandle);
+    FDBHandle:=nil;
+    FRegistered :=false;
+    end;
+end;
+
+end.
+

packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

@@ -831,6 +831,7 @@ function TSQLite3Connection.GetSchemaInfoSQL(SchemaType: TSchemaType;
 begin
   case SchemaType of
     stTables     : result := 'select name as table_name from sqlite_master where type = ''table'' order by 1';
+    stSysTables  : result := 'select ''sqlite_master'' as table_name';
     stColumns    : result := 'pragma table_info(''' + (SchemaObjectName) + ''')';
   else
     DatabaseError(SMetadataUnavailable)

packages/fcl-db/tests/testdbbasics.pas

@@ -610,13 +610,28 @@ begin
 end;
 
 procedure TTestCursorDBBasics.TestOldValue;
-var v : variant;
-    bufds: TDataset;
 begin
-  bufds := DBConnector.GetNDataset(0) as TDataset;
-  bufds.Open;
-  bufds.InsertRecord([0,'name']);
-  v := VarToStr(bufds.fields[1].OldValue);
+  with DBConnector.GetNDataset(1) as TDataset do
+  begin;
+    Open;
+    First;
+    CheckEquals('1', VarToStr(Fields[0].OldValue), 'Original value');  // unmodified original value
+    CheckTrue(UpdateStatus=usUnmodified, 'Unmodified');
+
+    Edit;
+    Fields[0].AsInteger := -1;
+    CheckEquals('1', VarToStr(Fields[0].OldValue), 'Editing');  // dsEdit, there is no update-buffer yet
+    Post;
+    CheckEquals('1', VarToStr(Fields[0].OldValue), 'Edited');  // there is already update-buffer
+    CheckTrue(UpdateStatus=usModified, 'Modified');
+
+    Append;
+    Fields[0].AsInteger := -2;
+    CheckTrue(VarIsNull(Fields[0].OldValue), 'Inserting'); // dsInsert, there is no update-buffer yet
+    Post;
+    CheckTrue(VarIsNull(Fields[0].OldValue), 'Inserted'); // there is already update-buffer
+    CheckTrue(UpdateStatus=usInserted, 'Inserted');
+  end;
 end;
 
 procedure TTestDBBasics.TestCanModifySpecialFields;