Servidor: al adquirir conexiones de BD comprobar si hay conexión antes de utilizarlas en los servicios.

git-svn-id: https://192.168.0.254/svn/Proyectos.LuisLeon_FactuGES/trunk@269 c93665c3-c93d-084d-9b98-7d5f4a9c3376

Source/Modulos/Tienda web/Servidor/srvTiendaWeb_Impl.pas

@@ -87,7 +87,7 @@ procedure TsrvTiendaWeb.bp_osc_CustomersGenerateSQL(
   const ReferencedStatement: TDAStatement; const aDelta: IDADelta;
   var SQL: string);
 begin
-  dmServer.EscribirLog(SQL + #10#13 + #10#13);
+  dmServer.EscribirLog(SQL + #13#10 + #13#10);
 end;
 
 procedure TsrvTiendaWeb.DARemoteServiceBeforeGetDatasetData(

Source/Servidor/uDataModuleServer.dfm

@@ -41,8 +41,11 @@ object dmServer: TdmServer
   end
   object ConnectionManager: TDAConnectionManager
     MaxPoolSize = 10
-    PoolTimeoutSeconds = 60
+    PoolTimeoutSeconds = 120
     PoolBehaviour = pbWait
+    OnConnectionAcquired = ConnectionManagerConnectionAcquired
+    OnConnectionTimedOut = ConnectionManagerConnectionTimedOut
+    OnConnectionCreated = ConnectionManagerConnectionCreated
     WaitIntervalSeconds = 1
     Connections = <
       item
@@ -96,4 +99,13 @@ object dmServer: TdmServer
     Left = 232
     Top = 136
   end
+  object ADOQuery1: TADOQuery
+    Parameters = <>
+    Left = 320
+    Top = 224
+  end
+  object ADOConnection1: TADOConnection
+    Left = 248
+    Top = 208
+  end
 end

Source/Servidor/uDataModuleServer.pas

@@ -8,7 +8,8 @@ uses
   uROSessions, uDADataTable, uDABINAdapter, IBSQLMonitor, JvComponent,
   JvAppStorage, JvAppRegistryStorage, uDAInterfaces,
   JvComponentBase, uROEventRepository,
-  SyncObjs, JvLogFile, uDAIBXDriver, uDAADODriver;
+  SyncObjs, JvLogFile, uDAIBXDriver, uDAADODriver, DB, IBCustomDataSet, IBQuery,
+  ADODB;
 
 const
   SERVER_PORT = '8099';    // Puerto por defecto
@@ -27,6 +28,8 @@ type
     DAIBXDriver: TDAIBXDriver;
     DAADODriver: TDAADODriver;
     ConnectionManager: TDAConnectionManager;
+    ADOQuery1: TADOQuery;
+    ADOConnection1: TADOConnection;
     procedure DataModuleCreate(Sender: TObject);
     procedure DataModuleDestroy(Sender: TObject);
     procedure HTTPServerBeforeServerActivate(Sender: TObject);
@@ -34,6 +37,11 @@ type
       Tag: Integer);
     procedure SessionManagerSessionDeleted(const aSessionID: TGUID;
       IsExpired: Boolean);
+    procedure ConnectionManagerConnectionAcquired(Sender: TDAConnectionManager;
+      const Connection: IDAConnection);
+    procedure ConnectionManagerConnectionTimedOut(Sender: TDAConnectionManager);
+    procedure ConnectionManagerConnectionCreated(Sender: TDAConnectionManager;
+      const Connection: IDAConnection);
   private
     FEscribirLog : TCriticalSection;
     FConnectionName : string;
@@ -65,6 +73,8 @@ function Encrypt (const Source : string) : String;
 function Decrypt (const Source : string) : String;
 function GetNextAutoinc(AConnection : IDAConnection; const GeneratorName: string): integer;
 
+procedure CheckConnection(AConnection: IDAConnection);
+
 var
   dmServer: TdmServer;
 
@@ -76,6 +86,55 @@ uses
   DateUtils, JclFileUtils, ActiveX, Forms, Registry, Windows, Dialogs,
   uSesionesUtils, uServerAppUtils;
 
+
+procedure CheckConnection(AConnection: IDAConnection);
+var
+  AIBXQuery : TIBQuery;
+  AADOQuery : TADOQuery;
+begin
+  if ((AConnection as IDAConnectionObjectAccess ).ConnectionObject is TIBXConnection) then
+  begin
+    try
+      AIBXQuery := TIBQuery.Create(NIL);
+      try
+        AIBXQuery.SQL.Add('select distinct 1 from RDB$TRANSACTIONS');
+        AIBXQuery.Database := ((AConnection as IDAConnectionObjectAccess ).ConnectionObject as TIBXConnection).Database;
+        AIBXQuery.Open;
+      finally
+        FreeANDNIL(AIBXQuery);
+      end;
+    except
+      on E:Exception do
+      begin
+        AConnection.Close;
+        AConnection.Open;
+      end;
+    end;
+  end;
+
+
+  if ((AConnection as IDAConnectionObjectAccess ).ConnectionObject is TADOConnection) then
+  begin
+    try
+      AADOQuery := TADOQuery.Create(NIL);
+      try
+        AADOQuery.SQL.Add('select count(*) From master.dbo.sysdatabases');
+        AADOQuery.Connection := ((AConnection as IDAConnectionObjectAccess ).ConnectionObject as TADOConnection);
+        AADOQuery.Open;
+      finally
+        FreeANDNIL(AADOQuery);
+      end;
+    except
+      on E:Exception do
+      begin
+        AConnection.Close;
+        AConnection.Open;
+      end;
+    end;
+  end;
+end;
+
+
 function DarRutaInformes : String;
 begin
   Result := ExtractFilePath(Application.ExeName) + 'Informes' + PathDelim;
@@ -145,6 +204,24 @@ begin
     Result := Result + chr(ord(Source[i]) - Random(10) - 1);
 end;
 
+procedure TdmServer.ConnectionManagerConnectionAcquired(
+  Sender: TDAConnectionManager; const Connection: IDAConnection);
+begin
+  EscribirLog('Conexión adquirida: ' + Connection.Name + #13#10 + #13#10);
+end;
+
+procedure TdmServer.ConnectionManagerConnectionCreated(
+  Sender: TDAConnectionManager; const Connection: IDAConnection);
+begin
+  EscribirLog('Conexión creada: ' + Connection.Name + #13#10 + #13#10);
+end;
+
+procedure TdmServer.ConnectionManagerConnectionTimedOut(
+  Sender: TDAConnectionManager);
+begin
+  EscribirLog('Error de timeout en conexión' + #13#10 + #13#10);
+end;
+
 function TdmServer.DarNuevaConexion: IDAConnection;
 begin
   with ConnectionManager do
@@ -233,8 +310,9 @@ end;
 
 procedure TdmServer.DataModuleDestroy(Sender: TObject);
 begin
-  SessionManager.ClearSessions(False);
   HTTPServer.Active := False;
+  SessionManager.ClearSessions(False);
+  ConnectionManager.ClearPool;
   DetenerLog;
 end;
 
@@ -246,7 +324,7 @@ end;
 procedure TdmServer.DriverManagerTraceEvent(Sender: TObject; const Text: string;
   Tag: Integer);
 begin
-  EscribirLog(Text + #10#13 + #10#13);
+  EscribirLog(Text + #13#10 + #13#10);
 end;
 
 procedure TdmServer.EscribirLog(const AMensaje: String);