* Force close during destroy, add event to report errors

packages/fcl-db/src/base/database.inc

@@ -66,7 +66,7 @@ end;
 destructor TDatabase.Destroy;
 
 begin
-  Connected:=False;
+  CloseForDestroy;
   RemoveDatasets;
   RemoveTransactions;
   FDatasets.Free;
@@ -650,6 +650,12 @@ begin
   FBeforeDisconnect:=AValue;
 end;
 
+procedure TCustomConnection.DoCloseError(aError: Exception);
+begin
+  if Assigned(FOnCloseError) then
+    FOnCloseError(Self,aError);
+end;
+
 procedure TCustomConnection.DoLoginPrompt;
 
 var
@@ -764,9 +770,34 @@ begin
   end;
 end;
 
+procedure TCustomConnection.CloseForDestroy;
+
+Const
+  MaxCount = 2;
+
+var
+  Force : Boolean;
+  aCount : Integer;
+begin
+  Force:=False;
+  aCount:=0;
+  While Connected and (aCount<MaxCount) do
+    try
+      Inc(aCount);
+      // Will set connected to false
+      Close(Force);
+    except
+      On E : Exception do
+        begin
+        Force:=True;
+        DoCloseError(E);
+        end;
+    end;
+end;
+
 destructor TCustomConnection.Destroy;
 begin
-  Connected:=False;
+  CloseForDestroy;
   Inherited Destroy;
 end;
 

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

@@ -2219,6 +2219,7 @@ type
   { TCustomConnection }
 
   TLoginEvent = procedure(Sender: TObject; Username, Password: string) of object;
+  TCloseErrorEvent = procedure(Sender : TObject; aError : Exception) of object;
 
   TCustomConnection = class(TComponent)
   private
@@ -2228,6 +2229,7 @@ type
     FBeforeDisconnect: TNotifyEvent;
     FForcedClose: Boolean;
     FLoginPrompt: Boolean;
+    FOnCloseError: TCloseErrorEvent;
     FOnLogin: TLoginEvent;
     FStreamedConnected: Boolean;
     procedure SetAfterConnect(const AValue: TNotifyEvent);
@@ -2235,6 +2237,8 @@ type
     procedure SetBeforeConnect(const AValue: TNotifyEvent);
     procedure SetBeforeDisconnect(const AValue: TNotifyEvent);
   protected
+    Procedure DoCloseError(aError : Exception);
+    procedure CloseForDestroy;
     procedure DoLoginPrompt; virtual;
     procedure DoConnect; virtual;
     procedure DoDisconnect; virtual;
@@ -2263,6 +2267,7 @@ type
     property BeforeConnect : TNotifyEvent read FBeforeConnect write SetBeforeConnect;
     property BeforeDisconnect : TNotifyEvent read FBeforeDisconnect write SetBeforeDisconnect;
     property OnLogin: TLoginEvent read FOnLogin write FOnLogin;
+    Property OnCloseError : TCloseErrorEvent Read FOnCloseError Write FOnCloseError;
   end;
 
 

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

@@ -1410,7 +1410,7 @@ end;
 destructor TSQLConnection.Destroy;
 begin
   try
-    Connected:=False; // needed because we want to de-allocate statements
+    CloseForDestroy; // needed because we want to de-allocate statements
   Finally  
     FreeAndNil(FStatements);
     inherited Destroy;