Archivado/LuisLeon_FactuGES
Archived
0
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source 
git-svn-id: https://192.168.0.254/svn/Proyectos.LuisLeon_FactuGES/trunk@269 c93665c3-c93d-084d-9b98-7d5f4a9c3376
This commit is contained in:
David Arranz 2008-07-14 17:27:20 +00:00
parent a501958189
commit f146ff560d
3 changed files with 95 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Source/Modulos/Tienda web/Servidor/srvTiendaWeb_Impl.pas
View File

@ -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(

14
Source/Servidor/uDataModuleServer.dfm
View File

@ -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

84
Source/Servidor/uDataModuleServer.pas
View File

@ -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);