Browse Source

* Transfer ForcedClose from TSQLConnector to proxy. Fixes issue #39910

Michaël Van Canneyt 1 year ago
parent
commit
d9fb288552

+ 6 - 0
packages/fcl-db/src/base/database.inc

@@ -650,6 +650,12 @@ begin
   FBeforeDisconnect:=AValue;
 end;
 
+procedure TCustomConnection.SetForcedClose(AValue: Boolean);
+begin
+  if FForcedClose=AValue then Exit;
+  FForcedClose:=AValue;
+end;
+
 procedure TCustomConnection.DoCloseError(aError: Exception);
 begin
   if Assigned(FOnCloseError) then

+ 2 - 1
packages/fcl-db/src/base/db.pas

@@ -2238,6 +2238,7 @@ type
     procedure SetBeforeDisconnect(const AValue: TNotifyEvent);
   protected
     Procedure DoCloseError(aError : Exception);
+    procedure SetForcedClose(AValue: Boolean); virtual;
     procedure CloseForDestroy;
     procedure DoLoginPrompt; virtual;
     procedure DoConnect; virtual;
@@ -2250,7 +2251,7 @@ type
     procedure Loaded; override;
     procedure SetConnected (Value : boolean); virtual;
     procedure SetLoginParams(const ADatabaseName, AUserName, APassword: string); virtual;
-    property ForcedClose : Boolean read FForcedClose write FForcedClose;
+    property ForcedClose : Boolean read FForcedClose write SetForcedClose;
     property StreamedConnected: Boolean read FStreamedConnected write FStreamedConnected;
   public
     procedure Close(ForceClose: Boolean=False);

+ 7 - 0
packages/fcl-db/src/sqldb/sqldb.pp

@@ -778,6 +778,7 @@ type
     FConnectorType: String;
     procedure SetConnectorType(const AValue: String);
   protected
+    procedure SetForcedClose(AValue: Boolean); override;
     procedure SetTransaction(Value : TSQLTransaction);override;
     procedure DoInternalConnect; override;
     procedure DoInternalDisconnect; override;
@@ -3803,6 +3804,12 @@ begin
     end;
 end;
 
+procedure TSQLConnector.SetForcedClose(AValue: Boolean);
+begin
+  inherited SetForcedClose(AValue);
+  FProxy.ForcedClose:=aValue;
+end;
+
 procedure TSQLConnector.SetTransaction(Value: TSQLTransaction);
 begin
   inherited SetTransaction(Value);