16 Commits

Author SHA1 Message Date
jaguerrau
524a9f268f - Actualizacion de archivos config.properties de prueba 2025-10-28 21:22:48 -06:00
8b876e5095 - VERSION 5.09.19
- feat(sqlite): Implementa optimización de SQLite (WAL e Índices)
- fix(manager): Extiende el comando 'test' para verificar todos los pools de conexión configurados.

- Mejoras al subsistema de logs y diagnóstico del servidor jRDC2-Multi.
- Cambios principales:
1. Optimización del Rendimiento de SQLite (users.db):
*   Habilitación de WAL: Se implementó PRAGMA journal_mode=WAL y PRAGMA synchronous=NORMAL en `InitializeSQLiteDatabase`. Esto reduce la contención de disco y mejora el rendimiento de I/O en las escrituras transaccionales de logs por lotes.
*   Índices de logs: Se agregaron índices a las columnas `timestamp` y `duration_ms` en `query_logs`, y a `timestamp` en `errores`. Esto acelera drásticamente las operaciones de limpieza periódica (`borraArribaDe15000Logs`) y la generación de reportes de consultas lentas (`slowqueries`).

2. Mejora del Comando de Diagnóstico 'test':
*   Se corrigió el comando `manager?command=test` para que no solo pruebe la conexión de `DB1`, sino que itere sobre `Main.listaDeCP` y fuerce la adquisición y liberación de una conexión (`GetConnection`) en *todos* los `RDCConnector` configurados (DB1, DB2, DB3, etc.).
*   La nueva lógica garantiza una prueba de vida rigurosa de cada pool C3P0, devolviendo un mensaje detallado del estado de conectividad y registrando un error crítico vía `LogServerError` si algún pool no responde.
2025-09-27 20:34:12 -06:00
616013f0fb - VERSION 5.09.18
- feat(manager): Implementa recarga granular (Hot-Swap).
- Actualiza manager.html para solicitar la DB Key a recargar (ej: DB2).
- Se modifica Manager.bas para leer este parámetro y ejecutar el Hot-Swap de forma atómica solo en el pool de conexión especificado, lo cual mejora la eficiencia y la disponibilidad del servicio.
2025-09-27 14:14:38 -06:00
820fe9fc2b - VERSION 5.09.17
- fix(handlers, logs): Reporte robusto de AffectedRows (simbólico) y limpieza de tabla de errores
- Aborda dos problemas críticos para la estabilidad y fiabilidad del servidor: el manejo del conteo de filas afectadas en DMLs y la gestión del crecimiento de la tabla de logs de errores.

- Cambios Principales:

1. Fix AffectedRows (ExecuteBatch V1 y DBHandlerJSON): Dada la imposibilidad de capturar el conteo de filas afectadas real (Null) de forma segura o la falla total en tiempo de ejecución (Method: ExecNonQuery2 not matched) al usar reflexión, se revierte la lógica a la llamada directa de ExecNonQuery2. Si el comando DML se ejecuta sin lanzar una excepción SQL, se reporta simbólicamente '1' fila afectada al cliente (en el Protocolo V1 y en la respuesta JSON para executecommand) para confirmar el éxito de la operación.
2. Limpieza de Tabla de Errores: Se corrigió la subrutina Main.borraArribaDe15000Logs para incluir la tabla `errores` en la limpieza periódica. Esto asegura que el log de errores no crezca indefinidamente, manteniendo solo los 15,000 registros más recientes y realizando la optimización de espacio en disco con `vacuum`.
2025-09-23 00:16:03 -06:00
884cb96f9d - VERSION 5.09.16.2
- feat(logs): Implementación de Cacheo y Escritura Transaccional en Lotes

- Implementa la funcionalidad de cacheo de logs en memoria y escritura transaccional para reducir el overhead de E/S de disco en SQLite [1, 2].

- Cambios principales:
		1. Refactorización de LogQueryPerformance y LogServerError para que solo almacenen logs en las cachés globales (QueryLogCache y ErrorLogCache) [3].
		2. Introducción de WriteQueryLogsBatch y WriteErrorLogsBatch, que vacían las cachés y realizan la inserción a SQLite dentro de una única transacción atómica (`BeginTransaction`/`TransactionSuccessful`), disparada por umbral (`LOG_CACHE_THRESHOLD`) o periódicamente por `TimerLogs_Tick` [4-7].
		3. Corrección del manejo de objetos List en las rutinas de lote (Write*LogsBatch): Se implementó la copia explícita de contenido (`List.AddAll`) dentro del bloqueo (`MainConnectorsLock`) para asegurar que el lote mantenga sus registros, resolviendo el problema de tamaño cero causado por la asignación de referencias.
2025-09-19 18:43:55 -06:00
dbfafbf9ac - VERSION 5.09.16
- feat: Implementa control de logs de SQLite granular por DBKey y corrige la concurrencia del Timer en Hot-Swap.
- Este commit introduce una mejora crucial en el rendimiento y la flexibilidad del servidor al permitir el control detallado del registro de logs en SQLite (users.db) por cada base de datos configurada (DB1, DB2, etc.).
- Cambios Principales y Beneficios:
1. Control Granular de Logs: Se reemplazó el flag de control global de logs por un mapa (SQLiteLoggingStatusByDB), permitiendo al administrador deshabilitar el costoso proceso de escritura de query_logs y errores para bases de datos específicas mediante la propiedad enableSQLiteLogs en sus archivos .properties correspondientes.
2. Estabilización del Timer y Hot-Swap:
    ◦ Se corrigió un problema de concurrencia y estado asegurando que timerLogs se inicialice incondicionalmente, resolviendo el error IllegalStateException: Interval must be larger than 0 que ocurría durante el reload.
    ◦ El Timer de limpieza (borraArribaDe15000Logs y VACUUM) ahora se activa solo si al menos una base de datos tiene el logging habilitado (IsAnySQLiteLoggingEnabled), minimizando el overhead de E/S de disco cuando los logs no se requieren.
3. Recarga Dinámica de Estado: El comando manager?command=reload ahora lee la configuración enableSQLiteLogs de todos los conectores nuevos y actualiza atómicamente el estado global de logs, aplicando los cambios sin requerir un reinicio del servidor.
2025-09-19 12:31:15 -06:00
3b352bb105 - VERSION 5.09.16
- feat: Implementa tolerancia de parámetros configurable y mejora estabilidad general del servidor.
- La tolerancia de parametros permite que si un query requiere 3 parametros y se mandan 4, NO mande un error,
	solo manda a la base de datos los parametros correctos y tira los extras, y guarda una "ADVERTENCIA" en el Log de errores.

- Este commit introduce la funcionalidad de `parameterTolerance` configurable y aborda varias mejoras críticas para la estabilidad y eficiencia del jRDC2-Multi.

- Principales cambios y beneficios:
- **Tolerancia de Parámetros**: Añade la propiedad `parameterTolerance` en `config.properties` para controlar el manejo de parámetros de más. Cuando está habilitada, recorta los parámetros excesivos; si está deshabilitada (modo estricto, por defecto), genera un error, aumentando la robustez de la validación.
- **Inicialización Multi-DB Confiable**: Corrige la lógica de inicialización en `Main.AppStart` para `RDCConnector` de DB3 y DB4, asegurando que cada base de datos tenga su propio *pool* de conexiones correctamente configurado.
- **Optimización de Ejecución SQL**: Elimina llamadas duplicadas a `ExecQuery2` y `ExecNonQuery2` en `DBHandlerB4X.bas`, garantizando que solo los parámetros validados se utilicen y evitando ejecuciones redundantes en la base de datos.
- **Refactorización y Limpieza**: Se eliminó la declaración duplicada de `ActiveRequestsCountByDB` en `Main.bas` y la subrutina `Handle0` obsoleta en `Manager.bas`, mejorando la claridad y mantenibilidad del código.
2025-09-18 22:30:32 -06:00
51c829b876 - VERSION 5.09.15
1.  **Nuevas Funcionalidades en el Panel de Administración (Manager):**
	*   Se añadió el comando `slowqueries` al `Manager` para permitir la visualización de las 20 consultas más lentas registradas en la tabla `query_logs` de SQLite [22].
	*   Se mejoró el comando `totalcon` en `Manager.bas` para mostrar estadísticas detalladas de *todos* los pools de conexión C3P0 configurados, obteniendo métricas en tiempo real (TotalConnections, BusyConnections, IdleConnections, etc.) de cada `RDCConnector` [2, 22].
	*   Beneficio: Mayor visibilidad y control proactivo sobre el rendimiento y el uso de recursos del servidor desde la interfaz de administración.

	2.  **Optimización de la Gestión de Logs (`query_logs`):**
	*   Se implementó un `Public timerLogs As Timer` en `Main.bas` [conversación], que se inicializa en `AppStart` y ejecuta periódicamente (cada 10 minutos) la subrutina `borraArribaDe15000Logs`.
	*   La subrutina `borraArribaDe15000Logs` recorta la tabla `query_logs` en `users.db` para mantener solo los 15,000 registros más recientes, y luego realiza un `vacuum` para optimizar el espacio en disco utilizado por la base de datos SQLite [conversación].
	*   Beneficio: Prevención del crecimiento excesivo de la base de datos de logs de rendimiento, manteniendo un historial manejable y optimizando el uso del almacenamiento a largo plazo.
2025-09-17 11:38:03 -06:00
2ec8f5973f - VERSION 5.09.14
-feat: Implementación robusta de monitoreo de pool de conexiones y peticiones activas

-Este commit resuelve problemas críticos en el monitoreo del pool de conexiones (C3P0) y el conteo de peticiones activas por base de datos, mejorando significativamente la visibilidad y fiabilidad del rendimiento del servidor jRDC2-Multi.

-Problemas Identificados y Resueltos:

-1.  **Métricas de `BusyConnections` y `TotalConnections` inconsistentes o siempre en `0` en el `Manager` y `query_logs`:**
		    *   **Problema**: Anteriormente, la métrica `busy_connections` en `query_logs` a menudo reportaba `0` o no reflejaba el estado real. De manera similar, el panel de `Manager?command=totalcon` consistentemente mostraba `BusyConnections: 0` y `TotalConnections` estancadas en `InitialPoolSize`, a pesar de que Oracle sí reportaba conexiones activas. Esto generaba confusión sobre el uso real y la expansión del pool.
		    *   **Solución**: Se modificó la lógica en los *handlers* (`DBHandlerJSON.bas` y `DBHandlerB4X.bas`) para capturar la métrica `BusyConnections` directamente del pool de C3P0 **inmediatamente después de que el *handler* adquiere una conexión** (`con = Connector.GetConnection(finalDbKey)`). Este valor se pasa explícitamente a la subrutina `Main.LogQueryPerformance` para su registro en `query_logs` y para ser consumido por `Manager.bas` a través de `RDCConnector.GetPoolStats`. Esto garantiza que el valor registrado y reportado refleje con precisión el número de conexiones activas en el instante de su adquisición. Pruebas exhaustivas confirmaron que C3P0 sí reporta conexiones ocupadas y sí expande `TotalConnections` hasta `MaxPoolSize` cuando la demanda lo exige.

-2.  **Contador `handler_active_requests` no decrementaba correctamente:**
		    *   **Problema**: El contador de peticiones activas por base de datos (`GlobalParameters.ActiveRequestsCountByDB`) no mostraba un decremento consistente, resultando en un conteo que solo aumentaba o mostraba valores erráticos en los logs.
		    *   **Solución**:
		        *   Se aseguró la declaración `Public ActiveRequestsCountByDB As Map` en `GlobalParameters.bas`.
		        *   Se garantizó su inicialización como un `srvr.CreateThreadSafeMap` en `Main.AppStart` para un manejo concurrente seguro de los contadores.
		        *   En `DBHandlerJSON.bas`, la `dbKey` (obtenida del parámetro `dbx` del JSON) ahora se resuelve *antes* de incrementar el contador, asegurando que el incremento y el decremento se apliquen siempre a la misma clave de base de datos correcta.
		        *   Se implementó una coerción explícita a `Int` (`.As(Int)`) para todas las operaciones de lectura y escritura (`GetDefault`, `Put`) en `GlobalParameters.ActiveRequestsCountByDB`, resolviendo problemas de tipo que causaban inconsistencias y el fallo en el decremento.
		        *   La lógica de decremento en `Private Sub CleanupAndLog` (presente en ambos *handlers*) se hizo más robusta, verificando que el contador sea mayor que cero antes de decrementar para evitar valores negativos.

-Beneficios de estos Cambios:

		*   **Monitoreo Preciso y Fiable**: Las métricas `busy_connections` y `handler_active_requests` en `query_logs` y el panel `Manager` ahora son totalmente fiables, proporcionando una visión clara y en tiempo real del uso del pool de conexiones y la carga de peticiones activas por base de datos.
		*   **Diagnóstico Mejorado**: La visibilidad interna del estado del pool de C3P0 durante las pruebas confirma que la configuración de `RDCConnector` es correcta y que el pool se expande y contrae según lo esperado por la demanda.
		*   **Robustez del Código**: La gestión de contadores de peticiones activas es ahora consistente, thread-safe y a prueba de fallos de tipo, mejorando la estabilidad general del servidor bajo carga.
2025-09-17 01:53:18 -06:00
e04cdded47 - VERSION 5.09.14
```
feat: Implement hot-swap for DB config reload and JSON POST support

**Cambios Principales:**

1. **Hot-Swap para recarga de configuraciones de DB sin reiniciar servidor**
2. **Migración a ReentrantLock para sincronización por incompatibilidad con Sync**
3. **Soporte para peticiones POST con Content-Type: application/json**
4. **Mejoras en inicialización del pool de conexiones y soporte multi-DB**

**Problemas Resueltos:**

- Falta de "Hot-Swap" en `reload`: El comando no permitía recarga dinámica de configuraciones sin reinicio
- Ausencia de mecanismo de cierre de pools en RDCConnector para liberación ordenada de conexiones
- Incompatibilidad con `Sync` en entorno B4X
- Procesamiento incorrecto de peticiones POST con Content-Type: application/json
- Inicialización incorrecta de pools C3P0 con TotalConnections: 0
- Configuración inconsistente de parámetros críticos de C3P0
- jdbcUrl truncada/vacía en logs por shadowing de variables

**Cambios Implementados:**

**Manager.bas:**
- Reemplazo completo de lógica para comando "reload"
- Creación de nuevos conectores antes de reemplazar los antiguos
- Sincronización con ReentrantLock para acceso thread-safe
- Patrón seguro de bloqueo sin `Finally` usando bandera booleana
- Cierre explícito de oldConnectors después del reemplazo
- Validación de inicialización y control de errores robusto
- Registro detallado en log HTML del proceso

**RDCConnector.bas:**
- Implementación de método `Public Sub Close()` para liberar pools C3P0
- Corrección de shadowing de variable `config` en LoadConfigMap
- Reordenamiento de Initialize
- Configuración completa de C3P0 antes de adquirir conexiones
- Forzar reportes de errores con acquireRetryAttempts y breakAfterAcquireFailure
- Activación forzada del pool con conexión temporal

**Main.bas:**
- Declaración de `MainConnectorsLock As JavaObject` (ReentrantLock)
- Inicialización del lock en AppStart
- Declaración separada de conectores (con1, con2, con3, con4)

**DBHandlerJSON.bas:**
- Detección de peticiones POST con Content-Type: application/json
- Lectura de JSON desde InputStream en lugar de parámetro URL
- Cierre explícito del InputStream para liberación de recursos
- Corrección de nombres de variables para evitar conflictos
- Mensajes de error mejorados para ambos métodos (legacy y nuevo)

**Beneficios:**
- Recarga en caliente de configuraciones DB sin interrupción de servicio
- Mayor disponibilidad y mantenibilidad del servidor
- Prevención de fugas de recursos con cierre ordenado de pools
- Compatibilidad con estándares APIs web (POST application/json)
- Inicialización robusta y confiable de pools de conexiones
- Mejor reporting de errores y diagnóstico de problemas
- Soporte multi-DB más estable y confiable
```
2025-09-15 11:44:48 -06:00
674eb2c81b - VERSION 5.09.08
- Se agregó que se puedan configurar en el config.properties los siguientes parametros:

  - setInitialPoolSize = 3
  - setMinPoolSize = 2
  - setMaxPoolSize = 5

- Se agregaron en duro a RDConnector los siguientes parametros:

  - setMaxIdleTime <-- Tiempo máximo de inactividad de la conexión.
  - setMaxConnectionAge <-- Tiempo de vida máximo de una conexión.
  - setCheckoutTimeout <-- Tiempo máximo de espera por una conexión.
2025-09-11 23:15:02 -06:00
jaguerrau
09d40879ca Update README.md 2025-09-09 09:57:19 -06:00
jaguerrau
b426c06eb2 Update README.md
Se quito la sección que mencionaba que para el orden de los parametros era necesario agregar par1, par2, etc, porque los parametros se enviaban en un mapa y ahora se envian en una lista y ya no es necesario el nombre.
2025-09-08 22:10:11 -06:00
48dbd1f034 - VERSION 5.09.08
- Se cambio el codigo para que en lugar de esperar un mapa con los parametros del query y nombres de los parametros (par1, par2, etc) paradefinir el ordenamiento, ahora se espera una lista [1,"2",3], y el orden de los parametros se toma directamente del orden en el que se mandan, de la misma forma que en B4A.
2025-09-08 22:04:22 -06:00
jaguerrau
2f9569b585 Delete RDCHandler.bas 2025-09-05 00:10:42 -06:00
9d82925dec - VERSION 5.09.04
- Se cambio el nombre del handler de B4X a DBHandlerB4X.
- Se quitaron los handlers que ya no servian.
2025-09-05 00:02:14 -06:00
36 changed files with 3690 additions and 4861 deletions

View File

@@ -1,319 +0,0 @@
B4J=true
Group=Default Group
ModulesStructureVersion=1
Type=Class
Version=4.19
@EndOfDesignText@
'Handler class
Sub Class_Globals
' #if VERSION1
Private const T_NULL = 0, T_STRING = 1, T_SHORT = 2, T_INT = 3, T_LONG = 4, T_FLOAT = 5 _
,T_DOUBLE = 6, T_BOOLEAN = 7, T_BLOB = 8 As Byte
Private bc As ByteConverter
Private cs As CompressedStreams
' #end if
Private DateTimeMethods As Map
Private Connector As RDCConnector
End Sub
Public Sub Initialize
DateTimeMethods = CreateMap(91: "getDate", 92: "getTime", 93: "getTimestamp")
End Sub
Sub Handle(req As ServletRequest, resp As ServletResponse)
Log("********************* DB1 ********************")
Dim start As Long = DateTime.Now
Dim q As String
Dim in As InputStream = req.InputStream
Dim method As String = req.GetParameter("method")
Connector = Main.Connectors.Get("DB1")
Dim con As SQL
Try
con = Connector.GetConnection("DB1")
If method = "query2" Then
q = ExecuteQuery2("DB1", con, in, resp)
'#if VERSION1
Else if method = "query" Then
in = cs.WrapInputStream(in, "gzip")
q = ExecuteQuery("DB1", con, in, resp)
Else if method = "batch" Then
in = cs.WrapInputStream(in, "gzip")
q = ExecuteBatch("DB1", con, in, resp)
'#end if
Else if method = "batch2" Then
q = ExecuteBatch2("DB1", con, in, resp)
Else
Log("Unknown method: " & method)
resp.SendError(500, "unknown method")
End If
Catch
Log(LastException)
resp.SendError(500, LastException.Message)
End Try
If con <> Null And con.IsInitialized Then con.Close
Log($"Command: ${q}, took: ${DateTime.Now - start}ms, client=${req.RemoteAddress}"$)
End Sub
Private Sub ExecuteQuery2 (DB As String, con As SQL, in As InputStream, resp As ServletResponse) As String
Dim ser As B4XSerializator
Dim m As Map = ser.ConvertBytesToObject(Bit.InputStreamToBytes(in))
Dim cmd As DBCommand = m.Get("command")
Dim limit As Int = m.Get("limit")
Dim rs As ResultSet = con.ExecQuery2(Connector.GetCommand(DB, cmd.Name), cmd.Parameters)
If limit <= 0 Then limit = 0x7fffffff 'max int
Dim jrs As JavaObject = rs
Dim rsmd As JavaObject = jrs.RunMethod("getMetaData", Null)
Dim cols As Int = rs.ColumnCount
Dim res As DBResult
res.Initialize
res.columns.Initialize
res.Tag = Null 'without this the Tag properly will not be serializable.
For i = 0 To cols - 1
res.columns.Put(rs.GetColumnName(i), i)
Next
res.Rows.Initialize
Do While rs.NextRow And limit > 0
Dim row(cols) As Object
For i = 0 To cols - 1
Dim ct As Int = rsmd.RunMethod("getColumnType", Array(i + 1))
'check whether it is a blob field
If ct = -2 Or ct = 2004 Or ct = -3 Or ct = -4 Then
row(i) = rs.GetBlob2(i)
Else If ct = 2005 Then
row(i) = rs.GetString2(i)
Else if ct = 2 Or ct = 3 Then
row(i) = rs.GetDouble2(i)
Else If DateTimeMethods.ContainsKey(ct) Then
Dim SQLTime As JavaObject = jrs.RunMethodJO(DateTimeMethods.Get(ct), Array(i + 1))
If SQLTime.IsInitialized Then
row(i) = SQLTime.RunMethod("getTime", Null)
Else
row(i) = Null
End If
Else
row(i) = jrs.RunMethod("getObject", Array(i + 1))
End If
Next
res.Rows.Add(row)
Loop
rs.Close
Dim data() As Byte = ser.ConvertObjectToBytes(res)
resp.OutputStream.WriteBytes(data, 0, data.Length)
Return "query: " & cmd.Name
End Sub
Private Sub ExecuteBatch2(DB As String, con As SQL, in As InputStream, resp As ServletResponse) As String
Dim ser As B4XSerializator
Dim m As Map = ser.ConvertBytesToObject(Bit.InputStreamToBytes(in))
Dim commands As List = m.Get("commands")
Dim res As DBResult
res.Initialize
res.columns = CreateMap("AffectedRows (N/A)": 0)
res.Rows.Initialize
res.Tag = Null
Try
con.BeginTransaction
For Each cmd As DBCommand In commands
con.ExecNonQuery2(Connector.GetCommand(DB, cmd.Name), _
cmd.Parameters)
Next
res.Rows.Add(Array As Object(0))
con.TransactionSuccessful
Catch
con.Rollback
Log(LastException)
resp.SendError(500, LastException.Message)
End Try
Dim data() As Byte = ser.ConvertObjectToBytes(res)
resp.OutputStream.WriteBytes(data, 0, data.Length)
Return $"batch (size=${commands.Size})"$
End Sub
'#if VERSION1
Private Sub ExecuteBatch(DB As String, con As SQL, in As InputStream, resp As ServletResponse) As String
Dim clientVersion As Float = ReadObject(in) 'ignore
Dim numberOfStatements As Int = ReadInt(in)
Dim res(numberOfStatements) As Int
Try
con.BeginTransaction
For i = 0 To numberOfStatements - 1
Dim queryName As String = ReadObject(in)
Dim params As List = ReadList(in)
con.ExecNonQuery2(Connector.GetCommand(DB, queryName), _
params)
Next
con.TransactionSuccessful
Dim out As OutputStream = cs.WrapOutputStream(resp.OutputStream, "gzip")
WriteObject(Main.VERSION, out)
WriteObject("batch", out)
WriteInt(res.Length, out)
For Each r As Int In res
WriteInt(r, out)
Next
out.Close
Catch
con.Rollback
Log(LastException)
resp.SendError(500, LastException.Message)
End Try
Return $"batch (size=${numberOfStatements})"$
End Sub
Private Sub ExecuteQuery(DB As String, con As SQL, in As InputStream, resp As ServletResponse) As String
' Log("==== ExecuteQuery ==== ")
Dim clientVersion As Float = ReadObject(in) 'ignore
Dim queryName As String = ReadObject(in)
Dim limit As Int = ReadInt(in)
Dim params As List = ReadList(in)
' Log("EL QUERY: |" & queryName & "|")
Private theSql As String = Connector.GetCommand(DB, queryName)
' Log(theSql)
' Log(params)
' Log(params.Size)
Dim rs As ResultSet = con.ExecQuery2(theSql, params)
If limit <= 0 Then limit = 0x7fffffff 'max int
Dim jrs As JavaObject = rs
Dim rsmd As JavaObject = jrs.RunMethod("getMetaData", Null)
Dim cols As Int = rs.ColumnCount
Dim out As OutputStream = cs.WrapOutputStream(resp.OutputStream, "gzip")
WriteObject(Main.VERSION, out)
WriteObject("query", out)
WriteInt(rs.ColumnCount, out)
' Log($"cols: ${cols}"$)
For i = 0 To cols - 1
WriteObject(rs.GetColumnName(i), out)
Next
Do While rs.NextRow And limit > 0
WriteByte(1, out)
For i = 0 To cols - 1
Dim ct As Int = rsmd.RunMethod("getColumnType", Array(i + 1))
'check whether it is a blob field
If ct = -2 Or ct = 2004 Or ct = -3 Or ct = -4 Then
WriteObject(rs.GetBlob2(i), out)
Else
WriteObject(jrs.RunMethod("getObject", Array(i + 1)), out)
End If
Next
Loop
WriteByte(0, out)
out.Close
rs.Close
Return "query: " & queryName
End Sub
Private Sub WriteByte(value As Byte, out As OutputStream)
out.WriteBytes(Array As Byte(value), 0, 1)
End Sub
Private Sub WriteObject(o As Object, out As OutputStream)
Dim data() As Byte
If o = Null Then
out.WriteBytes(Array As Byte(T_NULL), 0, 1)
Else If o Is Short Then
out.WriteBytes(Array As Byte(T_SHORT), 0, 1)
data = bc.ShortsToBytes(Array As Short(o))
Else If o Is Int Then
out.WriteBytes(Array As Byte(T_INT), 0, 1)
data = bc.IntsToBytes(Array As Int(o))
Else If o Is Float Then
out.WriteBytes(Array As Byte(T_FLOAT), 0, 1)
data = bc.FloatsToBytes(Array As Float(o))
Else If o Is Double Then
out.WriteBytes(Array As Byte(T_DOUBLE), 0, 1)
data = bc.DoublesToBytes(Array As Double(o))
Else If o Is Long Then
out.WriteBytes(Array As Byte(T_LONG), 0, 1)
data = bc.LongsToBytes(Array As Long(o))
Else If o Is Boolean Then
out.WriteBytes(Array As Byte(T_BOOLEAN), 0, 1)
Dim b As Boolean = o
Dim data(1) As Byte
If b Then data(0) = 1 Else data(0) = 0
Else If GetType(o) = "[B" Then
data = o
out.WriteBytes(Array As Byte(T_BLOB), 0, 1)
WriteInt(data.Length, out)
Else 'If o Is String Then (treat all other values as string)
out.WriteBytes(Array As Byte(T_STRING), 0, 1)
data = bc.StringToBytes(o, "UTF8")
WriteInt(data.Length, out)
End If
If data.Length > 0 Then out.WriteBytes(data, 0, data.Length)
End Sub
Private Sub ReadObject(In As InputStream) As Object
Dim data(1) As Byte
In.ReadBytes(data, 0, 1)
Select data(0)
Case T_NULL
Return Null
Case T_SHORT
Dim data(2) As Byte
Return bc.ShortsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_INT
Dim data(4) As Byte
Return bc.IntsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_LONG
Dim data(8) As Byte
Return bc.LongsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_FLOAT
Dim data(4) As Byte
Return bc.FloatsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_DOUBLE
Dim data(8) As Byte
Return bc.DoublesFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_BOOLEAN
Dim b As Byte = ReadByte(In)
Return b = 1
Case T_BLOB
Dim len As Int = ReadInt(In)
Dim data(len) As Byte
Return ReadBytesFully(In, data, data.Length)
Case Else
Dim len As Int = ReadInt(In)
Dim data(len) As Byte
ReadBytesFully(In, data, data.Length)
Return BytesToString(data, 0, data.Length, "UTF8")
End Select
End Sub
Private Sub ReadBytesFully(In As InputStream, Data() As Byte, Len As Int) As Byte()
Dim count = 0, Read As Int
Do While count < Len And Read > -1
Read = In.ReadBytes(Data, count, Len - count)
count = count + Read
Loop
Return Data
End Sub
Private Sub WriteInt(i As Int, out As OutputStream)
Dim data() As Byte
data = bc.IntsToBytes(Array As Int(i))
out.WriteBytes(data, 0, data.Length)
End Sub
Private Sub ReadInt(In As InputStream) As Int
Dim data(4) As Byte
Return bc.IntsFromBytes(ReadBytesFully(In, data, data.Length))(0)
End Sub
Private Sub ReadByte(In As InputStream) As Byte
Dim data(1) As Byte
In.ReadBytes(data, 0, 1)
Return data(0)
End Sub
Private Sub ReadList(in As InputStream) As List
Dim len As Int = ReadInt(in)
Dim l1 As List
l1.Initialize
For i = 0 To len - 1
l1.Add(ReadObject(in))
Next
Return l1
End Sub
'#end If

224
Cambios.bas Normal file
View File

@@ -0,0 +1,224 @@
B4J=true
Group=Default Group
ModulesStructureVersion=1
Type=StaticCode
Version=10.3
@EndOfDesignText@
' ########################################
' ##### HISTORIAL DE CAMBIOS #####
' ########################################
Sub Process_Globals
' - VERSION X.XX.XX (cambios a implementar)
' - Agregar que se puedan usar cualquier cantidad de archivos config.properties
' - Agregar que se pueda recargar solo un archivo de configuracion o todos a la vez.
' - Agregar una forma de probar con carga el servidor.
' - Agregar algun tipo de autenticación, posiblemente con tokens ... se podria poner
' en el config.properties un token de conexion y solo las peticiones que lo incluyan sean atendidas, o
' guardar los tokens en la BD sqlite.
' - Si se implementan los tokens, se podrian ligar los tokens con el "*" de CORS, y los tokens definirian
' los dominios permitidos.
' - Ej: token:1224abcd5678fghi, dominio:"keymon.net"
' - Ej: token:4321abcd8765fghi, dominio:"*"
' - Que en el reporte de "Queries lentos" se pueda especificar de cuanto tiempo, ahorita esta de la ultima hora, pero que se pueda seleccionar desde una
' lista, por ejemplo 15, 30, 45 y 60 minutos antes.
' - VERSION 5.09.19
' - feat(sqlite): Implementa optimización de SQLite (WAL e Índices)
' - fix(manager): Extiende el comando 'test' para verificar todos los pools de conexión configurados.
'
' - Mejoras al subsistema de logs y diagnóstico del servidor jRDC2-Multi.
'
' - Cambios principales:
'
' 1. Optimización del Rendimiento de SQLite (users.db):
' * Habilitación de WAL: Se implementó PRAGMA journal_mode=WAL y PRAGMA synchronous=NORMAL en `InitializeSQLiteDatabase`. Esto reduce la contención de disco y mejora el rendimiento de I/O en las escrituras transaccionales de logs por lotes.
' * Índices de logs: Se agregaron índices a las columnas `timestamp` y `duration_ms` en `query_logs`, y a `timestamp` en `errores`. Esto acelera drásticamente las operaciones de limpieza periódica (`borraArribaDe15000Logs`) y la generación de reportes de consultas lentas (`slowqueries`).
'
' 2. Mejora del Comando de Diagnóstico 'test':
' * Se corrigió el comando `manager?command=test` para que no solo pruebe la conexión de `DB1`, sino que itere sobre `Main.listaDeCP` y fuerce la adquisición y liberación de una conexión (`GetConnection`) en *todos* los `RDCConnector` configurados (DB1, DB2, DB3, etc.).
' * La nueva lógica garantiza una prueba de vida rigurosa de cada pool C3P0, devolviendo un mensaje detallado del estado de conectividad y registrando un error crítico vía `LogServerError` si algún pool no responde.
' - VERSION 5.09.18
' - feat(manager): Implementa recarga granular (Hot-Swap).
' - Actualiza manager.html para solicitar la DB Key a recargar (ej: DB2).
' - Se modifica Manager.bas para leer este parámetro y ejecutar el Hot-Swap de forma atómica solo en el pool de conexión especificado, lo cual mejora la eficiencia y la disponibilidad del servicio.
' - VERSION 5.09.17
' - fix(handlers, logs): Reporte robusto de AffectedRows (simbólico) y limpieza de tabla de errores
' - Aborda dos problemas críticos para la estabilidad y fiabilidad del servidor: el manejo del conteo de filas afectadas en DMLs y la gestión del crecimiento de la tabla de logs de errores.
' - Cambios Principales:
' 1. Fix AffectedRows (ExecuteBatch V1 y DBHandlerJSON): Dada la imposibilidad de capturar el conteo de filas afectadas real (Null) de forma segura o la falla total en tiempo de ejecución (Method: ExecNonQuery2 not matched) al usar reflexión, se revierte la lógica a la llamada directa de ExecNonQuery2. Si el comando DML se ejecuta sin lanzar una excepción SQL, se reporta simbólicamente '1' fila afectada al cliente (en el Protocolo V1 y en la respuesta JSON para executecommand) para confirmar el éxito de la operación.
' 2. Limpieza de Tabla de Errores: Se corrigió la subrutina Main.borraArribaDe15000Logs para incluir la tabla `errores` en la limpieza periódica. Esto asegura que el log de errores no crezca indefinidamente, manteniendo solo los 15,000 registros más recientes y realizando la optimización de espacio en disco con `vacuum`.
' - VERSION 5.09.16.2
' - feat(logs): Implementación de Cacheo y Escritura Transaccional en Lotes
'
' - Implementa la funcionalidad de cacheo de logs en memoria y escritura transaccional para reducir el overhead de E/S de disco en SQLite [1, 2].
'
' - Cambios principales:
' 1. Refactorización de LogQueryPerformance y LogServerError para que solo almacenen logs en las cachés globales (QueryLogCache y ErrorLogCache) [3].
' 2. Introducción de WriteQueryLogsBatch y WriteErrorLogsBatch, que vacían las cachés y realizan la inserción a SQLite dentro de una única transacción atómica (`BeginTransaction`/`TransactionSuccessful`), disparada por umbral (`LOG_CACHE_THRESHOLD`) o periódicamente por `TimerLogs_Tick` [4-7].
' 3. Corrección del manejo de objetos List en las rutinas de lote (Write*LogsBatch): Se implementó la copia explícita de contenido (`List.AddAll`) dentro del bloqueo (`MainConnectorsLock`) para asegurar que el lote mantenga sus registros, resolviendo el problema de tamaño cero causado por la asignación de referencias.
' - VERSION 5.09.16.1
' 1. Detalle de Comandos Batch: Se modificó DBHandlerB4X.bas (ExecuteBatch V1 y ExecuteBatch2 V2) para que, en lotes de tamaño 1, el Log retorne el nombre específico del comando (queryName) en lugar del genérico "batch (size=1)". Esto asegura que el query_logs registre la query exacta junto a su dbKey.
' 2. Timestamp Legible en SQLite: Se añade la columna timestamp_text_local a la tabla query_logs (incluyendo la lógica de migración en Main.InitializeSQLiteDatabase) y se actualiza Main.LogQueryPerformance para calcular e insertar el tiempo en formato yyyy/mm/dd HH:mm:ss.sss. Esto permite la inspección directa de la base de datos Sin necesidad de conversiones, mejorando la usabilidad para el análisis de rendimiento.
' - Versión: 5.09.16
' - feat: Implementa control de logs de SQLite granular por DBKey y corrige la concurrencia del Timer en Hot-Swap.
' - Este commit introduce una mejora crucial en el rendimiento y la flexibilidad del servidor al permitir el control detallado del registro de logs en SQLite (users.db) por cada base de datos configurada (DB1, DB2, etc.).
' - Cambios Principales y Beneficios:
' 1. Control Granular de Logs: Se reemplazó el flag de control global de logs por un mapa (SQLiteLoggingStatusByDB), permitiendo al administrador deshabilitar el costoso proceso de escritura de query_logs y errores para bases de datos específicas mediante la propiedad enableSQLiteLogs en sus archivos .properties correspondientes.
' 2. Estabilización del Timer y Hot-Swap:
' ◦ Se corrigió un problema de concurrencia y estado asegurando que timerLogs se inicialice incondicionalmente, resolviendo el error IllegalStateException: Interval must be larger than 0 que ocurría durante el reload.
' ◦ El Timer de limpieza (borraArribaDe15000Logs y VACUUM) ahora se activa solo si al menos una base de datos tiene el logging habilitado (IsAnySQLiteLoggingEnabled), minimizando el overhead de E/S de disco cuando los logs no se requieren.
' 3. Recarga Dinámica de Estado: El comando manager?command=reload ahora lee la configuración enableSQLiteLogs de todos los conectores nuevos y actualiza atómicamente el estado global de logs, aplicando los cambios Sin requerir un reinicio del servidor.
'
' - VERSION 5.09.16
' feat: Implementa tolerancia de parámetros configurable y mejora estabilidad general del servidor.
' La tolerancia de parametros permite que si un query requiere 3 parametros y se mandan 4, NO mande un error,
' solo manda a la base de datos los parametros correctos y tira los extras, y guarda una "ADVERTENCIA" en el Log de errores.
'
' Este commit introduce la funcionalidad de `parameterTolerance` configurable y aborda varias mejoras críticas para la estabilidad y eficiencia del jRDC2-Multi.
'
' Principales cambios y beneficios:
' - **Tolerancia de Parámetros**: Añade la propiedad `parameterTolerance` en `config.properties` para controlar el manejo de parámetros de más. Cuando está habilitada, recorta los parámetros excesivos; si está deshabilitada (modo estricto, por defecto), genera un error, aumentando la robustez de la validación.
' - **Inicialización Multi-DB Confiable**: Corrige la lógica de inicialización en `Main.AppStart` para `RDCConnector` de DB3 y DB4, asegurando que cada base de datos tenga su propio *pool* de conexiones correctamente configurado.
' - **Optimización de Ejecución SQL**: Elimina llamadas duplicadas a `ExecQuery2` y `ExecNonQuery2` en `DBHandlerB4X.bas`, garantizando que solo los parámetros validados se utilicen y evitando ejecuciones redundantes en la base de datos.
' - **Refactorización y Limpieza**: Se eliminó la declaración duplicada de `ActiveRequestsCountByDB` en `Main.bas` y la subrutina `Handle0` obsoleta en `Manager.bas`, mejorando la claridad y mantenibilidad del código.
'
' - VERSION 5.09.15
'
' 1. **Nuevas Funcionalidades en el Panel de Administración (Manager):**
' * Se añadió el comando `slowqueries` al `Manager` para permitir la visualización de las 20 consultas más lentas registradas en la tabla `query_logs` de SQLite [22].
' * Se mejoró el comando `totalcon` en `Manager.bas` para mostrar estadísticas detalladas de *todos* los pools de conexión C3P0 configurados, obteniendo métricas en tiempo real (TotalConnections, BusyConnections, IdleConnections, etc.) de cada `RDCConnector` [2, 22].
' * Beneficio: Mayor visibilidad y control proactivo sobre el rendimiento y el uso de recursos del servidor desde la interfaz de administración.
'
' 2. **Optimización de la Gestión de Logs (`query_logs`):**
' * Se implementó un `Public timerLogs As Timer` en `Main.bas` [conversación], que se inicializa en `AppStart` y ejecuta periódicamente (cada 10 minutos) la subrutina `borraArribaDe15000Logs`.
' * La subrutina `borraArribaDe15000Logs` recorta la tabla `query_logs` en `users.db` para mantener solo los 15,000 registros más recientes, y luego realiza un `vacuum` para optimizar el espacio en disco utilizado por la base de datos SQLite [conversación].
' * Beneficio: Prevención del crecimiento excesivo de la base de datos de logs de rendimiento, manteniendo un historial manejable y optimizando el uso del almacenamiento a largo plazo.
'
' - VERSION 5.09.14 (Ahora consolidado en 5.09.15)
' -feat: Implementación robusta de monitoreo de pool de conexiones y peticiones activas
' -Este commit resuelve problemas críticos en el monitoreo del pool de conexiones (C3P0) y el conteo de peticiones activas por base de datos, mejorando significativamente la visibilidad y fiabilidad del rendimiento del servidor jRDC2-Multi.
' -Problemas Identificados y Resueltos:
' -1. **Métricas de `BusyConnections` y `TotalConnections` inconsistentes o siempre en `0` en el `Manager` y `query_logs`:**
' * **Problema**: Anteriormente, la métrica `busy_connections` en `query_logs` a menudo reportaba `0` o no reflejaba el estado real. De manera similar, el panel de `Manager?command=totalcon` consistentemente mostraba `BusyConnections: 0` y `TotalConnections` estancadas en `InitialPoolSize`, a pesar de que Oracle sí reportaba conexiones activas. Esto generaba confusión sobre el uso real y la expansión del pool.
' * **Solución**: Se modificó la lógica en los *handlers* (`DBHandlerJSON.bas` y `DBHandlerB4X.bas`) para capturar la métrica `BusyConnections` directamente del pool de C3P0 **inmediatamente después de que el *handler* adquiere una conexión** (`con = Connector.GetConnection(finalDbKey)`). Este valor se pasa explícitamente a la subrutina `Main.LogQueryPerformance` para su registro en `query_logs` y para ser consumido por `Manager.bas` a través de `RDCConnector.GetPoolStats`. Esto garantiza que el valor registrado y reportado refleje con precisión el número de conexiones activas en el instante de su adquisición. Pruebas exhaustivas confirmaron que C3P0 sí reporta conexiones ocupadas y sí expande `TotalConnections` hasta `MaxPoolSize` cuando la demanda lo exige.
' -2. **Contador `handler_active_requests` no decrementaba correctamente:**
' * **Problema**: El contador de peticiones activas por base de datos (`GlobalParameters.ActiveRequestsCountByDB`) no mostraba un decremento consistente, resultando en un conteo que solo aumentaba o mostraba valores erráticos en los logs.
' * **Solución**:
' * Se aseguró la declaración `Public ActiveRequestsCountByDB As Map` en `GlobalParameters.bas`.
' * Se garantizó su inicialización como un `srvr.CreateThreadSafeMap` en `Main.AppStart` para un manejo concurrente seguro de los contadores.
' * En `DBHandlerJSON.bas`, la `dbKey` (obtenida del parámetro `dbx` del JSON) ahora se resuelve *antes* de incrementar el contador, asegurando que el incremento y el decremento se apliquen siempre a la misma clave de base de datos correcta.
' * Se implementó una coerción explícita a `Int` (`.As(Int)`) para todas las operaciones de lectura y escritura (`GetDefault`, `Put`) en `GlobalParameters.ActiveRequestsCountByDB`, resolviendo problemas de tipo que causaban inconsistencias y el fallo en el decremento.
' * La lógica de decremento en `Private Sub CleanupAndLog` (presente en ambos *handlers*) se hizo más robusta, verificando que el contador sea mayor que cero antes de decrementar para evitar valores negativos.
' -Beneficios de estos Cambios:
' * **Monitoreo Preciso y Fiable**: Las métricas `busy_connections` y `handler_active_requests` en `query_logs` y el panel `Manager` ahora son totalmente fiables, proporcionando una visión clara y en tiempo real del uso del pool de conexiones y la carga de peticiones activas por base de datos.
' * **Diagnóstico Mejorado**: La visibilidad interna del estado del pool de C3P0 durante las pruebas confirma que la configuración de `RDCConnector` es correcta y que el pool se expande y contrae según lo esperado por la demanda.
' * **Robustez del Código**: La gestión de contadores de peticiones activas es ahora consistente, thread-safe y a prueba de fallos de tipo, mejorando la estabilidad general del servidor bajo carga.
'
' - VERSION 5.09.13.3 (Ahora consolidado en 5.09.15)
' - Implementación de "Hot-Swap" para recarga de configuraciones de DB sin reiniciar el servidor.
' - Migración a ReentrantLock para sincronización debido a incompatibilidad con 'Sync'.
' - **Problemas Resueltos:**
' - 1. **Falta de "Hot-Swap" en `reload`:** El comando `reload` en `Manager.bas` no permitía la recarga dinámica de las configuraciones de la base de datos (config.properties) sin necesidad de reiniciar el servidor. La implementación anterior simplemente re-inicializaba las instancias existentes de `RDCConnector` in-situ, sin liberar los recursos de los pools de conexión anteriores, lo cual era ineficiente y propenso a errores.
' - 2. **Ausencia de un mecanismo de cierre de pools:** No existía un método `Close` en `RDCConnector.bas` que permitiera cerrar ordenadamente los `ConnectionPool` (C3P0) y liberar las conexiones a la base de datos, lo que era crítico para un "hot-swap" limpio .
' - 3. **Incompatibilidad con `Sync`:** La palabra clave `Sync` de B4X no era reconocida por el entorno de desarrollo del usuario, impidiendo su uso para la sincronización de hilos necesaria en el "hot-swap".
' - 4. **Ausencia de `Finally` en B4X:** La palabra clave `Finally` (común en otros lenguajes como Java para asegurar la liberación de recursos) no está disponible directamente en B4X, lo cual planteó un desafío para garantizar la liberación del `ReentrantLock` de forma segura.
' - **Cambios Implementados:**
' - **En `Main.bas`:**
' - * **Declaración de `MainConnectorsLock`:** Se añadió `Public MainConnectorsLock As JavaObject` en `Sub Process_Globals` para declarar una instancia de `java.util.concurrent.locks.ReentrantLock`, que servirá como objeto de bloqueo global para proteger el mapa `Main.Connectors`.
' - * **Inicialización de `MainConnectorsLock`:** Se inicializó `MainConnectorsLock.InitializeNewInstance("java.util.concurrent.locks.ReentrantLock", Null)` en `Sub AppStart`, asegurando que el objeto de bloqueo esté listo al inicio del servidor.
' - **En `RDCConnector.bas`:**
' - * **Método `Public Sub Close`:** Se añadió esta subrutina al final del módulo. Utiliza `JavaObject` para invocar `joPool.RunMethod("close", Null)` sobre la instancia subyacente de C3P0, permitiendo un cierre ordenado y la liberación de todas las conexiones del pool .
' - **En `Manager.bas`:**
' - * **Reemplazo completo de la lógica `If Command = "reload" Then`:**
' - * **Creación de `newConnectors`:** Se crea un mapa temporal (`Dim newConnectors As Map`) para inicializar las **nuevas instancias** de `RDCConnector` con la configuración fresca de los archivos `.properties` .
' - * **Preservación de `oldConnectors`:** Se almacena una referencia al mapa `Main.Connectors` actual en un nuevo mapa (`Dim oldConnectors As Map`) para tener acceso a los conectores antiguos que necesitan ser cerrados .
' - * **Sincronización con `ReentrantLock`:** Para proteger la manipulación del mapa `Main.Connectors` (que es compartido por múltiples hilos), se utilizan `Main.MainConnectorsLock.RunMethod("lock", Null)` y `Main.MainConnectorsLock.RunMethod("unlock", Null)`. Esto asegura que el reemplazo del mapa sea atómico, es decir, que solo un hilo pueda acceder a `Main.Connectors` durante la lectura y la escritura .
' - * **Manejo de Bloqueo Seguro sin `Finally`:** Dado que `Finally` no está disponible en B4X, se implementó un patrón con una bandera booleana (`lockAcquired`) dentro de un bloque `Try...Catch` para garantizar que `unlock()` siempre se ejecute si `lock()` fue exitoso, previniendo interbloqueos .
' - * **Cierre explícito de `oldConnectors`:** Después de que los `newConnectors` reemplazan a los `oldConnectors`, se itera sobre el mapa `oldConnectors` y se llama a `oldRDC.Close` para cada conector, liberando sus recursos de base de datos de manera limpia .
' - * **Validación de inicialización y control de errores:** Se agregó lógica para verificar el éxito de la inicialización de los nuevos conectores y abortar el "hot-swap" si ocurre un error crítico, manteniendo los conectores antiguos activos para evitar una interrupción del servicio .
' - * **Registro detallado:** Se mejoró la salida del log HTML del `Manager` para mostrar el proceso de recarga, las estadísticas de los pools recién inicializados y el cierre de los antiguos, incluyendo JSON detallado de las métricas de C3P0 .
' - • Beneficio: Estos cambios dotan al servidor jRDC2-Multi de una capacidad crítica para actualizar sus configuraciones de conexión a bases de datos en caliente, sin necesidad de reiniciar el servicio. Esto mejora la disponibilidad, simplifica el mantenimiento y previene fugas de recursos al asegurar el cierre ordenado de los pools de conexión antiguos.
'
' - VERSION 5.09.13.2 (Ahora consolidado en 5.09.15)
' - Módulo: DBHandlerJSON.bas
' - Descripción de Cambios: Manejo de Peticiones POST con Content-Type: application/json
' - • Problema Identificado: La implementación anterior de DBHandlerJSON procesaba las peticiones POST esperando que el payload JSON se encontrara en el parámetro j de la URL (req.GetParameter("j")). Esto impedía la correcta lectura de peticiones POST que utilizaban Content-Type: application/json, donde el JSON se envía directamente en el cuerpo de la petición (InputStream). Como resultado, los clientes recibían un error indicando la ausencia del parámetro j .
' - • Solución Implementada:
' - 1. Se modificó la lógica en el método Handle para detectar explícitamente las peticiones POST con Content-Type igual a application/json.
' - 2. En estos casos, el payload JSON ahora se lee directamente del InputStream de la petición (req.InputStream).
' - 3. Se utilizó Bit.InputStreamToBytes(Is0) para leer el cuerpo completo de la petición a un Array de bytes, seguido de BytesToString para convertirlo en la cadena JSON.
' - 4. Se añadió el cierre explícito del InputStream (Is0.Close) para asegurar la liberación de recursos .
' - 5. Se corrigió el nombre de la variable Is a Is0 para evitar un conflicto con la palabra reservada Is de B4X .
' - 6. Se actualizó el mensaje de error para aclarar que el JSON puede faltar tanto en el parámetro j como en el cuerpo de la petición.
' - • Beneficio: Esta corrección asegura que el DBHandlerJSON sea compatible con el "Método Recomendado" de POST con application/json, mejorando la robustez y la adherencia a los estándares de las APIs web, Sin comprometer la retrocompatibilidad con el "Método Legacy" (GET con parámetro j).
'
' - VERSION 5.09.13 (Ahora consolidado en 5.09.15)
' feat: Mejora la inicialización del pool de conexiones y el soporte multi-DB.
'
' **Problemas Resueltos:**
'
' 1. **Inicialización de `TotalConnections: 0` en todos los pools:** Anteriormente, el Log mostraba 0 conexiones inicializadas para todas las bases de datos (DB1, DB2, DB3, DB4) durante `AppStart`, a pesar de que los `handlers` de `DBHandlerB4X` y `DBHandlerJSON` podían conectarse más tarde bajo demanda. Esto indicaba un fallo silencioso en la creación de conexiones iniciales por parte de C3P0.
' 2. **Configuración inconsistente de C3P0:** Parámetros críticos de C3P0 como `acquireRetryAttempts` y `breakAfterAcquireFailure` no se aplicaban correctamente al inicio, manteniendo los valores por defecto que ocultaban errores de conexión.
' 3. **`jdbcUrl` truncado/vacío:** Se observó que la `jdbcUrl` aparecía truncada o vacía en algunos logs de C3P0, indicando un problema en la carga de la configuración.
'
' **Cambios Implementados:**
'
' **En `Main.bas`:**
'
' * **Declaración de conectores:** Se aseguró la declaración de variables `Dim conX As RDCConnector` separadas para cada conector (con1, con2, con3, con4) para evitar conflictos de variables y asegurar la inicialización correcta.
'
' **En `RDCConnector.bas`:**
'
' * **Corrección de shadowing de `config`:** Se modificó `LoadConfigMap(DB)` para asignar directamente a la variable de clase `config` (eliminando `Dim` local), resolviendo el problema de la `jdbcUrl` truncada y asegurando que cada `RDCConnector` use su configuración específica de manera persistente.
' * **Reordenamiento y robustecimiento de `Initialize`:**
' * **Carga de `config`:** Se asegura que `config` se cargue completamente en la variable de clase antes de cualquier operación del pool.
' * **Configuración de C3P0:** Todas las propiedades del pool (incluyendo `setInitialPoolSize`, `setMinPoolSize`, `setMaxPoolSize`, `setMaxIdleTime`, etc. ahora se aplican mediante `jo.RunMethod` *inmediatamente después* de `pool.Initialize` y *antes* de que el pool intente adquirir conexiones.
' * **Forzar reportes de errores:** Se añadieron las líneas `jo.RunMethod("setAcquireRetryAttempts", Array As Object(1))` y `jo.RunMethod("setBreakAfterAcquireFailure", Array As Object(True))`. Estas son cruciales para forzar a C3P0 a lanzar una `SQLException` explícita si falla al crear las conexiones iniciales, en lugar de fallar silenciosamente.
' * **Activación forzada del pool:** Se implementó `Dim tempCon As SQL = pool.GetConnection` seguido de `tempCon.Close` dentro de un bloque `Try...Catch`. Esto obliga al pool a establecer las conexiones iniciales (`InitialPoolSize`) con la configuración ya aplicada, permitiendo la captura de errores reales si la conexión falla.
'
' - VERSION 5.09.08
' - Se agregó que se puedan configurar en el config.properties los siguientes parametros:
' - - setInitialPoolSize = 3
' - - setMinPoolSize = 2
' - - setMaxPoolSize = 5
' - Se agregaron en duro a RDConnector los siguientes parametros:
' - - setMaxIdleTime <-- Tiempo máximo de inactividad de la conexión.
' - - setMaxConnectionAge <-- Tiempo de vida máximo de una conexión.
' - - setCheckoutTimeout <-- Tiempo máximo de espera por una conexión.
' - Se agregó en el config.properties, al final del "JdbcUrl" este parametro, que le indica al servidor de Oracle
' - el nombre del cliente que se está conectando "?v$session.program=jRDC_Multi"
' - VERSION 5.09.08
' - Se cambio el codigo para que en lugar de esperar un mapa con los parametros del query y nombres de los parametros (par1, par2, etc) para definir el ordenamiento, ahora se espera una lista [1,"2",3], y el orden de los parametros se toma directamente del orden en el que se mandan, de la misma forma que en B4A.
' - VERSION 5.09.04
' - Se cambio el nombre del handler de B4X a DBHandlerB4X.
' - Se quitaron los handlers que ya no servian.
' - VERSION 5.09.01
' - Se corrigieron errores en "Manager".
' - Se cambiaron nombres de handlers.
' - Se corrigio un error en la ruta de "www/login.html".
' - VERSION 5.08.31
' - Se corrigio que no avisaba cuando el query no requeria parametros y si se enviaban (en el JSONHandler)
' - VERSION 5.08.30
' - Se cambiaron los 4 handlers de B4A a uno solo que toma el DB de la ruta automáticamente.
' - Se agregaron validaciones del numero de parametros y si el query no los requiere o se dan de mas o de menos, manda un error especificando eso, ya no se reciben errores directos de la base de datos, esto fue tanto para B4A como para JSON.
' - Se modificó el Readme.md para incluir todos estos cambios.
' - VERSION 5.08.25
' - Se modificaron los archivos de reinicio de los servicios (servidor y Bow) y se cambio el menu del "manager" para que a seccion de "reload" incluya la liga a reinciar Bow.
' - VERSION 5.08.02
' - Se hizo un cambio para tratar de que las conexiones se "identifiquen" con Oracle y Jorge pueda saber que conexiones/recursos estamos ocupando
' - VERSION 4.11.14
' - Se agregó el parametro "setMaxPoolSize=5" para que solo genere 5 conexiones a la base de datos, antes generaba 15.
' - Se quitaron lineas previamente comentadas.
' - VERSION 4.11.09
' - Commit inicial on Nov 9, 2024
End Sub

View File

@@ -10,7 +10,7 @@ Sub Class_Globals
End Sub End Sub
Public Sub Initialize Public Sub Initialize
' bc.Initialize ' <<--- CORRECCIÓN 1: Descomentado para que el objeto se cree. bc.Initialize("BC")
End Sub End Sub
Public Sub Handle(req As ServletRequest, resp As ServletResponse) Public Sub Handle(req As ServletRequest, resp As ServletResponse)
@@ -32,10 +32,9 @@ Public Sub Handle(req As ServletRequest, resp As ServletResponse)
Try Try
Dim storedHash As String = Main.SQL1.ExecQuerySingleResult2("SELECT password_hash FROM users WHERE username = ?", Array As String(currentUser)) Dim storedHash As String = Main.SQL1.ExecQuerySingleResult2("SELECT password_hash FROM users WHERE username = ?", Array As String(currentUser))
Log("--- Probando con contraseña fija ---")
Log("Valor de la BD (storedHash): " & storedHash) Log("Valor de la BD (storedHash): " & storedHash)
If storedHash = Null Or bc.checkpw("12345", storedHash) = False Then ' <<--- CAMBIO CLAVE AQUÍ If storedHash = Null Or bc.checkpw(currentPass, storedHash) = False Then ' <<--- CAMBIO CLAVE AQUÍ
resp.Write("<script>alert('Error: La contraseña actual es incorrecta.'); history.back();</script>") resp.Write("<script>alert('Error: La contraseña actual es incorrecta.'); history.back();</script>")
Return Return
End If End If

320
DB1.bas
View File

@@ -1,320 +0,0 @@
B4J=true
Group=Default Group
ModulesStructureVersion=1
Type=Class
Version=10
@EndOfDesignText@
'Handler class
Sub Class_Globals
' #if VERSION1
Private const T_NULL = 0, T_STRING = 1, T_SHORT = 2, T_INT = 3, T_LONG = 4, T_FLOAT = 5 _
,T_DOUBLE = 6, T_BOOLEAN = 7, T_BLOB = 8 As Byte
Private bc As ByteConverter
Private cs As CompressedStreams
' #end if
Private DateTimeMethods As Map
End Sub
Public Sub Initialize
DateTimeMethods = CreateMap(91: "getDate", 92: "getTime", 93: "getTimestamp")
End Sub
Sub Handle(req As ServletRequest, resp As ServletResponse)
Log("***********************************************")
Dim start As Long = DateTime.Now
Dim q As String
Dim in As InputStream = req.InputStream
Dim method As String = req.GetParameter("method")
Dim con As SQL
Try
log(">>>>>> " & Main.rdcConnectorDB1.config)
con = Main.rdcConnectorDB1.GetConnection("DB1")
If method = "query2" Then
q = ExecuteQuery2(con, in, resp)
'#if VERSION1
Else if method = "query" Then
in = cs.WrapInputStream(in, "gzip")
q = ExecuteQuery(con, in, resp)
Else if method = "batch" Then
in = cs.WrapInputStream(in, "gzip")
q = ExecuteBatch(con, in, resp)
'#end if
Else if method = "batch2" Then
q = ExecuteBatch2(con, in, resp)
Else
Log("Unknown method: " & method)
resp.SendError(500, "unknown method")
End If
Catch
Log(LastException)
resp.SendError(500, LastException.Message)
End Try
If con <> Null And con.IsInitialized Then con.Close
Log($"Command: ${q}, took: ${DateTime.Now - start}ms, client=${req.RemoteAddress}"$)
End Sub
Private Sub ExecuteQuery2 (con As SQL, in As InputStream, resp As ServletResponse) As String
Dim ser As B4XSerializator
Dim m As Map = ser.ConvertBytesToObject(Bit.InputStreamToBytes(in))
Dim cmd As DBCommand = m.Get("command")
Dim limit As Int = m.Get("limit")
Dim rs As ResultSet = con.ExecQuery2(Main.rdcConnectorDB1.GetCommand(cmd.Name), cmd.Parameters)
If limit <= 0 Then limit = 0x7fffffff 'max int
Dim jrs As JavaObject = rs
Dim rsmd As JavaObject = jrs.RunMethod("getMetaData", Null)
Dim cols As Int = rs.ColumnCount
Dim res As DBResult
res.Initialize
res.columns.Initialize
res.Tag = Null 'without this the Tag properly will not be serializable.
For i = 0 To cols - 1
res.columns.Put(rs.GetColumnName(i), i)
Next
res.Rows.Initialize
Do While rs.NextRow And limit > 0
Dim row(cols) As Object
For i = 0 To cols - 1
Dim ct As Int = rsmd.RunMethod("getColumnType", Array(i + 1))
'check whether it is a blob field
If ct = -2 Or ct = 2004 Or ct = -3 Or ct = -4 Then
row(i) = rs.GetBlob2(i)
Else If ct = 2005 Then
row(i) = rs.GetString2(i)
Else if ct = 2 Or ct = 3 Then
row(i) = rs.GetDouble2(i)
Else If DateTimeMethods.ContainsKey(ct) Then
Dim SQLTime As JavaObject = jrs.RunMethodJO(DateTimeMethods.Get(ct), Array(i + 1))
If SQLTime.IsInitialized Then
row(i) = SQLTime.RunMethod("getTime", Null)
Else
row(i) = Null
End If
Else
row(i) = jrs.RunMethod("getObject", Array(i + 1))
End If
Next
res.Rows.Add(row)
Loop
rs.Close
Dim data() As Byte = ser.ConvertObjectToBytes(res)
resp.OutputStream.WriteBytes(data, 0, data.Length)
Return "query: " & cmd.Name
End Sub
Private Sub ExecuteBatch2(con As SQL, in As InputStream, resp As ServletResponse) As String
Dim ser As B4XSerializator
Dim m As Map = ser.ConvertBytesToObject(Bit.InputStreamToBytes(in))
Dim commands As List = m.Get("commands")
Dim res As DBResult
res.Initialize
res.columns = CreateMap("AffectedRows (N/A)": 0)
res.Rows.Initialize
res.Tag = Null
Try
con.BeginTransaction
For Each cmd As DBCommand In commands
con.ExecNonQuery2(Main.rdcConnectorDB1.GetCommand(cmd.Name), _
cmd.Parameters)
Next
res.Rows.Add(Array As Object(0))
con.TransactionSuccessful
Catch
con.Rollback
Log(LastException)
resp.SendError(500, LastException.Message)
End Try
Dim data() As Byte = ser.ConvertObjectToBytes(res)
resp.OutputStream.WriteBytes(data, 0, data.Length)
Return $"batch (size=${commands.Size})"$
End Sub
'#if VERSION1
Private Sub ExecuteBatch(con As SQL, in As InputStream, resp As ServletResponse) As String
Dim clientVersion As Float = ReadObject(in) 'ignore
Dim numberOfStatements As Int = ReadInt(in)
Dim res(numberOfStatements) As Int
Try
con.BeginTransaction
For i = 0 To numberOfStatements - 1
Dim queryName As String = ReadObject(in)
Dim params As List = ReadList(in)
con.ExecNonQuery2(Main.rdcConnectorDB1.GetCommand(queryName), _
params)
Next
con.TransactionSuccessful
Dim out As OutputStream = cs.WrapOutputStream(resp.OutputStream, "gzip")
WriteObject(Main.VERSION, out)
WriteObject("batch", out)
WriteInt(res.Length, out)
For Each r As Int In res
WriteInt(r, out)
Next
out.Close
Catch
con.Rollback
Log(LastException)
resp.SendError(500, LastException.Message)
End Try
Return $"batch (size=${numberOfStatements})"$
End Sub
Private Sub ExecuteQuery (con As SQL, in As InputStream, resp As ServletResponse) As String
' Log("==== ExecuteQuery ==== ")
Dim clientVersion As Float = ReadObject(in) 'ignore
Dim queryName As String = ReadObject(in)
Dim limit As Int = ReadInt(in)
Dim params As List = ReadList(in)
' Log("EL QUERY: |" & queryName & "|")
Private theSql As String = Main.rdcConnectorDB1.GetCommand(queryName)
' Log(theSql)
' Log(params)
' Log(params.Size)
Dim rs As ResultSet = con.ExecQuery2(theSql, params)
If limit <= 0 Then limit = 0x7fffffff 'max int
Dim jrs As JavaObject = rs
Dim rsmd As JavaObject = jrs.RunMethod("getMetaData", Null)
Dim cols As Int = rs.ColumnCount
Dim out As OutputStream = cs.WrapOutputStream(resp.OutputStream, "gzip")
WriteObject(Main.VERSION, out)
WriteObject("query", out)
WriteInt(rs.ColumnCount, out)
' Log($"cols: ${cols}"$)
For i = 0 To cols - 1
WriteObject(rs.GetColumnName(i), out)
Next
Do While rs.NextRow And limit > 0
WriteByte(1, out)
For i = 0 To cols - 1
Dim ct As Int = rsmd.RunMethod("getColumnType", Array(i + 1))
'check whether it is a blob field
If ct = -2 Or ct = 2004 Or ct = -3 Or ct = -4 Then
WriteObject(rs.GetBlob2(i), out)
Else
WriteObject(jrs.RunMethod("getObject", Array(i + 1)), out)
End If
Next
Loop
WriteByte(0, out)
out.Close
rs.Close
Return "query: " & queryName
End Sub
Private Sub WriteByte(value As Byte, out As OutputStream)
out.WriteBytes(Array As Byte(value), 0, 1)
End Sub
Private Sub WriteObject(o As Object, out As OutputStream)
Dim data() As Byte
If o = Null Then
out.WriteBytes(Array As Byte(T_NULL), 0, 1)
Else If o Is Short Then
out.WriteBytes(Array As Byte(T_SHORT), 0, 1)
data = bc.ShortsToBytes(Array As Short(o))
Else If o Is Int Then
out.WriteBytes(Array As Byte(T_INT), 0, 1)
data = bc.IntsToBytes(Array As Int(o))
Else If o Is Float Then
out.WriteBytes(Array As Byte(T_FLOAT), 0, 1)
data = bc.FloatsToBytes(Array As Float(o))
Else If o Is Double Then
out.WriteBytes(Array As Byte(T_DOUBLE), 0, 1)
data = bc.DoublesToBytes(Array As Double(o))
Else If o Is Long Then
out.WriteBytes(Array As Byte(T_LONG), 0, 1)
data = bc.LongsToBytes(Array As Long(o))
Else If o Is Boolean Then
out.WriteBytes(Array As Byte(T_BOOLEAN), 0, 1)
Dim b As Boolean = o
Dim data(1) As Byte
If b Then data(0) = 1 Else data(0) = 0
Else If GetType(o) = "[B" Then
data = o
out.WriteBytes(Array As Byte(T_BLOB), 0, 1)
WriteInt(data.Length, out)
Else 'If o Is String Then (treat all other values as string)
out.WriteBytes(Array As Byte(T_STRING), 0, 1)
data = bc.StringToBytes(o, "UTF8")
WriteInt(data.Length, out)
End If
If data.Length > 0 Then out.WriteBytes(data, 0, data.Length)
End Sub
Private Sub ReadObject(In As InputStream) As Object
Dim data(1) As Byte
In.ReadBytes(data, 0, 1)
Select data(0)
Case T_NULL
Return Null
Case T_SHORT
Dim data(2) As Byte
Return bc.ShortsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_INT
Dim data(4) As Byte
Return bc.IntsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_LONG
Dim data(8) As Byte
Return bc.LongsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_FLOAT
Dim data(4) As Byte
Return bc.FloatsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_DOUBLE
Dim data(8) As Byte
Return bc.DoublesFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_BOOLEAN
Dim b As Byte = ReadByte(In)
Return b = 1
Case T_BLOB
Dim len As Int = ReadInt(In)
Dim data(len) As Byte
Return ReadBytesFully(In, data, data.Length)
Case Else
Dim len As Int = ReadInt(In)
Dim data(len) As Byte
ReadBytesFully(In, data, data.Length)
Return BytesToString(data, 0, data.Length, "UTF8")
End Select
End Sub
Private Sub ReadBytesFully(In As InputStream, Data() As Byte, Len As Int) As Byte()
Dim count = 0, Read As Int
Do While count < Len And Read > -1
Read = In.ReadBytes(Data, count, Len - count)
count = count + Read
Loop
Return Data
End Sub
Private Sub WriteInt(i As Int, out As OutputStream)
Dim data() As Byte
data = bc.IntsToBytes(Array As Int(i))
out.WriteBytes(data, 0, data.Length)
End Sub
Private Sub ReadInt(In As InputStream) As Int
Dim data(4) As Byte
Return bc.IntsFromBytes(ReadBytesFully(In, data, data.Length))(0)
End Sub
Private Sub ReadByte(In As InputStream) As Byte
Dim data(1) As Byte
In.ReadBytes(data, 0, 1)
Return data(0)
End Sub
Private Sub ReadList(in As InputStream) As List
Dim len As Int = ReadInt(in)
Dim l1 As List
l1.Initialize
For i = 0 To len - 1
l1.Add(ReadObject(in))
Next
Return l1
End Sub
'#end If

View File

@@ -1,319 +0,0 @@
B4J=true
Group=Default Group
ModulesStructureVersion=1
Type=Class
Version=4.19
@EndOfDesignText@
'Handler class
Sub Class_Globals
' #if VERSION1
Private const T_NULL = 0, T_STRING = 1, T_SHORT = 2, T_INT = 3, T_LONG = 4, T_FLOAT = 5 _
,T_DOUBLE = 6, T_BOOLEAN = 7, T_BLOB = 8 As Byte
Private bc As ByteConverter
Private cs As CompressedStreams
' #end if
Private DateTimeMethods As Map
Private Connector As RDCConnector
End Sub
Public Sub Initialize
DateTimeMethods = CreateMap(91: "getDate", 92: "getTime", 93: "getTimestamp")
End Sub
Sub Handle(req As ServletRequest, resp As ServletResponse)
Log("********************* DB1 ********************")
Dim start As Long = DateTime.Now
Dim q As String
Dim in As InputStream = req.InputStream
Dim method As String = req.GetParameter("method")
Connector = Main.Connectors.Get("DB1")
Dim con As SQL
Try
con = Connector.GetConnection("DB1")
If method = "query2" Then
q = ExecuteQuery2("DB1", con, in, resp)
'#if VERSION1
Else if method = "query" Then
in = cs.WrapInputStream(in, "gzip")
q = ExecuteQuery("DB1", con, in, resp)
Else if method = "batch" Then
in = cs.WrapInputStream(in, "gzip")
q = ExecuteBatch("DB1", con, in, resp)
'#end if
Else if method = "batch2" Then
q = ExecuteBatch2("DB1", con, in, resp)
Else
Log("Unknown method: " & method)
resp.SendError(500, "unknown method")
End If
Catch
Log(LastException)
resp.SendError(500, LastException.Message)
End Try
If con <> Null And con.IsInitialized Then con.Close
Log($"Command: ${q}, took: ${DateTime.Now - start}ms, client=${req.RemoteAddress}"$)
End Sub
Private Sub ExecuteQuery2 (DB As String, con As SQL, in As InputStream, resp As ServletResponse) As String
Dim ser As B4XSerializator
Dim m As Map = ser.ConvertBytesToObject(Bit.InputStreamToBytes(in))
Dim cmd As DBCommand = m.Get("command")
Dim limit As Int = m.Get("limit")
Dim rs As ResultSet = con.ExecQuery2(Connector.GetCommand(DB, cmd.Name), cmd.Parameters)
If limit <= 0 Then limit = 0x7fffffff 'max int
Dim jrs As JavaObject = rs
Dim rsmd As JavaObject = jrs.RunMethod("getMetaData", Null)
Dim cols As Int = rs.ColumnCount
Dim res As DBResult
res.Initialize
res.columns.Initialize
res.Tag = Null 'without this the Tag properly will not be serializable.
For i = 0 To cols - 1
res.columns.Put(rs.GetColumnName(i), i)
Next
res.Rows.Initialize
Do While rs.NextRow And limit > 0
Dim row(cols) As Object
For i = 0 To cols - 1
Dim ct As Int = rsmd.RunMethod("getColumnType", Array(i + 1))
'check whether it is a blob field
If ct = -2 Or ct = 2004 Or ct = -3 Or ct = -4 Then
row(i) = rs.GetBlob2(i)
Else If ct = 2005 Then
row(i) = rs.GetString2(i)
Else if ct = 2 Or ct = 3 Then
row(i) = rs.GetDouble2(i)
Else If DateTimeMethods.ContainsKey(ct) Then
Dim SQLTime As JavaObject = jrs.RunMethodJO(DateTimeMethods.Get(ct), Array(i + 1))
If SQLTime.IsInitialized Then
row(i) = SQLTime.RunMethod("getTime", Null)
Else
row(i) = Null
End If
Else
row(i) = jrs.RunMethod("getObject", Array(i + 1))
End If
Next
res.Rows.Add(row)
Loop
rs.Close
Dim data() As Byte = ser.ConvertObjectToBytes(res)
resp.OutputStream.WriteBytes(data, 0, data.Length)
Return "query: " & cmd.Name
End Sub
Private Sub ExecuteBatch2(DB As String, con As SQL, in As InputStream, resp As ServletResponse) As String
Dim ser As B4XSerializator
Dim m As Map = ser.ConvertBytesToObject(Bit.InputStreamToBytes(in))
Dim commands As List = m.Get("commands")
Dim res As DBResult
res.Initialize
res.columns = CreateMap("AffectedRows (N/A)": 0)
res.Rows.Initialize
res.Tag = Null
Try
con.BeginTransaction
For Each cmd As DBCommand In commands
con.ExecNonQuery2(Connector.GetCommand(DB, cmd.Name), _
cmd.Parameters)
Next
res.Rows.Add(Array As Object(0))
con.TransactionSuccessful
Catch
con.Rollback
Log(LastException)
resp.SendError(500, LastException.Message)
End Try
Dim data() As Byte = ser.ConvertObjectToBytes(res)
resp.OutputStream.WriteBytes(data, 0, data.Length)
Return $"batch (size=${commands.Size})"$
End Sub
'#if VERSION1
Private Sub ExecuteBatch(DB As String, con As SQL, in As InputStream, resp As ServletResponse) As String
Dim clientVersion As Float = ReadObject(in) 'ignore
Dim numberOfStatements As Int = ReadInt(in)
Dim res(numberOfStatements) As Int
Try
con.BeginTransaction
For i = 0 To numberOfStatements - 1
Dim queryName As String = ReadObject(in)
Dim params As List = ReadList(in)
con.ExecNonQuery2(Connector.GetCommand(DB, queryName), _
params)
Next
con.TransactionSuccessful
Dim out As OutputStream = cs.WrapOutputStream(resp.OutputStream, "gzip")
WriteObject(Main.VERSION, out)
WriteObject("batch", out)
WriteInt(res.Length, out)
For Each r As Int In res
WriteInt(r, out)
Next
out.Close
Catch
con.Rollback
Log(LastException)
resp.SendError(500, LastException.Message)
End Try
Return $"batch (size=${numberOfStatements})"$
End Sub
Private Sub ExecuteQuery(DB As String, con As SQL, in As InputStream, resp As ServletResponse) As String
' Log("==== ExecuteQuery ==== ")
Dim clientVersion As Float = ReadObject(in) 'ignore
Dim queryName As String = ReadObject(in)
Dim limit As Int = ReadInt(in)
Dim params As List = ReadList(in)
' Log("EL QUERY: |" & queryName & "|")
Private theSql As String = Connector.GetCommand(DB, queryName)
' Log(theSql)
' Log(params)
' Log(params.Size)
Dim rs As ResultSet = con.ExecQuery2(theSql, params)
If limit <= 0 Then limit = 0x7fffffff 'max int
Dim jrs As JavaObject = rs
Dim rsmd As JavaObject = jrs.RunMethod("getMetaData", Null)
Dim cols As Int = rs.ColumnCount
Dim out As OutputStream = cs.WrapOutputStream(resp.OutputStream, "gzip")
WriteObject(Main.VERSION, out)
WriteObject("query", out)
WriteInt(rs.ColumnCount, out)
' Log($"cols: ${cols}"$)
For i = 0 To cols - 1
WriteObject(rs.GetColumnName(i), out)
Next
Do While rs.NextRow And limit > 0
WriteByte(1, out)
For i = 0 To cols - 1
Dim ct As Int = rsmd.RunMethod("getColumnType", Array(i + 1))
'check whether it is a blob field
If ct = -2 Or ct = 2004 Or ct = -3 Or ct = -4 Then
WriteObject(rs.GetBlob2(i), out)
Else
WriteObject(jrs.RunMethod("getObject", Array(i + 1)), out)
End If
Next
Loop
WriteByte(0, out)
out.Close
rs.Close
Return "query: " & queryName
End Sub
Private Sub WriteByte(value As Byte, out As OutputStream)
out.WriteBytes(Array As Byte(value), 0, 1)
End Sub
Private Sub WriteObject(o As Object, out As OutputStream)
Dim data() As Byte
If o = Null Then
out.WriteBytes(Array As Byte(T_NULL), 0, 1)
Else If o Is Short Then
out.WriteBytes(Array As Byte(T_SHORT), 0, 1)
data = bc.ShortsToBytes(Array As Short(o))
Else If o Is Int Then
out.WriteBytes(Array As Byte(T_INT), 0, 1)
data = bc.IntsToBytes(Array As Int(o))
Else If o Is Float Then
out.WriteBytes(Array As Byte(T_FLOAT), 0, 1)
data = bc.FloatsToBytes(Array As Float(o))
Else If o Is Double Then
out.WriteBytes(Array As Byte(T_DOUBLE), 0, 1)
data = bc.DoublesToBytes(Array As Double(o))
Else If o Is Long Then
out.WriteBytes(Array As Byte(T_LONG), 0, 1)
data = bc.LongsToBytes(Array As Long(o))
Else If o Is Boolean Then
out.WriteBytes(Array As Byte(T_BOOLEAN), 0, 1)
Dim b As Boolean = o
Dim data(1) As Byte
If b Then data(0) = 1 Else data(0) = 0
Else If GetType(o) = "[B" Then
data = o
out.WriteBytes(Array As Byte(T_BLOB), 0, 1)
WriteInt(data.Length, out)
Else 'If o Is String Then (treat all other values as string)
out.WriteBytes(Array As Byte(T_STRING), 0, 1)
data = bc.StringToBytes(o, "UTF8")
WriteInt(data.Length, out)
End If
If data.Length > 0 Then out.WriteBytes(data, 0, data.Length)
End Sub
Private Sub ReadObject(In As InputStream) As Object
Dim data(1) As Byte
In.ReadBytes(data, 0, 1)
Select data(0)
Case T_NULL
Return Null
Case T_SHORT
Dim data(2) As Byte
Return bc.ShortsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_INT
Dim data(4) As Byte
Return bc.IntsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_LONG
Dim data(8) As Byte
Return bc.LongsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_FLOAT
Dim data(4) As Byte
Return bc.FloatsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_DOUBLE
Dim data(8) As Byte
Return bc.DoublesFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_BOOLEAN
Dim b As Byte = ReadByte(In)
Return b = 1
Case T_BLOB
Dim len As Int = ReadInt(In)
Dim data(len) As Byte
Return ReadBytesFully(In, data, data.Length)
Case Else
Dim len As Int = ReadInt(In)
Dim data(len) As Byte
ReadBytesFully(In, data, data.Length)
Return BytesToString(data, 0, data.Length, "UTF8")
End Select
End Sub
Private Sub ReadBytesFully(In As InputStream, Data() As Byte, Len As Int) As Byte()
Dim count = 0, Read As Int
Do While count < Len And Read > -1
Read = In.ReadBytes(Data, count, Len - count)
count = count + Read
Loop
Return Data
End Sub
Private Sub WriteInt(i As Int, out As OutputStream)
Dim data() As Byte
data = bc.IntsToBytes(Array As Int(i))
out.WriteBytes(data, 0, data.Length)
End Sub
Private Sub ReadInt(In As InputStream) As Int
Dim data(4) As Byte
Return bc.IntsFromBytes(ReadBytesFully(In, data, data.Length))(0)
End Sub
Private Sub ReadByte(In As InputStream) As Byte
Dim data(1) As Byte
In.ReadBytes(data, 0, 1)
Return data(0)
End Sub
Private Sub ReadList(in As InputStream) As List
Dim len As Int = ReadInt(in)
Dim l1 As List
l1.Initialize
For i = 0 To len - 1
l1.Add(ReadObject(in))
Next
Return l1
End Sub
'#end If

View File

@@ -1,266 +0,0 @@
B4J=true
Group=Default Group
ModulesStructureVersion=1
Type=Class
Version=10.3
@EndOfDesignText@
' Handler class for JSON requests from Web Clients (JavaScript/axios)
' VERSIÓN 16 (Comentarios y Mensajes en Español):
' - Se añaden comentarios detallados a la versión con mensajes de error en español.
' - Revisa que el 'query' exista en config.properties antes de continuar.
' - Asegura que la conexión a la BD se cierre en todos los 'Return' para evitar fugas.
Sub Class_Globals
' Declara una variable privada para mantener una instancia del conector RDC.
' Este objeto maneja la comunicación con la base de datos.
Private Connector As RDCConnector
End Sub
' Subrutina de inicialización de la clase. Se llama cuando se crea un objeto de esta clase.
' En este caso, no se necesita ninguna inicialización específica.
Public Sub Initialize
End Sub
' Este es el método principal que maneja las peticiones HTTP entrantes (req) y prepara la respuesta (resp).
Sub Handle(req As ServletRequest, resp As ServletResponse)
Log("============== DB1JsonHandler ==============")
' --- Headers CORS (Cross-Origin Resource Sharing) ---
' Estos encabezados son necesarios para permitir que un cliente web (ej. una página con JavaScript)
' que se encuentra en un dominio diferente pueda hacer peticiones a este servidor.
resp.SetHeader("Access-Control-Allow-Origin", "*") ' Permite peticiones desde cualquier origen.
resp.SetHeader("Access-Control-Allow-Methods", "GET, POST, OPTIONS") ' Métodos HTTP permitidos.
resp.SetHeader("Access-Control-Allow-Headers", "Content-Type") ' Encabezados permitidos en la petición.
' El método OPTIONS es una "petición de comprobación previa" (preflight request) que envían los navegadores
' para verificar los permisos CORS antes de enviar la petición real (ej. POST).
' Si es una petición OPTIONS, simplemente terminamos la ejecución sin procesar nada más.
If req.Method = "OPTIONS" Then Return
' Establece "DB1" como el nombre de la base de datos por defecto.
Dim DB As String = "DB1"
' Obtiene el objeto conector para la base de datos por defecto desde el objeto Main.
Connector = Main.Connectors.Get(DB)
' Declara una variable para la conexión SQL.
Dim con As SQL
' Inicia un bloque Try...Catch para manejar posibles errores durante la ejecución.
Try
' Obtiene el valor del parámetro 'j' de la petición. Se espera que contenga una cadena JSON.
Dim jsonString As String = req.GetParameter("j")
' Verifica si el parámetro 'j' es nulo o está vacío.
If jsonString = Null Or jsonString = "" Then
' Si falta el parámetro, envía una respuesta de error 400 (Bad Request) y termina la ejecución.
SendErrorResponse(resp, 400, "Falta el parametro 'j' en el URL")
Return
End If
' Crea un objeto JSONParser para analizar la cadena JSON.
Dim parser As JSONParser
parser.Initialize(jsonString)
' Convierte la cadena JSON en un objeto Map, que es como un diccionario (clave-valor).
Dim RootMap As Map = parser.NextObject
' Extrae los datos necesarios del JSON.
Dim execType As String = RootMap.GetDefault("exec", "") ' Tipo de ejecución: "executeQuery" o "executeCommand".
Dim queryName As String = RootMap.Get("query") ' Nombre del comando SQL (definido en config.properties).
Dim paramsMap As Map = RootMap.Get("params") ' Un mapa con los parámetros para la consulta.
' Log(RootMap)
' Verifica si en el JSON se especificó un nombre de base de datos diferente con la clave "dbx".
If RootMap.Get("dbx") <> Null Then DB = RootMap.Get("dbx") ' Si se especifica, usamos la BD indicada, si no, se queda "DB1".
' Valida que el nombre de la base de datos (DB) exista en la lista de conexiones configuradas en Main.
If Main.listaDeCP.IndexOf(DB) = -1 Then
SendErrorResponse(resp, 400, "Parametro 'DB' invalido. El nombre '" & DB & "' no es válido.")
' Se añade Return para detener la ejecución si la BD no es válida.
Return
End If
' Prepara una lista para almacenar las claves de los parámetros.
Dim paramKeys As List
paramKeys.Initialize
' Si el mapa de parámetros existe y está inicializado...
If paramsMap <> Null And paramsMap.IsInitialized Then
' ...itera sobre todas las claves y las añade a la lista 'paramKeys'.
For Each key As String In paramsMap.Keys
paramKeys.Add(key)
Next
End If
' Ordena las claves alfabéticamente. Esto es crucial para asegurar que los parámetros
' se pasen a la consulta SQL en un orden consistente y predecible.
paramKeys.Sort(True)
' Prepara una lista para almacenar los valores de los parámetros en el orden correcto.
Dim orderedParams As List
orderedParams.Initialize
' Itera sobre la lista de claves ya ordenada.
For Each key As String In paramKeys
' Añade el valor correspondiente a cada clave a la lista 'orderedParams'.
orderedParams.Add(paramsMap.Get(key))
Next
' Obtiene una conexión a la base de datos del pool de conexiones.
con = Connector.GetConnection(DB)
' Obtiene la cadena SQL del archivo de configuración usando el nombre de la consulta (queryName).
Dim sqlCommand As String = Connector.GetCommand(DB, queryName)
' <<< INICIO NUEVA VALIDACIÓN: VERIFICAR SI EL COMANDO EXISTE >>>
' Comprueba si el comando SQL (query) especificado en el JSON fue encontrado en el archivo de configuración.
If sqlCommand = Null Or sqlCommand = "null" Or sqlCommand.Trim = "" Then
' Si no se encontró el comando, crea un mensaje de error claro.
Dim errorMessage As String = $"El comando '${queryName}' no fue encontrado en el config.properties de '${DB}'."$
' Registra el error en el log del servidor para depuración.
Log(errorMessage)
' Envía una respuesta de error 400 (Bad Request) al cliente en formato JSON.
SendErrorResponse(resp, 400, errorMessage)
' Cierra la conexión a la base de datos antes de salir para evitar fugas de conexión.
If con <> Null And con.IsInitialized Then con.Close
' Detiene la ejecución del método Handle para esta petición.
Return
End If
' <<< FIN NUEVA VALIDACIÓN >>>
' Comprueba el tipo de ejecución solicitado ("executeQuery" o "executeCommand").
If execType.ToLowerCase = "executequery" Then
' Declara una variable para almacenar el resultado de la consulta.
Dim rs As ResultSet
' Si el comando SQL contiene placeholders ('?'), significa que espera parámetros.
If sqlCommand.Contains("?") or orderedParams.Size > 0 Then
' =================================================================
' === VALIDACIÓN DE CONTEO DE PARÁMETROS ==========================
' =================================================================
' Calcula cuántos parámetros espera la consulta contando el número de '?'.
Dim expectedParams As Int = sqlCommand.Length - sqlCommand.Replace("?", "").Length
' Obtiene cuántos parámetros se recibieron.
Dim receivedParams As Int = orderedParams.Size
' Compara si la cantidad de parámetros esperados y recibidos es diferente.
Log($"expectedParams: ${expectedParams}, receivedParams: ${receivedParams}"$)
If expectedParams <> receivedParams Then
' Si no coinciden, envía un error 400 detallado.
SendErrorResponse(resp, 400, $"Número de parametros equivocado para '${queryName}'. Se esperaban ${expectedParams} y se recibieron ${receivedParams}."$)
' Cierra la conexión antes de salir para evitar fugas.
If con <> Null And con.IsInitialized Then con.Close
' Detiene la ejecución para evitar un error en la base de datos.
Return
End If
' =================================================================
' Ejecuta la consulta pasando el comando SQL y la lista ordenada de parámetros.
rs = con.ExecQuery2(sqlCommand, orderedParams)
Else
' Si no hay '?', ejecuta la consulta directamente sin parámetros.
rs = con.ExecQuery(sqlCommand)
End If
' --- Procesamiento de resultados ---
' Prepara una lista para almacenar todas las filas del resultado.
Dim ResultList As List
ResultList.Initialize
' Usa un objeto JavaObject para acceder a los metadatos del resultado (info de columnas).
Dim jrs As JavaObject = rs
Dim rsmd As JavaObject = jrs.RunMethod("getMetaData", Null)
' Obtiene el número de columnas en el resultado.
Dim cols As Int = rsmd.RunMethod("getColumnCount", Null)
' Itera sobre cada fila del resultado (ResultSet).
Do While rs.NextRow
' Crea un mapa para almacenar los datos de la fila actual (columna -> valor).
Dim RowMap As Map
RowMap.Initialize
' Itera sobre cada columna de la fila.
For i = 1 To cols
' Obtiene el nombre de la columna.
Dim ColumnName As String = rsmd.RunMethod("getColumnName", Array(i))
' Obtiene el valor de la columna.
Dim value As Object = jrs.RunMethod("getObject", Array(i))
' Añade la pareja (nombre_columna, valor) al mapa de la fila.
RowMap.Put(ColumnName, value)
Next
' Añade el mapa de la fila a la lista de resultados.
ResultList.Add(RowMap)
Loop
' Cierra el ResultSet para liberar recursos de la base de datos.
rs.Close
' Envía una respuesta de éxito con la lista de resultados en formato JSON.
SendSuccessResponse(resp, CreateMap("result": ResultList))
Else If execType.ToLowerCase = "executecommand" Then
' Si es un comando (INSERT, UPDATE, DELETE), también valida los parámetros.
If sqlCommand.Contains("?") Then
' =================================================================
' === VALIDACIÓN DE CONTEO DE PARÁMETROS (para Comandos) ==========
' =================================================================
Dim expectedParams As Int = sqlCommand.Length - sqlCommand.Replace("?", "").Length
Dim receivedParams As Int = orderedParams.Size
If expectedParams <> receivedParams Then
SendErrorResponse(resp, 400, $"Número de parametros equivocado para '${queryName}'. Se esperaban ${expectedParams} y se recibieron ${receivedParams}."$)
' Cierra la conexión antes de salir.
If con <> Null And con.IsInitialized Then con.Close
' Detiene la ejecución.
Return
End If
' =================================================================
End If
' Ejecuta el comando que no devuelve resultados (NonQuery) con sus parámetros.
con.ExecNonQuery2(sqlCommand, orderedParams)
' Envía una respuesta de éxito con un mensaje de confirmación.
SendSuccessResponse(resp, CreateMap("message": "Command executed successfully"))
Else
' Si el valor de 'exec' no es ni "executeQuery" ni "executeCommand", envía un error.
SendErrorResponse(resp, 400, "Parametro 'exec' inválido. '" & execType & "' no es un valor permitido.")
End If
Catch
' Si ocurre cualquier error inesperado en el bloque Try...
' Registra la excepción completa en el log del servidor para diagnóstico.
Log(LastException)
' Envía una respuesta de error 500 (Internal Server Error) con el mensaje de la excepción.
SendErrorResponse(resp, 500, LastException.Message)
End Try
' Este bloque se ejecuta siempre al final, haya habido error o no, *excepto si se usó Return antes*.
' Comprueba si el objeto de conexión fue inicializado y sigue abierto.
If con <> Null And con.IsInitialized Then
' Cierra la conexión para devolverla al pool y que pueda ser reutilizada.
' Esto es fundamental para no agotar las conexiones a la base de datos.
con.Close
End If
End Sub
' --- Subrutinas de ayuda para respuestas JSON ---
' Construye y envía una respuesta JSON de éxito.
Private Sub SendSuccessResponse(resp As ServletResponse, dataMap As Map)
' Añade el campo "success": true al mapa de datos para indicar que todo salió bien.
dataMap.Put("success", True)
' Crea un generador de JSON.
Dim jsonGenerator As JSONGenerator
jsonGenerator.Initialize(dataMap)
' Establece el tipo de contenido de la respuesta a "application/json".
resp.ContentType = "application/json"
' Escribe la cadena JSON generada en el cuerpo de la respuesta HTTP.
resp.Write(jsonGenerator.ToString)
End Sub
' Construye y envía una respuesta JSON de error.
Private Sub SendErrorResponse(resp As ServletResponse, statusCode As Int, errorMessage As String)
' Personaliza el mensaje de error si es un error común de parámetros de Oracle o JDBC.
If errorMessage.Contains("Índice de columnas no válido") Or errorMessage.Contains("ORA-17003") Then errorMessage = "NUMERO DE PARAMETROS EQUIVOCADO: " & errorMessage
' Crea un mapa con el estado de error y el mensaje.
Dim resMap As Map = CreateMap("success": False, "error": errorMessage)
' Genera la cadena JSON a partir del mapa.
Dim jsonGenerator As JSONGenerator
jsonGenerator.Initialize(resMap)
' Establece el código de estado HTTP (ej. 400 para error del cliente, 500 para error del servidor).
resp.Status = statusCode
' Establece el tipo de contenido y escribe la respuesta de error.
resp.ContentType = "application/json"
resp.Write(jsonGenerator.ToString)
End Sub

View File

@@ -1,320 +0,0 @@
B4J=true
Group=Default Group
ModulesStructureVersion=1
Type=Class
Version=10
@EndOfDesignText@
'Handler class
Sub Class_Globals
' #if VERSION1
Private const T_NULL = 0, T_STRING = 1, T_SHORT = 2, T_INT = 3, T_LONG = 4, T_FLOAT = 5 _
,T_DOUBLE = 6, T_BOOLEAN = 7, T_BLOB = 8 As Byte
Private bc As ByteConverter
Private cs As CompressedStreams
' #end if
Private DateTimeMethods As Map
Private Connector As RDCConnector
End Sub
Public Sub Initialize
DateTimeMethods = CreateMap(91: "getDate", 92: "getTime", 93: "getTimestamp")
End Sub
Sub Handle(req As ServletRequest, resp As ServletResponse)
Log("********************* DB2 ********************")
Dim start As Long = DateTime.Now
Dim q As String
Dim in As InputStream = req.InputStream
Dim method As String = req.GetParameter("method")
Connector = Main.Connectors.Get("DB2")
Dim con As SQL
Try
con = Connector.GetConnection("DB2")
If method = "query2" Then
q = ExecuteQuery2("DB2", con, in, resp)
'#if VERSION1
Else if method = "query" Then
in = cs.WrapInputStream(in, "gzip")
q = ExecuteQuery("DB2", con, in, resp)
Else if method = "batch" Then
in = cs.WrapInputStream(in, "gzip")
q = ExecuteBatch("DB2", con, in, resp)
'#end if
Else if method = "batch2" Then
q = ExecuteBatch2("DB2", con, in, resp)
Else
Log("Unknown method: " & method)
resp.SendError(500, "unknown method")
End If
Catch
Log(LastException)
resp.SendError(500, LastException.Message)
End Try
If con <> Null And con.IsInitialized Then con.Close
Log($"Command: ${q}, took: ${DateTime.Now - start}ms, client=${req.RemoteAddress}"$)
End Sub
Private Sub ExecuteQuery2 (DB As String, con As SQL, in As InputStream, resp As ServletResponse) As String
Log("==== ExecuteQuery2 ==== ")
Dim ser As B4XSerializator
Dim m As Map = ser.ConvertBytesToObject(Bit.InputStreamToBytes(in))
Dim cmd As DBCommand = m.Get("command")
Dim limit As Int = m.Get("limit")
Dim rs As ResultSet = con.ExecQuery2(Connector.GetCommand(DB, cmd.Name), cmd.Parameters)
If limit <= 0 Then limit = 0x7fffffff 'max int
Dim jrs As JavaObject = rs
Dim rsmd As JavaObject = jrs.RunMethod("getMetaData", Null)
Dim cols As Int = rs.ColumnCount
Dim res As DBResult
res.Initialize
res.columns.Initialize
res.Tag = Null 'without this the Tag properly will not be serializable.
For i = 0 To cols - 1
res.columns.Put(rs.GetColumnName(i), i)
Next
res.Rows.Initialize
Do While rs.NextRow And limit > 0
Dim row(cols) As Object
For i = 0 To cols - 1
Dim ct As Int = rsmd.RunMethod("getColumnType", Array(i + 1))
'check whether it is a blob field
If ct = -2 Or ct = 2004 Or ct = -3 Or ct = -4 Then
row(i) = rs.GetBlob2(i)
Else If ct = 2005 Then
row(i) = rs.GetString2(i)
Else if ct = 2 Or ct = 3 Then
row(i) = rs.GetDouble2(i)
Else If DateTimeMethods.ContainsKey(ct) Then
Dim SQLTime As JavaObject = jrs.RunMethodJO(DateTimeMethods.Get(ct), Array(i + 1))
If SQLTime.IsInitialized Then
row(i) = SQLTime.RunMethod("getTime", Null)
Else
row(i) = Null
End If
Else
row(i) = jrs.RunMethod("getObject", Array(i + 1))
End If
Next
res.Rows.Add(row)
Loop
rs.Close
Dim data() As Byte = ser.ConvertObjectToBytes(res)
resp.OutputStream.WriteBytes(data, 0, data.Length)
Return "query: " & cmd.Name
End Sub
Private Sub ExecuteBatch2(DB As String, con As SQL, in As InputStream, resp As ServletResponse) As String
Dim ser As B4XSerializator
Dim m As Map = ser.ConvertBytesToObject(Bit.InputStreamToBytes(in))
Dim commands As List = m.Get("commands")
Dim res As DBResult
res.Initialize
res.columns = CreateMap("AffectedRows (N/A)": 0)
res.Rows.Initialize
res.Tag = Null
Try
con.BeginTransaction
For Each cmd As DBCommand In commands
con.ExecNonQuery2(Connector.GetCommand(DB, cmd.Name), _
cmd.Parameters)
Next
res.Rows.Add(Array As Object(0))
con.TransactionSuccessful
Catch
con.Rollback
Log(LastException)
resp.SendError(500, LastException.Message)
End Try
Dim data() As Byte = ser.ConvertObjectToBytes(res)
resp.OutputStream.WriteBytes(data, 0, data.Length)
Return $"batch (size=${commands.Size})"$
End Sub
'#if VERSION1
Private Sub ExecuteBatch(DB As String, con As SQL, in As InputStream, resp As ServletResponse) As String
Dim clientVersion As Float = ReadObject(in) 'ignore
Dim numberOfStatements As Int = ReadInt(in)
Dim res(numberOfStatements) As Int
Try
con.BeginTransaction
For i = 0 To numberOfStatements - 1
Dim queryName As String = ReadObject(in)
Dim params As List = ReadList(in)
con.ExecNonQuery2(Connector.GetCommand(DB, queryName), _
params)
Next
con.TransactionSuccessful
Dim out As OutputStream = cs.WrapOutputStream(resp.OutputStream, "gzip")
WriteObject(Main.VERSION, out)
WriteObject("batch", out)
WriteInt(res.Length, out)
For Each r As Int In res
WriteInt(r, out)
Next
out.Close
Catch
con.Rollback
Log(LastException)
resp.SendError(500, LastException.Message)
End Try
Return $"batch (size=${numberOfStatements})"$
End Sub
Private Sub ExecuteQuery (DB As String, con As SQL, in As InputStream, resp As ServletResponse) As String
Log("==== ExecuteQuery ==== ")
Dim clientVersion As Float = ReadObject(in) 'ignore
Dim queryName As String = ReadObject(in)
Dim limit As Int = ReadInt(in)
Dim params As List = ReadList(in)
' Log("EL QUERY: |" & queryName & "|")
Private theSql As String = Connector.GetCommand(DB, queryName)
' Log(theSql)
' Log(params)
' Log(params.Size)
Dim rs As ResultSet = con.ExecQuery2(theSql, params)
If limit <= 0 Then limit = 0x7fffffff 'max int
Dim jrs As JavaObject = rs
Dim rsmd As JavaObject = jrs.RunMethod("getMetaData", Null)
Dim cols As Int = rs.ColumnCount
Dim out As OutputStream = cs.WrapOutputStream(resp.OutputStream, "gzip")
WriteObject(Main.VERSION, out)
WriteObject("query", out)
WriteInt(rs.ColumnCount, out)
' Log($"cols: ${cols}"$)
For i = 0 To cols - 1
WriteObject(rs.GetColumnName(i), out)
Next
Do While rs.NextRow And limit > 0
WriteByte(1, out)
For i = 0 To cols - 1
Dim ct As Int = rsmd.RunMethod("getColumnType", Array(i + 1))
'check whether it is a blob field
If ct = -2 Or ct = 2004 Or ct = -3 Or ct = -4 Then
WriteObject(rs.GetBlob2(i), out)
Else
WriteObject(jrs.RunMethod("getObject", Array(i + 1)), out)
End If
Next
Loop
WriteByte(0, out)
out.Close
rs.Close
Return "query: " & queryName
End Sub
Private Sub WriteByte(value As Byte, out As OutputStream)
out.WriteBytes(Array As Byte(value), 0, 1)
End Sub
Private Sub WriteObject(o As Object, out As OutputStream)
Dim data() As Byte
If o = Null Then
out.WriteBytes(Array As Byte(T_NULL), 0, 1)
Else If o Is Short Then
out.WriteBytes(Array As Byte(T_SHORT), 0, 1)
data = bc.ShortsToBytes(Array As Short(o))
Else If o Is Int Then
out.WriteBytes(Array As Byte(T_INT), 0, 1)
data = bc.IntsToBytes(Array As Int(o))
Else If o Is Float Then
out.WriteBytes(Array As Byte(T_FLOAT), 0, 1)
data = bc.FloatsToBytes(Array As Float(o))
Else If o Is Double Then
out.WriteBytes(Array As Byte(T_DOUBLE), 0, 1)
data = bc.DoublesToBytes(Array As Double(o))
Else If o Is Long Then
out.WriteBytes(Array As Byte(T_LONG), 0, 1)
data = bc.LongsToBytes(Array As Long(o))
Else If o Is Boolean Then
out.WriteBytes(Array As Byte(T_BOOLEAN), 0, 1)
Dim b As Boolean = o
Dim data(1) As Byte
If b Then data(0) = 1 Else data(0) = 0
Else If GetType(o) = "[B" Then
data = o
out.WriteBytes(Array As Byte(T_BLOB), 0, 1)
WriteInt(data.Length, out)
Else 'If o Is String Then (treat all other values as string)
out.WriteBytes(Array As Byte(T_STRING), 0, 1)
data = bc.StringToBytes(o, "UTF8")
WriteInt(data.Length, out)
End If
If data.Length > 0 Then out.WriteBytes(data, 0, data.Length)
End Sub
Private Sub ReadObject(In As InputStream) As Object
Dim data(1) As Byte
In.ReadBytes(data, 0, 1)
Select data(0)
Case T_NULL
Return Null
Case T_SHORT
Dim data(2) As Byte
Return bc.ShortsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_INT
Dim data(4) As Byte
Return bc.IntsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_LONG
Dim data(8) As Byte
Return bc.LongsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_FLOAT
Dim data(4) As Byte
Return bc.FloatsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_DOUBLE
Dim data(8) As Byte
Return bc.DoublesFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_BOOLEAN
Dim b As Byte = ReadByte(In)
Return b = 1
Case T_BLOB
Dim len As Int = ReadInt(In)
Dim data(len) As Byte
Return ReadBytesFully(In, data, data.Length)
Case Else
Dim len As Int = ReadInt(In)
Dim data(len) As Byte
ReadBytesFully(In, data, data.Length)
Return BytesToString(data, 0, data.Length, "UTF8")
End Select
End Sub
Private Sub ReadBytesFully(In As InputStream, Data() As Byte, Len As Int) As Byte()
Dim count = 0, Read As Int
Do While count < Len And Read > -1
Read = In.ReadBytes(Data, count, Len - count)
count = count + Read
Loop
Return Data
End Sub
Private Sub WriteInt(i As Int, out As OutputStream)
Dim data() As Byte
data = bc.IntsToBytes(Array As Int(i))
out.WriteBytes(data, 0, data.Length)
End Sub
Private Sub ReadInt(In As InputStream) As Int
Dim data(4) As Byte
Return bc.IntsFromBytes(ReadBytesFully(In, data, data.Length))(0)
End Sub
Private Sub ReadByte(In As InputStream) As Byte
Dim data(1) As Byte
In.ReadBytes(data, 0, 1)
Return data(0)
End Sub
Private Sub ReadList(in As InputStream) As List
Dim len As Int = ReadInt(in)
Dim l1 As List
l1.Initialize
For i = 0 To len - 1
l1.Add(ReadObject(in))
Next
Return l1
End Sub
'#end If

View File

@@ -1,319 +0,0 @@
B4J=true
Group=Default Group
ModulesStructureVersion=1
Type=Class
Version=10
@EndOfDesignText@
'Handler class
Sub Class_Globals
' #if VERSION1
Private const T_NULL = 0, T_STRING = 1, T_SHORT = 2, T_INT = 3, T_LONG = 4, T_FLOAT = 5 _
,T_DOUBLE = 6, T_BOOLEAN = 7, T_BLOB = 8 As Byte
Private bc As ByteConverter
Private cs As CompressedStreams
' #end if
Private DateTimeMethods As Map
Private Connector As RDCConnector
End Sub
Public Sub Initialize
DateTimeMethods = CreateMap(91: "getDate", 92: "getTime", 93: "getTimestamp")
End Sub
Sub Handle(req As ServletRequest, resp As ServletResponse)
Log("********************* DB3 ********************")
Dim start As Long = DateTime.Now
Dim q As String
Dim in As InputStream = req.InputStream
Dim method As String = req.GetParameter("method")
Connector = Main.Connectors.Get("DB3")
Dim con As SQL
Try
con = Connector.GetConnection("DB3")
If method = "query2" Then
q = ExecuteQuery2("DB3", con, in, resp)
'#if VERSION1
Else if method = "query" Then
in = cs.WrapInputStream(in, "gzip")
q = ExecuteQuery("DB3", con, in, resp)
Else if method = "batch" Then
in = cs.WrapInputStream(in, "gzip")
q = ExecuteBatch("DB3", con, in, resp)
'#end if
Else if method = "batch2" Then
q = ExecuteBatch2("DB3", con, in, resp)
Else
Log("Unknown method: " & method)
resp.SendError(500, "unknown method")
End If
Catch
Log(LastException)
resp.SendError(500, LastException.Message)
End Try
If con <> Null And con.IsInitialized Then con.Close
Log($"Command: ${q}, took: ${DateTime.Now - start}ms, client=${req.RemoteAddress}"$)
End Sub
Private Sub ExecuteQuery2 (DB As String, con As SQL, in As InputStream, resp As ServletResponse) As String
Dim ser As B4XSerializator
Dim m As Map = ser.ConvertBytesToObject(Bit.InputStreamToBytes(in))
Dim cmd As DBCommand = m.Get("command")
Dim limit As Int = m.Get("limit")
Dim rs As ResultSet = con.ExecQuery2(Connector.GetCommand(DB, cmd.Name), cmd.Parameters)
If limit <= 0 Then limit = 0x7fffffff 'max int
Dim jrs As JavaObject = rs
Dim rsmd As JavaObject = jrs.RunMethod("getMetaData", Null)
Dim cols As Int = rs.ColumnCount
Dim res As DBResult
res.Initialize
res.columns.Initialize
res.Tag = Null 'without this the Tag properly will not be serializable.
For i = 0 To cols - 1
res.columns.Put(rs.GetColumnName(i), i)
Next
res.Rows.Initialize
Do While rs.NextRow And limit > 0
Dim row(cols) As Object
For i = 0 To cols - 1
Dim ct As Int = rsmd.RunMethod("getColumnType", Array(i + 1))
'check whether it is a blob field
If ct = -2 Or ct = 2004 Or ct = -3 Or ct = -4 Then
row(i) = rs.GetBlob2(i)
Else If ct = 2005 Then
row(i) = rs.GetString2(i)
Else if ct = 2 Or ct = 3 Then
row(i) = rs.GetDouble2(i)
Else If DateTimeMethods.ContainsKey(ct) Then
Dim SQLTime As JavaObject = jrs.RunMethodJO(DateTimeMethods.Get(ct), Array(i + 1))
If SQLTime.IsInitialized Then
row(i) = SQLTime.RunMethod("getTime", Null)
Else
row(i) = Null
End If
Else
row(i) = jrs.RunMethod("getObject", Array(i + 1))
End If
Next
res.Rows.Add(row)
Loop
rs.Close
Dim data() As Byte = ser.ConvertObjectToBytes(res)
resp.OutputStream.WriteBytes(data, 0, data.Length)
Return "query: " & cmd.Name
End Sub
Private Sub ExecuteBatch2(DB As String, con As SQL, in As InputStream, resp As ServletResponse) As String
Dim ser As B4XSerializator
Dim m As Map = ser.ConvertBytesToObject(Bit.InputStreamToBytes(in))
Dim commands As List = m.Get("commands")
Dim res As DBResult
res.Initialize
res.columns = CreateMap("AffectedRows (N/A)": 0)
res.Rows.Initialize
res.Tag = Null
Try
con.BeginTransaction
For Each cmd As DBCommand In commands
con.ExecNonQuery2(Connector.GetCommand(DB, cmd.Name), _
cmd.Parameters)
Next
res.Rows.Add(Array As Object(0))
con.TransactionSuccessful
Catch
con.Rollback
Log(LastException)
resp.SendError(500, LastException.Message)
End Try
Dim data() As Byte = ser.ConvertObjectToBytes(res)
resp.OutputStream.WriteBytes(data, 0, data.Length)
Return $"batch (size=${commands.Size})"$
End Sub
'#if VERSION1
Private Sub ExecuteBatch(DB As String, con As SQL, in As InputStream, resp As ServletResponse) As String
Dim clientVersion As Float = ReadObject(in) 'ignore
Dim numberOfStatements As Int = ReadInt(in)
Dim res(numberOfStatements) As Int
Try
con.BeginTransaction
For i = 0 To numberOfStatements - 1
Dim queryName As String = ReadObject(in)
Dim params As List = ReadList(in)
con.ExecNonQuery2(Connector.GetCommand(DB, queryName), _
params)
Next
con.TransactionSuccessful
Dim out As OutputStream = cs.WrapOutputStream(resp.OutputStream, "gzip")
WriteObject(Main.VERSION, out)
WriteObject("batch", out)
WriteInt(res.Length, out)
For Each r As Int In res
WriteInt(r, out)
Next
out.Close
Catch
con.Rollback
Log(LastException)
resp.SendError(500, LastException.Message)
End Try
Return $"batch (size=${numberOfStatements})"$
End Sub
Private Sub ExecuteQuery (DB As String, con As SQL, in As InputStream, resp As ServletResponse) As String
' Log("==== ExecuteQuery ==== ")
Dim clientVersion As Float = ReadObject(in) 'ignore
Dim queryName As String = ReadObject(in)
Dim limit As Int = ReadInt(in)
Dim params As List = ReadList(in)
' Log("EL QUERY: |" & queryName & "|")
Private theSql As String = Connector.GetCommand(DB, queryName)
' Log(theSql)
' Log(params)
' Log(params.Size)
Dim rs As ResultSet = con.ExecQuery2(theSql, params)
If limit <= 0 Then limit = 0x7fffffff 'max int
Dim jrs As JavaObject = rs
Dim rsmd As JavaObject = jrs.RunMethod("getMetaData", Null)
Dim cols As Int = rs.ColumnCount
Dim out As OutputStream = cs.WrapOutputStream(resp.OutputStream, "gzip")
WriteObject(Main.VERSION, out)
WriteObject("query", out)
WriteInt(rs.ColumnCount, out)
' Log($"cols: ${cols}"$)
For i = 0 To cols - 1
WriteObject(rs.GetColumnName(i), out)
Next
Do While rs.NextRow And limit > 0
WriteByte(1, out)
For i = 0 To cols - 1
Dim ct As Int = rsmd.RunMethod("getColumnType", Array(i + 1))
'check whether it is a blob field
If ct = -2 Or ct = 2004 Or ct = -3 Or ct = -4 Then
WriteObject(rs.GetBlob2(i), out)
Else
WriteObject(jrs.RunMethod("getObject", Array(i + 1)), out)
End If
Next
Loop
WriteByte(0, out)
out.Close
rs.Close
Return "query: " & queryName
End Sub
Private Sub WriteByte(value As Byte, out As OutputStream)
out.WriteBytes(Array As Byte(value), 0, 1)
End Sub
Private Sub WriteObject(o As Object, out As OutputStream)
Dim data() As Byte
If o = Null Then
out.WriteBytes(Array As Byte(T_NULL), 0, 1)
Else If o Is Short Then
out.WriteBytes(Array As Byte(T_SHORT), 0, 1)
data = bc.ShortsToBytes(Array As Short(o))
Else If o Is Int Then
out.WriteBytes(Array As Byte(T_INT), 0, 1)
data = bc.IntsToBytes(Array As Int(o))
Else If o Is Float Then
out.WriteBytes(Array As Byte(T_FLOAT), 0, 1)
data = bc.FloatsToBytes(Array As Float(o))
Else If o Is Double Then
out.WriteBytes(Array As Byte(T_DOUBLE), 0, 1)
data = bc.DoublesToBytes(Array As Double(o))
Else If o Is Long Then
out.WriteBytes(Array As Byte(T_LONG), 0, 1)
data = bc.LongsToBytes(Array As Long(o))
Else If o Is Boolean Then
out.WriteBytes(Array As Byte(T_BOOLEAN), 0, 1)
Dim b As Boolean = o
Dim data(1) As Byte
If b Then data(0) = 1 Else data(0) = 0
Else If GetType(o) = "[B" Then
data = o
out.WriteBytes(Array As Byte(T_BLOB), 0, 1)
WriteInt(data.Length, out)
Else 'If o Is String Then (treat all other values as string)
out.WriteBytes(Array As Byte(T_STRING), 0, 1)
data = bc.StringToBytes(o, "UTF8")
WriteInt(data.Length, out)
End If
If data.Length > 0 Then out.WriteBytes(data, 0, data.Length)
End Sub
Private Sub ReadObject(In As InputStream) As Object
Dim data(1) As Byte
In.ReadBytes(data, 0, 1)
Select data(0)
Case T_NULL
Return Null
Case T_SHORT
Dim data(2) As Byte
Return bc.ShortsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_INT
Dim data(4) As Byte
Return bc.IntsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_LONG
Dim data(8) As Byte
Return bc.LongsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_FLOAT
Dim data(4) As Byte
Return bc.FloatsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_DOUBLE
Dim data(8) As Byte
Return bc.DoublesFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_BOOLEAN
Dim b As Byte = ReadByte(In)
Return b = 1
Case T_BLOB
Dim len As Int = ReadInt(In)
Dim data(len) As Byte
Return ReadBytesFully(In, data, data.Length)
Case Else
Dim len As Int = ReadInt(In)
Dim data(len) As Byte
ReadBytesFully(In, data, data.Length)
Return BytesToString(data, 0, data.Length, "UTF8")
End Select
End Sub
Private Sub ReadBytesFully(In As InputStream, Data() As Byte, Len As Int) As Byte()
Dim count = 0, Read As Int
Do While count < Len And Read > -1
Read = In.ReadBytes(Data, count, Len - count)
count = count + Read
Loop
Return Data
End Sub
Private Sub WriteInt(i As Int, out As OutputStream)
Dim data() As Byte
data = bc.IntsToBytes(Array As Int(i))
out.WriteBytes(data, 0, data.Length)
End Sub
Private Sub ReadInt(In As InputStream) As Int
Dim data(4) As Byte
Return bc.IntsFromBytes(ReadBytesFully(In, data, data.Length))(0)
End Sub
Private Sub ReadByte(In As InputStream) As Byte
Dim data(1) As Byte
In.ReadBytes(data, 0, 1)
Return data(0)
End Sub
Private Sub ReadList(in As InputStream) As List
Dim len As Int = ReadInt(in)
Dim l1 As List
l1.Initialize
For i = 0 To len - 1
l1.Add(ReadObject(in))
Next
Return l1
End Sub
'#end If

View File

@@ -1,319 +0,0 @@
B4J=true
Group=Default Group
ModulesStructureVersion=1
Type=Class
Version=10
@EndOfDesignText@
'Handler class
Sub Class_Globals
' #if VERSION1
Private const T_NULL = 0, T_STRING = 1, T_SHORT = 2, T_INT = 3, T_LONG = 4, T_FLOAT = 5 _
,T_DOUBLE = 6, T_BOOLEAN = 7, T_BLOB = 8 As Byte
Private bc As ByteConverter
Private cs As CompressedStreams
' #end if
Private DateTimeMethods As Map
Private Connector As RDCConnector
End Sub
Public Sub Initialize
DateTimeMethods = CreateMap(91: "getDate", 92: "getTime", 93: "getTimestamp")
End Sub
Sub Handle(req As ServletRequest, resp As ServletResponse)
Log("********************* DB4 ********************")
Dim start As Long = DateTime.Now
Dim q As String
Dim in As InputStream = req.InputStream
Dim method As String = req.GetParameter("method")
Connector = Main.Connectors.Get("DB4")
Dim con As SQL
Try
con = Connector.GetConnection("DB4")
If method = "query2" Then
q = ExecuteQuery2("DB4", con, in, resp)
'#if VERSION1
Else if method = "query" Then
in = cs.WrapInputStream(in, "gzip")
q = ExecuteQuery("DB4", con, in, resp)
Else if method = "batch" Then
in = cs.WrapInputStream(in, "gzip")
q = ExecuteBatch("DB4", con, in, resp)
'#end if
Else if method = "batch2" Then
q = ExecuteBatch2("DB4", con, in, resp)
Else
Log("Unknown method: " & method)
resp.SendError(500, "unknown method")
End If
Catch
Log(LastException)
resp.SendError(500, LastException.Message)
End Try
If con <> Null And con.IsInitialized Then con.Close
Log($"Command: ${q}, took: ${DateTime.Now - start}ms, client=${req.RemoteAddress}"$)
End Sub
Private Sub ExecuteQuery2 (DB As String, con As SQL, in As InputStream, resp As ServletResponse) As String
Dim ser As B4XSerializator
Dim m As Map = ser.ConvertBytesToObject(Bit.InputStreamToBytes(in))
Dim cmd As DBCommand = m.Get("command")
Dim limit As Int = m.Get("limit")
Dim rs As ResultSet = con.ExecQuery2(Connector.GetCommand(DB, cmd.Name), cmd.Parameters)
If limit <= 0 Then limit = 0x7fffffff 'max int
Dim jrs As JavaObject = rs
Dim rsmd As JavaObject = jrs.RunMethod("getMetaData", Null)
Dim cols As Int = rs.ColumnCount
Dim res As DBResult
res.Initialize
res.columns.Initialize
res.Tag = Null 'without this the Tag properly will not be serializable.
For i = 0 To cols - 1
res.columns.Put(rs.GetColumnName(i), i)
Next
res.Rows.Initialize
Do While rs.NextRow And limit > 0
Dim row(cols) As Object
For i = 0 To cols - 1
Dim ct As Int = rsmd.RunMethod("getColumnType", Array(i + 1))
'check whether it is a blob field
If ct = -2 Or ct = 2004 Or ct = -3 Or ct = -4 Then
row(i) = rs.GetBlob2(i)
Else If ct = 2005 Then
row(i) = rs.GetString2(i)
Else if ct = 2 Or ct = 3 Then
row(i) = rs.GetDouble2(i)
Else If DateTimeMethods.ContainsKey(ct) Then
Dim SQLTime As JavaObject = jrs.RunMethodJO(DateTimeMethods.Get(ct), Array(i + 1))
If SQLTime.IsInitialized Then
row(i) = SQLTime.RunMethod("getTime", Null)
Else
row(i) = Null
End If
Else
row(i) = jrs.RunMethod("getObject", Array(i + 1))
End If
Next
res.Rows.Add(row)
Loop
rs.Close
Dim data() As Byte = ser.ConvertObjectToBytes(res)
resp.OutputStream.WriteBytes(data, 0, data.Length)
Return "query: " & cmd.Name
End Sub
Private Sub ExecuteBatch2(DB As String, con As SQL, in As InputStream, resp As ServletResponse) As String
Dim ser As B4XSerializator
Dim m As Map = ser.ConvertBytesToObject(Bit.InputStreamToBytes(in))
Dim commands As List = m.Get("commands")
Dim res As DBResult
res.Initialize
res.columns = CreateMap("AffectedRows (N/A)": 0)
res.Rows.Initialize
res.Tag = Null
Try
con.BeginTransaction
For Each cmd As DBCommand In commands
con.ExecNonQuery2(Connector.GetCommand(DB, cmd.Name), _
cmd.Parameters)
Next
res.Rows.Add(Array As Object(0))
con.TransactionSuccessful
Catch
con.Rollback
Log(LastException)
resp.SendError(500, LastException.Message)
End Try
Dim data() As Byte = ser.ConvertObjectToBytes(res)
resp.OutputStream.WriteBytes(data, 0, data.Length)
Return $"batch (size=${commands.Size})"$
End Sub
'#if VERSION1
Private Sub ExecuteBatch(DB As String, con As SQL, in As InputStream, resp As ServletResponse) As String
Dim clientVersion As Float = ReadObject(in) 'ignore
Dim numberOfStatements As Int = ReadInt(in)
Dim res(numberOfStatements) As Int
Try
con.BeginTransaction
For i = 0 To numberOfStatements - 1
Dim queryName As String = ReadObject(in)
Dim params As List = ReadList(in)
con.ExecNonQuery2(Connector.GetCommand(DB, queryName), _
params)
Next
con.TransactionSuccessful
Dim out As OutputStream = cs.WrapOutputStream(resp.OutputStream, "gzip")
WriteObject(Main.VERSION, out)
WriteObject("batch", out)
WriteInt(res.Length, out)
For Each r As Int In res
WriteInt(r, out)
Next
out.Close
Catch
con.Rollback
Log(LastException)
resp.SendError(500, LastException.Message)
End Try
Return $"batch (size=${numberOfStatements})"$
End Sub
Private Sub ExecuteQuery (DB As String, con As SQL, in As InputStream, resp As ServletResponse) As String
' Log("==== ExecuteQuery ==== ")
Dim clientVersion As Float = ReadObject(in) 'ignore
Dim queryName As String = ReadObject(in)
Dim limit As Int = ReadInt(in)
Dim params As List = ReadList(in)
' Log("EL QUERY: |" & queryName & "|")
Private theSql As String = Connector.GetCommand(DB, queryName)
' Log(theSql)
' Log(params)
' Log(params.Size)
Dim rs As ResultSet = con.ExecQuery2(theSql, params)
If limit <= 0 Then limit = 0x7fffffff 'max int
Dim jrs As JavaObject = rs
Dim rsmd As JavaObject = jrs.RunMethod("getMetaData", Null)
Dim cols As Int = rs.ColumnCount
Dim out As OutputStream = cs.WrapOutputStream(resp.OutputStream, "gzip")
WriteObject(Main.VERSION, out)
WriteObject("query", out)
WriteInt(rs.ColumnCount, out)
' Log($"cols: ${cols}"$)
For i = 0 To cols - 1
WriteObject(rs.GetColumnName(i), out)
Next
Do While rs.NextRow And limit > 0
WriteByte(1, out)
For i = 0 To cols - 1
Dim ct As Int = rsmd.RunMethod("getColumnType", Array(i + 1))
'check whether it is a blob field
If ct = -2 Or ct = 2004 Or ct = -3 Or ct = -4 Then
WriteObject(rs.GetBlob2(i), out)
Else
WriteObject(jrs.RunMethod("getObject", Array(i + 1)), out)
End If
Next
Loop
WriteByte(0, out)
out.Close
rs.Close
Return "query: " & queryName
End Sub
Private Sub WriteByte(value As Byte, out As OutputStream)
out.WriteBytes(Array As Byte(value), 0, 1)
End Sub
Private Sub WriteObject(o As Object, out As OutputStream)
Dim data() As Byte
If o = Null Then
out.WriteBytes(Array As Byte(T_NULL), 0, 1)
Else If o Is Short Then
out.WriteBytes(Array As Byte(T_SHORT), 0, 1)
data = bc.ShortsToBytes(Array As Short(o))
Else If o Is Int Then
out.WriteBytes(Array As Byte(T_INT), 0, 1)
data = bc.IntsToBytes(Array As Int(o))
Else If o Is Float Then
out.WriteBytes(Array As Byte(T_FLOAT), 0, 1)
data = bc.FloatsToBytes(Array As Float(o))
Else If o Is Double Then
out.WriteBytes(Array As Byte(T_DOUBLE), 0, 1)
data = bc.DoublesToBytes(Array As Double(o))
Else If o Is Long Then
out.WriteBytes(Array As Byte(T_LONG), 0, 1)
data = bc.LongsToBytes(Array As Long(o))
Else If o Is Boolean Then
out.WriteBytes(Array As Byte(T_BOOLEAN), 0, 1)
Dim b As Boolean = o
Dim data(1) As Byte
If b Then data(0) = 1 Else data(0) = 0
Else If GetType(o) = "[B" Then
data = o
out.WriteBytes(Array As Byte(T_BLOB), 0, 1)
WriteInt(data.Length, out)
Else 'If o Is String Then (treat all other values as string)
out.WriteBytes(Array As Byte(T_STRING), 0, 1)
data = bc.StringToBytes(o, "UTF8")
WriteInt(data.Length, out)
End If
If data.Length > 0 Then out.WriteBytes(data, 0, data.Length)
End Sub
Private Sub ReadObject(In As InputStream) As Object
Dim data(1) As Byte
In.ReadBytes(data, 0, 1)
Select data(0)
Case T_NULL
Return Null
Case T_SHORT
Dim data(2) As Byte
Return bc.ShortsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_INT
Dim data(4) As Byte
Return bc.IntsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_LONG
Dim data(8) As Byte
Return bc.LongsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_FLOAT
Dim data(4) As Byte
Return bc.FloatsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_DOUBLE
Dim data(8) As Byte
Return bc.DoublesFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_BOOLEAN
Dim b As Byte = ReadByte(In)
Return b = 1
Case T_BLOB
Dim len As Int = ReadInt(In)
Dim data(len) As Byte
Return ReadBytesFully(In, data, data.Length)
Case Else
Dim len As Int = ReadInt(In)
Dim data(len) As Byte
ReadBytesFully(In, data, data.Length)
Return BytesToString(data, 0, data.Length, "UTF8")
End Select
End Sub
Private Sub ReadBytesFully(In As InputStream, Data() As Byte, Len As Int) As Byte()
Dim count = 0, Read As Int
Do While count < Len And Read > -1
Read = In.ReadBytes(Data, count, Len - count)
count = count + Read
Loop
Return Data
End Sub
Private Sub WriteInt(i As Int, out As OutputStream)
Dim data() As Byte
data = bc.IntsToBytes(Array As Int(i))
out.WriteBytes(data, 0, data.Length)
End Sub
Private Sub ReadInt(In As InputStream) As Int
Dim data(4) As Byte
Return bc.IntsFromBytes(ReadBytesFully(In, data, data.Length))(0)
End Sub
Private Sub ReadByte(In As InputStream) As Byte
Dim data(1) As Byte
In.ReadBytes(data, 0, 1)
Return data(0)
End Sub
Private Sub ReadList(in As InputStream) As List
Dim len As Int = ReadInt(in)
Dim l1 As List
l1.Initialize
For i = 0 To len - 1
l1.Add(ReadObject(in))
Next
Return l1
End Sub
'#end If

781
DBHandlerB4X.bas Normal file
View File

@@ -0,0 +1,781 @@
B4J=true
Group=Default Group
ModulesStructureVersion=1
Type=Class
Version=10.3
@EndOfDesignText@
' Módulo de clase: DBHandlerB4X
' Este handler genérico se encarga de procesar las peticiones HTTP provenientes
' de clientes B4A/B4i (que utilizan la librería DBRequestManager).
' La base de datos a utilizar (DB1, DB2, etc.) se determina dinámicamente
' a partir de la URL de la petición.
' Esta versión incluye validaciones de parámetros y manejo de errores.
Sub Class_Globals
' --- Variables globales de la clase ---
' La siguiente sección de constantes y utilidades se compila condicionalmente
' solo si la directiva #if VERSION1 está activa. Esto es para dar soporte
' a una versión antigua del protocolo de comunicación de DBRequestManager.
' #if VERSION1
' Constantes para identificar los tipos de datos en la serialización personalizada (protocolo V1).
Private const T_NULL = 0, T_STRING = 1, T_SHORT = 2, T_INT = 3, T_LONG = 4, T_FLOAT = 5 _
,T_DOUBLE = 6, T_BOOLEAN = 7, T_BLOB = 8 As Byte
' Utilidades para convertir entre tipos de datos y arrays de bytes.
Private bc As ByteConverter
' Utilidad para comprimir/descomprimir streams de datos (usado en V1).
Private cs As CompressedStreams
' #end if
' Mapa para convertir tipos de columna JDBC de fecha/hora a los nombres de métodos de Java
' para obtener los valores correctos de ResultSet.
Private DateTimeMethods As Map
' Objeto que gestiona las conexiones al pool de una base de datos específica.
' Esta instancia de RDCConnector será asignada en el método Handle según la dbKey de la petición.
Private Connector As RDCConnector
End Sub
' Se ejecuta una vez cuando se crea una instancia de esta clase por el servidor HTTP.
Public Sub Initialize
' Inicializa el mapa que asocia los códigos de tipo de columna de fecha/hora de JDBC
' con los nombres de los métodos correspondientes para leerlos correctamente desde un ResultSet.
DateTimeMethods = CreateMap(91: "getDate", 92: "getTime", 93: "getTimestamp")
End Sub
' Método principal que maneja cada petición HTTP que llega a este handler.
' req: El objeto ServletRequest que contiene la información de la petición entrante.
' resp: El objeto ServletResponse para construir y enviar la respuesta al cliente.
Sub Handle(req As ServletRequest, resp As ServletResponse)
' === INICIO DE LA LÓGICA DINÁMICA: Extracción de dbKey de la URL ===
' Esta sección analiza la URL de la petición para determinar a qué base de datos
' (DB1, DB2, etc.) se dirige la solicitud. Por ejemplo, si la URL es "/DB2/query",
' el 'dbKey' extraído será "DB2".
Dim URI As String = req.RequestURI
Dim dbKey As String ' Variable para almacenar el identificador de la base de datos.
If URI.Length > 1 And URI.StartsWith("/") Then
dbKey = URI.Substring(1) ' Elimina el '/' inicial.
If dbKey.Contains("/") Then
' Si la URL tiene más segmentos (ej. "/DB2/alguna_ruta"), toma solo el primer segmento como dbKey.
dbKey = dbKey.SubString2(0, dbKey.IndexOf("/"))
End If
Else
' Si la URL es solo "/", por defecto se usa "DB1".
dbKey = "DB1"
End If
dbKey = dbKey.ToUpperCase ' Normaliza el dbKey a mayúsculas para consistencia.
' Verifica si el dbKey extraído corresponde a una base de datos configurada y cargada en Main.
If Main.Connectors.ContainsKey(dbKey) = False Then
Dim ErrorMsg As String = $"Invalid DB key specified in URL: '${dbKey}'. Valid keys are: ${Main.listaDeCP}"$
Log(ErrorMsg)
Main.LogServerError("ERROR", "DBHandlerB4X.Handle", ErrorMsg, dbKey, Null, req.RemoteAddress) ' <-- Nuevo Log
SendPlainTextError(resp, 400, ErrorMsg)
Return
End If
' === FIN DE LA LÓGICA DINÁMICA ===
' Log("********************* " & dbKey & " ********************") ' Log de depuración para identificar la base de datos.
Dim start As Long = DateTime.Now ' Registra el tiempo de inicio de la petición para calcular la duración.
' --- INICIO: Conteo de peticiones activas para esta dbKey (Incrementar) ---
' Este bloque incrementa un contador global que rastrea cuántas peticiones están
' activas para una base de datos específica en un momento dado.
' <<<< ¡CORRECCIÓN CLAVE: Aseguramos que el valor inicial sea un Int y lo recuperamos como Int! >>>>
Dim currentActiveRequests As Int = GlobalParameters.ActiveRequestsCountByDB.GetDefault(dbKey, 0).As(Int)
GlobalParameters.ActiveRequestsCountByDB.Put(dbKey, currentActiveRequests + 1)
' requestsBeforeDecrement es el valor del contador justo después de que esta petición lo incrementa.
' Este es el valor que se registrará en la tabla 'query_logs'.
Dim requestsBeforeDecrement As Int = currentActiveRequests + 1
' Log($"[DEBUG] Handle Increment (B4X): dbKey=${dbKey}, currentCountFromMap=${currentActiveRequests}, requestsBeforeDecrement=${requestsBeforeDecrement}, Map state: ${GlobalParameters.ActiveRequestsCountByDB}"$)
' --- FIN: Conteo de peticiones activas ---
' Declaraciones de variables con alcance en toda la subrutina para asegurar la limpieza final.
Dim q As String = "unknown_b4x_command" ' Nombre del comando para el log, con valor por defecto.
Dim con As SQL ' La conexión a la BD, se inicializará más tarde.
Dim duration As Long ' La duración total de la petición, calculada antes del log.
Dim poolBusyConnectionsForLog As Int = 0 ' Contiene el número de conexiones ocupadas del pool.
Try ' --- INICIO: Bloque Try que envuelve la lógica principal del Handler ---
Dim in As InputStream = req.InputStream ' Obtiene el stream de entrada de la petición HTTP.
Dim method As String = req.GetParameter("method") ' Obtiene el parámetro 'method' de la URL (ej. "query2", "batch2").
Connector = Main.Connectors.Get(dbKey) ' Asigna la instancia de RDCConnector para esta dbKey.
con = Connector.GetConnection(dbKey) ' ¡La conexión a la BD se obtiene aquí del pool de conexiones!
' Este bloque captura el número de conexiones actualmente ocupadas en el pool
' *después* de que esta petición ha obtenido la suya.
If Connector.IsInitialized Then
Dim poolStats As Map = Connector.GetPoolStats
If poolStats.ContainsKey("BusyConnections") Then
poolBusyConnectionsForLog = poolStats.Get("BusyConnections").As(Int) ' Capturamos el valor.
Log($">>>>>>>>>> ${poolStats.Get("BusyConnections")} "$)
End If
End If
Dim cachedStatsB4X As Map = Main.LatestPoolStats.Get(dbKey).As(Map)
If cachedStatsB4X.IsInitialized Then
' 1. Actualizar Busy Connections y Active Requests
cachedStatsB4X.Put("BusyConnections", poolBusyConnectionsForLog)
cachedStatsB4X.Put("HandlerActiveRequests", requestsBeforeDecrement)
' 2. Capturar TotalConnections y IdleConnections (ya disponibles en poolStats)
If poolStats.ContainsKey("TotalConnections") Then
cachedStatsB4X.Put("TotalConnections", poolStats.Get("TotalConnections"))
End If
If poolStats.ContainsKey("IdleConnections") Then
cachedStatsB4X.Put("IdleConnections", poolStats.Get("IdleConnections"))
End If
' 3. Re-escribir el mapa en el cache global (es Thread-Safe)
Main.LatestPoolStats.Put(dbKey, cachedStatsB4X)
End If
' Log("Metodo: " & method) ' Log de depuración para identificar el método de la petición.
' --- Lógica para ejecutar diferentes tipos de comandos basados en el parámetro 'method' ---
If method = "query2" Then
' Ejecuta una consulta única utilizando el protocolo V2 (B4XSerializator).
q = ExecuteQuery2(dbKey, con, in, resp)
If q = "error" Then ' Si ExecuteQuery2 devolvió un error de validación.
duration = DateTime.Now - start
CleanupAndLog(dbKey, "error_in_" & method, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con)
Return ' Salida temprana si hay un error.
End If
' #if VERSION1
' Estas ramas se compilan solo si #if VERSION1 está activo (para protocolo antiguo).
Else if method = "query" Then
in = cs.WrapInputStream(in, "gzip") ' Descomprime el stream de entrada si es protocolo V1.
q = ExecuteQuery(dbKey, con, in, resp)
If q = "error" Then
duration = DateTime.Now - start
CleanupAndLog(dbKey, "error_in_" & method, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con)
Return
End If
Else if method = "batch" Then
in = cs.WrapInputStream(in, "gzip") ' Descomprime el stream de entrada si es protocolo V1.
q = ExecuteBatch(dbKey, con, in, resp)
If q = "error" Then
duration = DateTime.Now - start
CleanupAndLog(dbKey, "error_in_" & method, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con)
Return
End If
' #end if
Else if method = "batch2" Then
' Ejecuta un lote de comandos (INSERT, UPDATE, DELETE) utilizando el protocolo V2.
q = ExecuteBatch2(dbKey, con, in, resp)
If q = "error" Then
duration = DateTime.Now - start
CleanupAndLog(dbKey, "error_in_" & method, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con)
Return ' Salida temprana si hay un error.
End If
Else
Dim ErrorMsg As String = "Unknown method: " & method
Log(ErrorMsg)
Main.LogServerError("ERROR", "DBHandlerB4X.Handle", ErrorMsg, dbKey, method, req.RemoteAddress) ' <-- Nuevo Log
SendPlainTextError(resp, 500, "unknown method")
q = "unknown_method_handler"
duration = DateTime.Now - start
CleanupAndLog(dbKey, q, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con)
Return
End If
Catch ' --- CATCH: Maneja errores generales de ejecución o de SQL ---
Dim errorMessage As String = LastException.Message
If errorMessage.Contains("ORA-01002") Or errorMessage.Contains("recuperación fuera de secuencia") Then
errorMessage = "SE USA EXECUTEQUERY EN LUGAR DE EXECUTECOMMAND: " & errorMessage
else If errorMessage.Contains("ORA-17003") Or errorMessage.Contains("Índice de columnas no válido") Then
errorMessage = "NUMERO DE PARAMETROS EQUIVOCADO: " & errorMessage
End If
Log(errorMessage) ' Registra la excepción completa en el log.
Main.LogServerError("ERROR", "DBHandlerB4X.Handle", errorMessage, dbKey, q, req.RemoteAddress) ' <-- Nuevo Log
SendPlainTextError(resp, 500, errorMessage) ' Envía un error 500 al cliente.
q = "error_in_b4x_handler" ' Aseguramos un valor para 'q' en caso de excepción.
End Try ' --- FIN: Bloque Try principal ---
' --- Lógica de logging y limpieza final (para rutas de ejecución normal o después de Catch) ---
' Este bloque se asegura de que, independientemente de cómo termine la petición (éxito o error),
' la duración se calcule y se llamen las subrutinas de limpieza y logging.
duration = DateTime.Now - start ' Calcula la duración total de la petición.
Log($"${dbKey} - Command: ${q}, took: ${duration}ms, client=${req.RemoteAddress}"$) ' Logea el comando y la duración.
' Llama a la subrutina centralizada para registrar el rendimiento y limpiar recursos.
CleanupAndLog(dbKey, q, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con)
End Sub
' --- NUEVA SUBRUTINA: Centraliza el logging de rendimiento y la limpieza de recursos ---
' Esta subrutina es llamada por Handle en todos los puntos de salida, asegurando
' que los contadores se decrementen y las conexiones se cierren de forma consistente.
Private Sub CleanupAndLog(dbKey As String, qName As String, durMs As Long, clientIp As String, handlerReqs As Int, poolBusyConns As Int, conn As SQL)
' Log($"[DEBUG] CleanupAndLog Entry (B4X): dbKey=${dbKey}, handlerReqs=${handlerReqs}, Map state: ${GlobalParameters.ActiveRequestsCountByDB}"$)
' 1. Llama a la subrutina centralizada en Main para registrar el rendimiento en SQLite.
Main.LogQueryPerformance(qName, durMs, dbKey, clientIp, handlerReqs, poolBusyConns)
' <<<< ¡CORRECCIÓN CLAVE: Aseguramos que currentCount sea Int al obtenerlo del mapa! >>>>
' 2. Decrementa el contador de peticiones activas para esta dbKey de forma robusta.
Dim currentCount As Int = GlobalParameters.ActiveRequestsCountByDB.GetDefault(dbKey, 0).As(Int)
' Log($"[DEBUG] CleanupAndLog Before Decrement (B4X): dbKey=${dbKey}, currentCount (as Int)=${currentCount}, Map state: ${GlobalParameters.ActiveRequestsCountByDB}"$)
If currentCount > 0 Then
' Si el contador es positivo, lo decrementamos.
GlobalParameters.ActiveRequestsCountByDB.Put(dbKey, currentCount - 1)
Else
' Si el contador ya está en 0 o negativo (lo cual no debería ocurrir con la lógica actual,
' pero se maneja para robustez), registramos una advertencia y lo aseguramos en 0.
' Log($"ADVERTENCIA: Intento de decrementar ActiveRequestsCountByDB para ${dbKey} que ya estaba en ${currentCount}. Asegurando a 0."$)
GlobalParameters.ActiveRequestsCountByDB.Put(dbKey, 0)
End If
' Log($"[DEBUG] CleanupAndLog After Decrement (B4X): dbKey=${dbKey}, New count (as Int)=${GlobalParameters.ActiveRequestsCountByDB.GetDefault(dbKey,0).As(Int)}, Map state: ${GlobalParameters.ActiveRequestsCountByDB}"$)
' <<<< ¡FIN DE CORRECCIÓN CLAVE! >>>>
' 3. Asegura que la conexión a la BD siempre se cierre y se devuelva al pool de conexiones.
If conn <> Null And conn.IsInitialized Then conn.Close
End Sub
' --- Subrutinas para manejar la ejecución de queries y batches (Protocolo V2) ---
' Ejecuta una consulta única usando el protocolo V2 (B4XSerializator).
' DB: Identificador de la base de datos.
' con: La conexión SQL obtenida del pool.
' in: InputStream de la petición.
' resp: ServletResponse para enviar la respuesta.
' Retorna el nombre del comando ejecutado o "error" si falló.
Private Sub ExecuteQuery2 (DB As String, con As SQL, in As InputStream, resp As ServletResponse) As String
Dim ser As B4XSerializator ' Objeto para deserializar los datos enviados desde el cliente.
' Convierte el stream de entrada a un array de bytes y luego a un objeto Mapa.
Dim m As Map = ser.ConvertBytesToObject(Bit.InputStreamToBytes(in))
' Extrae el objeto DBCommand (nombre de la query y sus parámetros) del mapa.
Dim cmd As DBCommand = m.Get("command")
' Extrae el límite de filas a devolver (para paginación).
Dim limit As Int = m.Get("limit")
' Obtiene la sentencia SQL correspondiente al nombre del comando desde config.properties.
Dim sqlCommand As String = Connector.GetCommand(DB, cmd.Name)
' <<< INICIO NUEVA VALIDACIÓN: VERIFICAR SI EL COMANDO EXISTE >>>
' Comprueba si el comando no fue encontrado en el archivo de configuración.
If sqlCommand = Null Or sqlCommand = "null" Or sqlCommand.Trim = "" Then
Dim errorMessage As String = $"El comando '${cmd.Name}' no fue encontrado en el config.properties de '${DB}'."$
Log(errorMessage)
Main.LogServerError("ERROR", "DBHandlerB4X.ExecuteQuery2", errorMessage, DB, cmd.Name, Null)
' Envía un error 400 (Bad Request) al cliente informando del problema.
SendPlainTextError(resp, 400, errorMessage)
Return "error" ' Retorna un texto para el log.
End If
' <<< FIN NUEVA VALIDACIÓN >>>
' <<< INICIO VALIDACIÓN DE PARÁMETROS CENTRALIZADA >>>
' Convertimos el array de Object() de cmd.Parameters a una List para la utilidad de validación.
Dim paramsAsList As List
paramsAsList.Initialize
If cmd.Parameters <> Null Then
For Each p As Object In cmd.Parameters
paramsAsList.Add(p)
Next
End If
Dim validationResult As ParameterValidationResult = ParameterValidationUtils.ValidateAndAdjustParameters(cmd.Name, DB, sqlCommand, paramsAsList, Connector.IsParameterToleranceEnabled)
If validationResult.Success = False Then
SendPlainTextError(resp, 400, validationResult.ErrorMessage)
Return "error" ' Salida temprana si la validación falla.
End If
' Ejecuta la consulta SQL con la lista de parámetros validada.
Dim rs As ResultSet = con.ExecQuery2(sqlCommand, validationResult.ParamsToExecute)
' <<< FIN VALIDACIÓN DE PARÁMETROS CENTRALIZADA >>>
' Si el límite es 0 o negativo, lo establece a un valor muy alto (máximo entero).
If limit <= 0 Then limit = 0x7fffffff 'max int
' Obtiene el objeto Java subyacente del ResultSet para acceder a métodos adicionales.
Dim jrs As JavaObject = rs
' Obtiene los metadatos del ResultSet (información sobre las columnas).
Dim rsmd As JavaObject = jrs.RunMethod("getMetaData", Null)
' Obtiene el número de columnas del resultado.
Dim cols As Int = rs.ColumnCount
Dim res As DBResult ' Crea un objeto DBResult para empaquetar la respuesta.
res.Initialize
res.columns.Initialize
res.Tag = Null
' Llena el mapa de columnas con el nombre de cada columna y su índice.
For i = 0 To cols - 1
res.columns.Put(rs.GetColumnName(i), i)
Next
' Inicializa la lista de filas.
res.Rows.Initialize
' Itera sobre cada fila del ResultSet, hasta llegar al límite.
Do While rs.NextRow And limit > 0
Dim row(cols) As Object
' Itera sobre cada columna de la fila actual.
For i = 0 To cols - 1
' Obtiene el tipo de dato de la columna según JDBC.
Dim ct As Int = rsmd.RunMethod("getColumnType", Array(i + 1))
' Maneja diferentes tipos de datos para leerlos de la forma correcta.
If ct = -2 Or ct = 2004 Or ct = -3 Or ct = -4 Then ' Tipos BLOB/binarios
row(i) = rs.GetBlob2(i)
Else If ct = 2005 Then ' Tipo CLOB (texto largo)
row(i) = rs.GetString2(i)
Else if ct = 2 Or ct = 3 Then ' Tipos numéricos que pueden tener decimales
row(i) = rs.GetDouble2(i)
Else If DateTimeMethods.ContainsKey(ct) Then ' Tipos de Fecha/Hora
' Obtiene el objeto de tiempo/fecha de Java.
Dim SQLTime As JavaObject = jrs.RunMethodJO(DateTimeMethods.Get(ct), Array(i + 1))
If SQLTime.IsInitialized Then
' Lo convierte a milisegundos (Long) para B4X.
row(i) = SQLTime.RunMethod("getTime", Null)
Else
row(i) = Null
End If
Else ' Para todos los demás tipos de datos
' Usa getObject que funciona para la mayoría de los tipos estándar.
row(i) = jrs.RunMethod("getObject", Array(i + 1))
End If
Next
' Añade la fila completa a la lista de resultados.
res.Rows.Add(row)
limit = limit - 1
Loop
' Cierra el ResultSet para liberar recursos.
rs.Close
' Serializa el objeto DBResult completo a un array de bytes.
Dim data() As Byte = ser.ConvertObjectToBytes(res)
' Escribe los datos serializados en el stream de respuesta.
resp.OutputStream.WriteBytes(data, 0, data.Length)
' Devuelve el nombre del comando para el log.
Return "query: " & cmd.Name
End Sub
' Ejecuta un lote de comandos (INSERT, UPDATE, DELETE) usando el protocolo V2.
' DB: Identificador de la base de datos.
' con: La conexión SQL obtenida del pool.
' in: InputStream de la petición.
' resp: ServletResponse para enviar la respuesta.
' Retorna un resumen del lote para el log, o "error" si falló.
Private Sub ExecuteBatch2(DB As String, con As SQL, in As InputStream, resp As ServletResponse) As String
Dim ser As B4XSerializator
' Deserializa el mapa que contiene la lista de comandos.
Dim m As Map = ser.ConvertBytesToObject(Bit.InputStreamToBytes(in))
' Obtiene la lista de objetos DBCommand.
Dim commands As List = m.Get("commands")
Dim totalAffectedRows As Int = 0 ' Contador para acumular el total de filas afectadas.
' Prepara un objeto DBResult para la respuesta (aunque para batch no devuelve datos, solo confirmación).
Dim res As DBResult
res.Initialize
res.columns = CreateMap("AffectedRows": 0) ' Columna simbólica.
res.Rows.Initialize
res.Tag = Null
Try
' Inicia una transacción. Todos los comandos del lote se ejecutarán como una unidad.
con.BeginTransaction
' Itera sobre cada comando en la lista.
For Each cmd As DBCommand In commands
' Obtiene la sentencia SQL para el comando actual.
Dim sqlCommand As String = Connector.GetCommand(DB, cmd.Name)
' <<< INICIO NUEVA VALIDACIÓN: VERIFICAR SI EL COMANDO EXISTE DENTRO DEL BATCH >>>
If sqlCommand = Null Or sqlCommand = "null" Or sqlCommand.Trim = "" Then
con.Rollback ' Deshace la transacción si un comando es inválido.
Dim errorMessage As String = $"El comando '${cmd.Name}' no fue encontrado en el config.properties de '${DB}'."$
Log(errorMessage)
Main.LogServerError("ERROR", "DBHandlerB4X.ExecuteBatch2", errorMessage, DB, cmd.Name, Null)
SendPlainTextError(resp, 400, errorMessage)
Return "error"
End If
' <<< FIN NUEVA VALIDACIÓN >>>
' <<< INICIO VALIDACIÓN DE PARÁMETROS CENTRALIZADA DENTRO DEL BATCH >>>
' Convertimos el array de Object() de cmd.Parameters a una List para la utilidad de validación.
Dim paramsAsList As List
paramsAsList.Initialize
If cmd.Parameters <> Null Then
For Each p As Object In cmd.Parameters
paramsAsList.Add(p)
Next
End If
Dim validationResult As ParameterValidationResult = ParameterValidationUtils.ValidateAndAdjustParameters(cmd.Name, DB, sqlCommand, paramsAsList, Connector.IsParameterToleranceEnabled)
If validationResult.Success = False Then
con.Rollback ' ¡Importante hacer rollback si la validación falla dentro de una transacción!
SendPlainTextError(resp, 400, validationResult.ErrorMessage)
Return "error" ' Salida temprana si la validación falla.
End If
con.ExecNonQuery2(sqlCommand, validationResult.ParamsToExecute) ' Ejecuta el comando con la lista de parámetros validada.
totalAffectedRows = totalAffectedRows + 1 ' Acumulamos 1 por cada comando ejecutado sin error.
' <<< FIN VALIDACIÓN DE PARÁMETROS CENTRALIZADA DENTRO DEL BATCH >>>
Next
res.Rows.Add(Array As Object(totalAffectedRows)) ' Añade una fila simbólica al resultado para indicar éxito.
con.TransactionSuccessful ' Si todos los comandos se ejecutaron sin error, confirma la transacción.
Catch
' Si cualquier comando falla, se captura el error.
con.Rollback ' Se deshacen todos los cambios hechos en la transacción.
Log(LastException) ' Registra la excepción.
Main.LogServerError("ERROR", "DBHandlerB4X.ExecuteBatch2", LastException.Message, DB, "batch_execution_error", Null)
SendPlainTextError(resp, 500, LastException.Message) ' Envía un error 500 al cliente.
End Try
' Serializa y envía la respuesta al cliente.
Dim data() As Byte = ser.ConvertObjectToBytes(res)
resp.OutputStream.WriteBytes(data, 0, data.Length)
' Devuelve un resumen para el log.
' Return $"batch (size=${commands.Size})"$
' Devuelve un resumen para el log, incluyendo el nombre de la query si es un lote de tamaño 1.
If commands.Size = 1 Then
' Obtenemos el único comando en el lote.
Dim cmd As DBCommand = commands.Get(0)
Return $"batch (size=1) - query: ${cmd.Name}"$
Else
' Si el lote es de tamaño > 1, mantenemos el resumen por tamaño.
Return $"batch (size=${commands.Size})"$
End If
End Sub
' --- Subrutinas para manejar la ejecución de queries y batches (Protocolo V1 - Compilación Condicional) ---
' Este código se compila solo si #if VERSION1 está activo, para mantener compatibilidad con clientes antiguos.
'#if VERSION1
' Ejecuta un lote de comandos usando el protocolo V1.
Private Sub ExecuteBatch(DB As String, con As SQL, in As InputStream, resp As ServletResponse) As String
' Log($"ExecuteBatch ${DB}"$)
' Lee y descarta la versión del cliente.
Dim clientVersion As Float = ReadObject(in) 'ignore
' Lee cuántos comandos vienen en el lote.
Dim numberOfStatements As Int = ReadInt(in)
Dim res(numberOfStatements) As Int ' Array para resultados (aunque no se usa).
Dim singleQueryName As String = ""
Dim affectedCounts As List
Dim totalAffectedRows As Int
affectedCounts.Initialize
Try
con.BeginTransaction
' Itera para procesar cada comando del lote.
' Log(numberOfStatements)
For i = 0 To numberOfStatements - 1
' Log($"i: ${i}"$)
' Lee el nombre del comando y la lista de parámetros usando el deserializador V1.
Dim queryName As String = ReadObject(in)
Dim params As List = ReadList(in)
' Log(params)
If numberOfStatements = 1 Then
singleQueryName = queryName 'Capturamos el nombre del query.
End If
Dim sqlCommand As String = Connector.GetCommand(DB, queryName)
' Log(sqlCommand)
' <<< INICIO NUEVA VALIDACIÓN: VERIFICAR SI EL COMANDO EXISTE (V1) >>>
If sqlCommand = Null Or sqlCommand = "null" Or sqlCommand.Trim = "" Then
con.Rollback ' Deshace la transacción si un comando es inválido.
Dim errorMessage As String = $"El comando '${queryName}' no fue encontrado en el config.properties de '${DB}'."$
Log(errorMessage)
Main.LogServerError("ERROR", "DBHandlerB4X.ExecuteBatch (V1)", errorMessage, DB, queryName, Null)
SendPlainTextError(resp, 400, errorMessage)
Return "error"
End If
' <<< FIN NUEVA VALIDACIÓN >>>
' <<< INICIO VALIDACIÓN DE PARÁMETROS CENTRALIZADA DENTRO DEL BATCH (V1) >>>
Dim validationResult As ParameterValidationResult = ParameterValidationUtils.ValidateAndAdjustParameters(queryName, DB, sqlCommand, params, Connector.IsParameterToleranceEnabled)
If validationResult.Success = False Then
con.Rollback ' ¡Importante hacer rollback si la validación falla dentro de una transacción!
SendPlainTextError(resp, 400, validationResult.ErrorMessage)
Return "error" ' Salida temprana si la validación falla.
End If
' Log(validationResult.ParamsToExecute)
Dim affectedCount As Int = 1 ' Asumimos éxito (1) ya que la llamada directa es la única que ejecuta el SQL sin fallar en runtime.
con.ExecNonQuery2(sqlCommand, validationResult.ParamsToExecute) ' Ejecuta el comando con la lista de parámetros validada.
' <<< FIN VALIDACIÓN DE PARÁMETROS CENTRALIZADA DENTRO DEL BATCH (V1) >>>
affectedCounts.Add(affectedCount) ' Añadimos el resultado (1) a la lista de respuesta V1
totalAffectedRows = totalAffectedRows + affectedCount ' Acumulamos el total para el log (aunque sea 1 simbólico)
Next
con.TransactionSuccessful ' Confirma la transacción.
' Log("Transaction succesfull")
Dim out As OutputStream = cs.WrapOutputStream(resp.OutputStream, "gzip") ' Comprime la salida antes de enviarla.
' Escribe la respuesta usando el serializador V1.
WriteObject(Main.VERSION, out)
WriteObject("batch", out)
WriteInt(res.Length, out)
For Each r As Int In affectedCounts
WriteInt(r, out)
Next
out.Close
Catch
con.Rollback
Log(LastException)
Main.LogServerError("ERROR", "DBHandlerB4X.ExecuteBatch (V1)", LastException.Message, DB, "batch_execution_error_v1", Null)
SendPlainTextError(resp, 500, LastException.Message)
End Try
' Return $"batch (size=${numberOfStatements})"$
If numberOfStatements = 1 And singleQueryName <> "" Then
Return $"batch (size=1) - query: ${singleQueryName}"$
Else
Return $"batch (size=${numberOfStatements})"$
End If
End Sub
' Ejecuta una consulta única usando el protocolo V1.
Private Sub ExecuteQuery(DB As String, con As SQL, in As InputStream, resp As ServletResponse) As String
' Log("====================== ExecuteQuery =====================")
' Deserializa los datos de la petición usando el protocolo V1.
Dim clientVersion As Float = ReadObject(in) 'ignore
Dim queryName As String = ReadObject(in)
Dim limit As Int = ReadInt(in)
Dim params As List = ReadList(in)
' Obtiene la sentencia SQL.
Dim theSql As String = Connector.GetCommand(DB, queryName)
' <<< INICIO NUEVA VALIDACIÓN: VERIFICAR SI EL COMANDO EXISTE (V1) >>>
If theSql = Null Or theSql ="null" Or theSql.Trim = "" Then
Dim errorMessage As String = $"El comando '${queryName}' no fue encontrado en el config.properties de '${DB}'."$
Log(errorMessage)
Main.LogServerError("ERROR", "DBHandlerB4X.ExecuteQuery (V1)", errorMessage, DB, queryName, Null)
SendPlainTextError(resp, 400, errorMessage)
Return "error"
End If
' <<< FIN NUEVA VALIDACIÓN >>>
' <<< INICIO VALIDACIÓN DE PARÁMETROS CENTRALIZADA (V1) >>>
Dim validationResult As ParameterValidationResult = ParameterValidationUtils.ValidateAndAdjustParameters(queryName, DB, theSql, params, Connector.IsParameterToleranceEnabled)
If validationResult.Success = False Then
SendPlainTextError(resp, 400, validationResult.ErrorMessage)
Return "error" ' Salida temprana si la validación falla.
End If
' Ejecuta la consulta con la lista de parámetros validada.
Dim rs As ResultSet = con.ExecQuery2(theSql, validationResult.ParamsToExecute)
' <<< FIN VALIDACIÓN DE PARÁMETROS CENTRALIZADA (V1) >>>
If limit <= 0 Then limit = 0x7fffffff 'max int
Dim jrs As JavaObject = rs
Dim rsmd As JavaObject = jrs.RunMethod("getMetaData", Null)
Dim cols As Int = rs.ColumnCount
Dim out As OutputStream = cs.WrapOutputStream(resp.OutputStream, "gzip") ' Comprime el stream de salida.
' Escribe la cabecera de la respuesta V1.
WriteObject(Main.VERSION, out)
WriteObject("query", out)
WriteInt(rs.ColumnCount, out)
' Escribe los nombres de las columnas.
For i = 0 To cols - 1
WriteObject(rs.GetColumnName(i), out)
Next
' Itera sobre las filas del resultado.
Do While rs.NextRow And limit > 0
WriteByte(1, out) ' Escribe un byte '1' para indicar que viene una fila.
' Itera sobre las columnas de la fila.
For i = 0 To cols - 1
Dim ct As Int = rsmd.RunMethod("getColumnType", Array(i + 1))
' Maneja los tipos de datos binarios de forma especial.
If ct = -2 Or ct = 2004 Or ct = -3 Or ct = -4 Then
WriteObject(rs.GetBlob2(i), out)
Else
' Escribe el valor de la columna.
WriteObject(jrs.RunMethod("getObject", Array(i + 1)), out)
End If
Next
limit = limit - 1
Loop
' Escribe un byte '0' para indicar el fin de las filas.
WriteByte(0, out)
out.Close
rs.Close
Return "query: " & queryName
End Sub
' Escribe un único byte en el stream de salida.
Private Sub WriteByte(value As Byte, out As OutputStream)
out.WriteBytes(Array As Byte(value), 0, 1)
End Sub
' Serializador principal para el protocolo V1. Escribe un objeto al stream.
Private Sub WriteObject(o As Object, out As OutputStream)
Dim data() As Byte
' Escribe un byte de tipo seguido de los datos.
If o = Null Then
out.WriteBytes(Array As Byte(T_NULL), 0, 1)
Else If o Is Short Then
out.WriteBytes(Array As Byte(T_SHORT), 0, 1)
data = bc.ShortsToBytes(Array As Short(o))
Else If o Is Int Then
out.WriteBytes(Array As Byte(T_INT), 0, 1)
data = bc.IntsToBytes(Array As Int(o))
Else If o Is Float Then
out.WriteBytes(Array As Byte(T_FLOAT), 0, 1)
data = bc.FloatsToBytes(Array As Float(o))
Else If o Is Double Then
out.WriteBytes(Array As Byte(T_DOUBLE), 0, 1)
data = bc.DoublesToBytes(Array As Double(o))
Else If o Is Long Then
out.WriteBytes(Array As Byte(T_LONG), 0, 1)
data = bc.LongsToBytes(Array As Long(o))
Else If o Is Boolean Then
out.WriteBytes(Array As Byte(T_BOOLEAN), 0, 1)
Dim b As Boolean = o
Dim data(1) As Byte
If b Then data(0) = 1 Else data(0) = 0
Else If GetType(o) = "[B" Then ' Si el objeto es un array de bytes (BLOB)
data = o
out.WriteBytes(Array As Byte(T_BLOB), 0, 1)
' Escribe la longitud de los datos antes de los datos mismos.
WriteInt(data.Length, out)
Else ' Trata todo lo demás como un String
out.WriteBytes(Array As Byte(T_STRING), 0, 1)
data = bc.StringToBytes(o, "UTF8")
' Escribe la longitud del string antes del string.
WriteInt(data.Length, out)
End If
' Escribe los bytes del dato.
If data.Length > 0 Then out.WriteBytes(data, 0, data.Length)
End Sub
' Deserializador principal para el protocolo V1. Lee un objeto del stream.
Private Sub ReadObject(In As InputStream) As Object
' Lee el primer byte para determinar el tipo de dato.
Dim data(1) As Byte
In.ReadBytes(data, 0, 1)
Select data(0)
Case T_NULL
Return Null
Case T_SHORT
Dim data(2) As Byte
Return bc.ShortsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_INT
Dim data(4) As Byte
Return bc.IntsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_LONG
Dim data(8) As Byte
Return bc.LongsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_FLOAT
Dim data(4) As Byte
Return bc.FloatsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_DOUBLE
Dim data(8) As Byte
Return bc.DoublesFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_BOOLEAN
Dim b As Byte = ReadByte(In)
Return b = 1
Case T_BLOB
' Lee la longitud, luego lee esa cantidad de bytes.
Dim len As Int = ReadInt(In)
Dim data(len) As Byte
Return ReadBytesFully(In, data, data.Length)
Case Else ' T_STRING
' Lee la longitud, luego lee esa cantidad de bytes y los convierte a string.
Dim len As Int = ReadInt(In)
Dim data(len) As Byte
ReadBytesFully(In, data, data.Length)
Return BytesToString(data, 0, data.Length, "UTF8")
End Select
End Sub
' Se asegura de leer exactamente la cantidad de bytes solicitada del stream.
Private Sub ReadBytesFully(In As InputStream, Data() As Byte, Len As Int) As Byte()
Dim count = 0, Read As Int
' Sigue leyendo en un bucle hasta llenar el buffer, por si los datos llegan en partes.
Do While count < Len And Read > -1
Read = In.ReadBytes(Data, count, Len - count)
count = count + Read
Loop
Return Data
End Sub
' Escribe un entero (4 bytes) en el stream.
Private Sub WriteInt(i As Int, out As OutputStream)
Dim data() As Byte
data = bc.IntsToBytes(Array As Int(i))
out.WriteBytes(data, 0, data.Length)
End Sub
' Lee un entero (4 bytes) del stream.
Private Sub ReadInt(In As InputStream) As Int
Dim data(4) As Byte
Return bc.IntsFromBytes(ReadBytesFully(In, data, data.Length))(0)
End Sub
' Lee un solo byte del stream.
Private Sub ReadByte(In As InputStream) As Byte
Dim data(1) As Byte
In.ReadBytes(data, 0, 1)
Return data(0)
End Sub
' Lee una lista de objetos del stream (protocolo V1).
Private Sub ReadList(in As InputStream) As List
' Primero lee la cantidad de elementos en la lista.
Dim len As Int = ReadInt(in)
Dim l1 As List
l1.Initialize
' Luego lee cada objeto uno por uno y lo añade a la lista.
For i = 0 To len - 1
l1.Add(ReadObject(in))
Next
Return l1
End Sub
'#end If ' Fin del bloque de compilación condicional para VERSION1
' Envía una respuesta de error en formato de texto plano.
' Esto evita la página de error HTML por defecto que genera resp.SendError.
' resp: El objeto ServletResponse para enviar la respuesta.
' statusCode: El código de estado HTTP (ej. 400 para Bad Request, 500 para Internal Server Error).
' errorMessage: El mensaje de error que se enviará al cliente.
' En los clientes de B4X, una respuesta en HTML o JSON no es lo ideal, el IDE muestra todo el texto del error y texto plano es mucho mas facil de leer que HTML o JSON.
Private Sub SendPlainTextError(resp As ServletResponse, statusCode As Int, errorMessage As String)
Try
' Establece el código de estado HTTP (ej. 400, 500).
resp.Status = statusCode
' Define el tipo de contenido como texto plano, con codificación UTF-8 para soportar acentos.
resp.ContentType = "text/plain; charset=utf-8"
' Obtiene el OutputStream de la respuesta para escribir los datos directamente.
Dim out As OutputStream = resp.OutputStream
' Convierte el mensaje de error a un array de bytes usando UTF-8.
Dim data() As Byte = errorMessage.GetBytes("UTF8")
' Escribe los bytes en el stream de salida.
out.WriteBytes(data, 0, data.Length)
' Cierra el stream para asegurar que todos los datos se envíen correctamente.
out.Close
Catch
' Si algo falla al intentar enviar la respuesta de error, lo registra en el log
' para que no se pierda la causa original del problema.
Dim ErrorMsg As String = "Error sending plain text error response: " & LastException
Log(ErrorMsg)
Main.LogServerError("ERROR", "DBHandlerB4X.SendPlainTextError", ErrorMsg, Null, Null, Null)
End Try
End Sub

View File

@@ -1,609 +0,0 @@
B4J=true
Group=Default Group
ModulesStructureVersion=1
Type=Class
Version=10.3
@EndOfDesignText@
' Handler genérico para peticiones desde clientes B4A/B4i (DBRequestManager)
' Determina la base de datos a utilizar dinámicamente a partir de la URL de la petición.
' Versión con validación de parámetros y errores en texto plano.
Sub Class_Globals
' Estas constantes y variables solo se compilan si se usa la #if VERSION1,
' lo que sugiere que es para dar soporte a una versión antigua del protocolo de comunicación.
' #if VERSION1
' Constantes para identificar los tipos de datos en la serialización personalizada (protocolo V1).
Private const T_NULL = 0, T_STRING = 1, T_SHORT = 2, T_INT = 3, T_LONG = 4, T_FLOAT = 5 _
,T_DOUBLE = 6, T_BOOLEAN = 7, T_BLOB = 8 As Byte
' Utilidades para convertir entre tipos de datos y arrays de bytes.
Private bc As ByteConverter
' Utilidad para comprimir/descomprimir streams de datos (usado en V1).
Private cs As CompressedStreams
' #end if
' Mapa para convertir tipos de columna JDBC de fecha/hora a métodos de obtención de datos.
Private DateTimeMethods As Map
' Objeto que gestiona las conexiones a las diferentes bases de datos definidas en config.properties.
Private Connector As RDCConnector
End Sub
' Se ejecuta una vez cuando se crea una instancia de esta clase.
Public Sub Initialize
' Inicializa el mapa que asocia los códigos de tipo de columna de fecha/hora de JDBC
' con los nombres de los métodos correspondientes para leerlos correctamente.
DateTimeMethods = CreateMap(91: "getDate", 92: "getTime", 93: "getTimestamp")
End Sub
' Método principal que maneja cada petición HTTP que llega a este servlet.
Sub Handle(req As ServletRequest, resp As ServletResponse)
' === INICIO DE LA LÓGICA DINÁMICA ===
' Extrae la URI completa de la petición (ej. /DB1/endpoint).
Dim URI As String = req.RequestURI
' Variable para almacenar la "llave" o identificador de la base de datos (ej. "DB1").
Dim dbKey As String
' Comprueba si la URI tiene contenido y empieza con "/".
If URI.Length > 1 And URI.StartsWith("/") Then
' Extrae la parte de la URI que viene después del primer "/".
dbKey = URI.Substring(1)
' Si la llave contiene más "/", se queda solo con la primera parte.
' Esto permite URLs como /DB1/clientes o /DB2/productos, extrayendo "DB1" o "DB2".
If dbKey.Contains("/") Then
dbKey = dbKey.SubString2(0, dbKey.IndexOf("/"))
End If
Else
' Si la URI está vacía o es "/", usa "DB1" como la base de datos por defecto.
dbKey = "DB1"
End If
' Convierte la llave a mayúsculas para que no sea sensible a mayúsculas/minúsculas (ej. "db1" se convierte en "DB1").
dbKey = dbKey.ToUpperCase
' Verifica si la llave de la base de datos extraída existe en la configuración de conectores.
If Main.Connectors.ContainsKey(dbKey) = False Then
' Si no existe, crea un mensaje de error claro.
Dim ErrorMsg As String = $"Invalid DB key specified in URL: '${dbKey}'. Valid keys are: ${Main.listaDeCP}"$
' Registra el error en el log del servidor.
Log(ErrorMsg)
' Envía una respuesta de error 400 (Bad Request) al cliente en formato de texto plano.
SendPlainTextError(resp, 400, ErrorMsg)
' Termina la ejecución de este método.
Return
End If
' === FIN DE LA LÓGICA DINÁMICA ===
Log("********************* " & dbKey & " ********************")
' Guarda el tiempo de inicio para medir la duración de la petición.
Dim start As Long = DateTime.Now
' Variable para almacenar el nombre del comando SQL a ejecutar.
Dim q As String
' Obtiene el stream de entrada de la petición, que contiene los datos enviados por el cliente.
Dim in As InputStream = req.InputStream
' Obtiene el parámetro "method" de la URL (ej. ?method=query2).
Dim method As String = req.GetParameter("method")
' Obtiene el conector correspondiente a la base de datos seleccionada.
Connector = Main.Connectors.Get(dbKey)
' Declara la variable para la conexión a la base de datos.
Dim con As SQL
Try
' Obtiene una conexión del pool de conexiones.
con = Connector.GetConnection(dbKey)
Log("Metodo: " & method)
' Determina qué función ejecutar basándose en el parámetro "method".
If method = "query2" Then
' Ejecuta una consulta usando el protocolo más nuevo (B4XSerializator).
q = ExecuteQuery2(dbKey, con, in, resp)
'#if VERSION1
Else if method = "query" Then
' Protocolo antiguo: descomprime el stream y ejecuta la consulta.
in = cs.WrapInputStream(in, "gzip")
q = ExecuteQuery(dbKey, con, in, resp)
Else if method = "batch" Then
' Protocolo antiguo: descomprime el stream y ejecuta un lote de comandos.
in = cs.WrapInputStream(in, "gzip")
q = ExecuteBatch(dbKey, con, in, resp)
'#end if
Else if method = "batch2" Then
' Ejecuta un lote de comandos usando el protocolo más nuevo.
q = ExecuteBatch2(dbKey, con, in, resp)
Else
' Si el método es desconocido, lo registra y envía un error.
Log("Unknown method: " & method)
SendPlainTextError(resp, 500, "unknown method")
End If
Catch
' Si ocurre cualquier error en el bloque Try, lo captura.
Log(LastException)
' Envía un error 500 (Internal Server Error) al cliente con el mensaje de la excepción.
SendPlainTextError(resp, 500, LastException.Message)
End Try
' Asegura que la conexión a la BD se cierre y se devuelva al pool.
If con <> Null And con.IsInitialized Then con.Close
' Registra en el log el comando ejecutado, cuánto tiempo tardó y la IP del cliente.
Log($"Command: ${q}, took: ${DateTime.Now - start}ms, client=${req.RemoteAddress}"$)
End Sub
' Ejecuta una consulta única usando el protocolo V2 (B4XSerializator).
Private Sub ExecuteQuery2 (DB As String, con As SQL, in As InputStream, resp As ServletResponse) As String
' Objeto para deserializar los datos enviados desde el cliente.
Dim ser As B4XSerializator
' Convierte el stream de entrada a un array de bytes y luego a un objeto Mapa.
Dim m As Map = ser.ConvertBytesToObject(Bit.InputStreamToBytes(in))
' Extrae el objeto DBCommand del mapa.
Dim cmd As DBCommand = m.Get("command")
' Extrae el límite de filas a devolver.
Dim limit As Int = m.Get("limit")
' Obtiene la sentencia SQL correspondiente al nombre del comando desde config.properties.
Dim sqlCommand As String = Connector.GetCommand(DB, cmd.Name)
' <<< INICIO NUEVA VALIDACIÓN: VERIFICAR SI EL COMANDO EXISTE >>>
' Comprueba si el comando no fue encontrado en el archivo de configuración.
If sqlCommand = Null Or sqlCommand = "null" Or sqlCommand.Trim = "" Then
Dim errorMessage As String = $"El comando '${cmd.Name}' no fue encontrado en el config.properties de '${DB}'."$
Log(errorMessage)
' Envía un error 400 (Bad Request) al cliente informando del problema.
SendPlainTextError(resp, 400, errorMessage)
Return "error" ' Retorna un texto para el log.
End If
' <<< FIN NUEVA VALIDACIÓN >>>
' --- INICIO VALIDACIÓN DE PARÁMETROS ---
' Comprueba si el SQL espera parámetros o si se recibieron parámetros.
If sqlCommand.Contains("?") Or (cmd.Parameters <> Null And cmd.Parameters.Length > 0) Then
' Cuenta cuántos '?' hay en la sentencia SQL para saber cuántos parámetros se esperan.
Dim expectedParams As Int = sqlCommand.Length - sqlCommand.Replace("?", "").Length
' Cuenta cuántos parámetros se recibieron.
Dim receivedParams As Int
If cmd.Parameters = Null Then receivedParams = 0 Else receivedParams = cmd.Parameters.Length
' Compara el número de parámetros esperados con los recibidos.
If expectedParams <> receivedParams Then
Dim errorMessage As String = $"Número de parametros equivocado para "${cmd.Name}". Se esperaban ${expectedParams} y se recibieron ${receivedParams}."$
Log(errorMessage)
' Si no coinciden, envía un error 400 al cliente.
SendPlainTextError(resp, 400, errorMessage)
Return "error"
End If
End If
' --- FIN VALIDACIÓN ---
' Ejecuta la consulta SQL con los parámetros proporcionados.
Dim rs As ResultSet = con.ExecQuery2(sqlCommand, cmd.Parameters)
' Si el límite es 0 o negativo, lo establece a un valor muy alto (máximo entero).
If limit <= 0 Then limit = 0x7fffffff 'max int
' Obtiene el objeto Java subyacente del ResultSet para acceder a métodos adicionales.
Dim jrs As JavaObject = rs
' Obtiene los metadatos del ResultSet (información sobre las columnas).
Dim rsmd As JavaObject = jrs.RunMethod("getMetaData", Null)
' Obtiene el número de columnas del resultado.
Dim cols As Int = rs.ColumnCount
' Crea un objeto DBResult para empaquetar la respuesta.
Dim res As DBResult
res.Initialize
res.columns.Initialize
res.Tag = Null
' Llena el mapa de columnas con el nombre de cada columna y su índice.
For i = 0 To cols - 1
res.columns.Put(rs.GetColumnName(i), i)
Next
' Inicializa la lista de filas.
res.Rows.Initialize
' Itera sobre cada fila del ResultSet, hasta llegar al límite.
Do While rs.NextRow And limit > 0
Dim row(cols) As Object
' Itera sobre cada columna de la fila actual.
For i = 0 To cols - 1
' Obtiene el tipo de dato de la columna según JDBC.
Dim ct As Int = rsmd.RunMethod("getColumnType", Array(i + 1))
' Maneja diferentes tipos de datos para leerlos de la forma correcta.
If ct = -2 Or ct = 2004 Or ct = -3 Or ct = -4 Then ' Tipos BLOB/binarios
row(i) = rs.GetBlob2(i)
Else If ct = 2005 Then ' Tipo CLOB (texto largo)
row(i) = rs.GetString2(i)
Else if ct = 2 Or ct = 3 Then ' Tipos numéricos que pueden tener decimales
row(i) = rs.GetDouble2(i)
Else If DateTimeMethods.ContainsKey(ct) Then ' Tipos de Fecha/Hora
' Obtiene el objeto de tiempo/fecha de Java.
Dim SQLTime As JavaObject = jrs.RunMethodJO(DateTimeMethods.Get(ct), Array(i + 1))
If SQLTime.IsInitialized Then
' Lo convierte a milisegundos (Long) para B4X.
row(i) = SQLTime.RunMethod("getTime", Null)
Else
row(i) = Null
End If
Else ' Para todos los demás tipos de datos
' Usa getObject que funciona para la mayoría de los tipos estándar.
row(i) = jrs.RunMethod("getObject", Array(i + 1))
End If
Next
' Añade la fila completa a la lista de resultados.
res.Rows.Add(row)
limit = limit - 1
Loop
' Cierra el ResultSet para liberar recursos.
rs.Close
' Serializa el objeto DBResult completo a un array de bytes.
Dim data() As Byte = ser.ConvertObjectToBytes(res)
' Escribe los datos serializados en el stream de respuesta.
resp.OutputStream.WriteBytes(data, 0, data.Length)
' Devuelve el nombre del comando para el log.
Return "query: " & cmd.Name
End Sub
' Ejecuta un lote de comandos (INSERT, UPDATE, DELETE) usando el protocolo V2.
Private Sub ExecuteBatch2(DB As String, con As SQL, in As InputStream, resp As ServletResponse) As String
Dim ser As B4XSerializator
' Deserializa el mapa que contiene la lista de comandos.
Dim m As Map = ser.ConvertBytesToObject(Bit.InputStreamToBytes(in))
' Obtiene la lista de objetos DBCommand.
Dim commands As List = m.Get("commands")
' Prepara un objeto DBResult para la respuesta (aunque para batch no devuelve datos, solo confirmación).
Dim res As DBResult
res.Initialize
res.columns = CreateMap("AffectedRows (N/A)": 0)
res.Rows.Initialize
res.Tag = Null
Try
' Inicia una transacción. Todos los comandos del lote se ejecutarán como una unidad.
con.BeginTransaction
' Itera sobre cada comando en la lista.
For Each cmd As DBCommand In commands
' Obtiene la sentencia SQL para el comando actual.
Dim sqlCommand As String = Connector.GetCommand(DB, cmd.Name)
' <<< INICIO NUEVA VALIDACIÓN: VERIFICAR SI EL COMANDO EXISTE DENTRO DEL BATCH >>>
If sqlCommand = Null Or sqlCommand = "null" Or sqlCommand.Trim = "" Then
con.Rollback ' Deshace la transacción si un comando es inválido.
Dim errorMessage As String = $"El comando '${cmd.Name}' no fue encontrado en el config.properties de '${DB}'."$
Log(errorMessage)
SendPlainTextError(resp, 400, errorMessage)
Return "error"
End If
' <<< FIN NUEVA VALIDACIÓN >>>
' --- INICIO VALIDACIÓN DE PARÁMETROS DENTRO DEL BATCH ---
If sqlCommand.Contains("?") Or (cmd.Parameters <> Null And cmd.Parameters.Length > 0) Then
Dim expectedParams As Int = sqlCommand.Length - sqlCommand.Replace("?", "").Length
Dim receivedParams As Int
If cmd.Parameters = Null Then receivedParams = 0 Else receivedParams = cmd.Parameters.Length
' Si el número de parámetros no coincide, deshace la transacción y envía error.
If expectedParams <> receivedParams Then
con.Rollback
Dim errorMessage As String = $"Número de parametros equivocado para "${cmd.Name}". Se esperaban ${expectedParams} y se recibieron ${receivedParams}."$
Log(errorMessage)
SendPlainTextError(resp, 400, errorMessage)
Return "error"
End If
End If
' --- FIN VALIDACIÓN ---
' Ejecuta el comando (no es una consulta, no devuelve filas).
con.ExecNonQuery2(sqlCommand, cmd.Parameters)
Next
' Añade una fila simbólica al resultado para indicar éxito.
res.Rows.Add(Array As Object(0))
' Si todos los comandos se ejecutaron sin error, confirma la transacción.
con.TransactionSuccessful
Catch
' Si cualquier comando falla, se captura el error.
con.Rollback ' Se deshacen todos los cambios hechos en la transacción.
Log(LastException)
SendPlainTextError(resp, 500, LastException.Message)
End Try
' Serializa y envía la respuesta al cliente.
Dim data() As Byte = ser.ConvertObjectToBytes(res)
resp.OutputStream.WriteBytes(data, 0, data.Length)
' Devuelve un resumen para el log.
Return $"batch (size=${commands.Size})"$
End Sub
' Código compilado condicionalmente para el protocolo antiguo (V1).
'#if VERSION1
' Ejecuta un lote de comandos usando el protocolo V1.
Private Sub ExecuteBatch(DB As String, con As SQL, in As InputStream, resp As ServletResponse) As String
' Lee y descarta la versión del cliente.
Dim clientVersion As Float = ReadObject(in) 'ignore
' Lee cuántos comandos vienen en el lote.
Dim numberOfStatements As Int = ReadInt(in)
Dim res(numberOfStatements) As Int ' Array para resultados (aunque no se usa).
Try
con.BeginTransaction
' Itera para procesar cada comando del lote.
For i = 0 To numberOfStatements - 1
' Lee el nombre del comando y la lista de parámetros usando el deserializador V1.
Dim queryName As String = ReadObject(in)
Dim params As List = ReadList(in)
Dim sqlCommand As String = Connector.GetCommand(DB, queryName)
' <<< INICIO NUEVA VALIDACIÓN: VERIFICAR SI EL COMANDO EXISTE (V1) >>>
If sqlCommand = Null Or sqlCommand = "null" Or sqlCommand.Trim = "" Then
con.Rollback
Dim errorMessage As String = $"El comando '${queryName}' no fue encontrado en el config.properties de '${DB}'."$
Log(errorMessage)
SendPlainTextError(resp, 400, errorMessage)
Return "error"
End If
' <<< FIN NUEVA VALIDACIÓN >>>
' --- INICIO VALIDACIÓN DE PARÁMETROS DENTRO DEL BATCH (V1) ---
If sqlCommand.Contains("?") Or (params <> Null And params.Size > 0) Then
Dim expectedParams As Int = sqlCommand.Length - sqlCommand.Replace("?", "").Length
Dim receivedParams As Int
If params = Null Then receivedParams = 0 Else receivedParams = params.Size
If expectedParams <> receivedParams Then
con.Rollback
Dim errorMessage As String = $"Número de parametros equivocado para "${queryName}". Se esperaban ${expectedParams} y se recibieron ${receivedParams}."$
Log(errorMessage)
SendPlainTextError(resp, 400, errorMessage)
Return "error"
End If
End If
' --- FIN VALIDACIÓN ---
' Ejecuta el comando.
con.ExecNonQuery2(sqlCommand, params)
Next
' Confirma la transacción.
con.TransactionSuccessful
' Comprime la salida antes de enviarla.
Dim out As OutputStream = cs.WrapOutputStream(resp.OutputStream, "gzip")
' Escribe la respuesta usando el serializador V1.
WriteObject(Main.VERSION, out)
WriteObject("batch", out)
WriteInt(res.Length, out)
For Each r As Int In res
WriteInt(r, out)
Next
out.Close
Catch
con.Rollback
Log(LastException)
SendPlainTextError(resp, 500, LastException.Message)
End Try
Return $"batch (size=${numberOfStatements})"$
End Sub
' Ejecuta una consulta única usando el protocolo V1.
Private Sub ExecuteQuery(DB As String, con As SQL, in As InputStream, resp As ServletResponse) As String
Log("====================== ExecuteQuery =====================")
' Deserializa los datos de la petición usando el protocolo V1.
Dim clientVersion As Float = ReadObject(in) 'ignore
Dim queryName As String = ReadObject(in)
Dim limit As Int = ReadInt(in)
Dim params As List = ReadList(in)
' Obtiene la sentencia SQL.
Dim theSql As String = Connector.GetCommand(DB, queryName)
' Log(444 & "|" & theSql)
' <<< INICIO NUEVA VALIDACIÓN: VERIFICAR SI EL COMANDO EXISTE (V1) >>>
If theSql = Null Or theSql ="null" Or theSql.Trim = "" Then
Dim errorMessage As String = $"El comando '${queryName}' no fue encontrado en el config.properties de '${DB}'."$
Log(errorMessage)
SendPlainTextError(resp, 400, errorMessage)
Return "error"
End If
' <<< FIN NUEVA VALIDACIÓN >>>
' --- INICIO VALIDACIÓN DE PARÁMETROS (V1) ---
If theSql.Contains("?") Or (params <> Null And params.Size > 0) Then
Dim expectedParams As Int = theSql.Length - theSql.Replace("?", "").Length
Dim receivedParams As Int
If params = Null Then receivedParams = 0 Else receivedParams = params.Size
If expectedParams <> receivedParams Then
Dim errorMessage As String = $"Número de parametros equivocado para "${queryName}". Se esperaban ${expectedParams} y se recibieron ${receivedParams}."$
Log(errorMessage)
SendPlainTextError(resp, 400, errorMessage)
Return "error"
End If
End If
' --- FIN VALIDACIÓN ---
' Ejecuta la consulta.
Dim rs As ResultSet = con.ExecQuery2(theSql, params)
If limit <= 0 Then limit = 0x7fffffff 'max int
Dim jrs As JavaObject = rs
Dim rsmd As JavaObject = jrs.RunMethod("getMetaData", Null)
Dim cols As Int = rs.ColumnCount
' Comprime el stream de salida.
Dim out As OutputStream = cs.WrapOutputStream(resp.OutputStream, "gzip")
' Escribe la cabecera de la respuesta V1.
WriteObject(Main.VERSION, out)
WriteObject("query", out)
WriteInt(rs.ColumnCount, out)
' Escribe los nombres de las columnas.
For i = 0 To cols - 1
WriteObject(rs.GetColumnName(i), out)
Next
' Itera sobre las filas del resultado.
Do While rs.NextRow And limit > 0
' Escribe un byte '1' para indicar que viene una fila.
WriteByte(1, out)
' Itera sobre las columnas de la fila.
For i = 0 To cols - 1
Dim ct As Int = rsmd.RunMethod("getColumnType", Array(i + 1))
' Maneja los tipos de datos binarios de forma especial.
If ct = -2 Or ct = 2004 Or ct = -3 Or ct = -4 Then
WriteObject(rs.GetBlob2(i), out)
Else
' Escribe el valor de la columna.
WriteObject(jrs.RunMethod("getObject", Array(i + 1)), out)
End If
Next
limit = limit - 1
Loop
' Escribe un byte '0' para indicar el fin de las filas.
WriteByte(0, out)
out.Close
rs.Close
Return "query: " & queryName
End Sub
' Escribe un único byte en el stream de salida.
Private Sub WriteByte(value As Byte, out As OutputStream)
out.WriteBytes(Array As Byte(value), 0, 1)
End Sub
' Serializador principal para el protocolo V1. Escribe un objeto al stream.
Private Sub WriteObject(o As Object, out As OutputStream)
Dim data() As Byte
' Escribe un byte de tipo seguido de los datos.
If o = Null Then
out.WriteBytes(Array As Byte(T_NULL), 0, 1)
Else If o Is Short Then
out.WriteBytes(Array As Byte(T_SHORT), 0, 1)
data = bc.ShortsToBytes(Array As Short(o))
Else If o Is Int Then
out.WriteBytes(Array As Byte(T_INT), 0, 1)
data = bc.IntsToBytes(Array As Int(o))
Else If o Is Float Then
out.WriteBytes(Array As Byte(T_FLOAT), 0, 1)
data = bc.FloatsToBytes(Array As Float(o))
Else If o Is Double Then
out.WriteBytes(Array As Byte(T_DOUBLE), 0, 1)
data = bc.DoublesToBytes(Array As Double(o))
Else If o Is Long Then
out.WriteBytes(Array As Byte(T_LONG), 0, 1)
data = bc.LongsToBytes(Array As Long(o))
Else If o Is Boolean Then
out.WriteBytes(Array As Byte(T_BOOLEAN), 0, 1)
Dim b As Boolean = o
Dim data(1) As Byte
If b Then data(0) = 1 Else data(0) = 0
Else If GetType(o) = "[B" Then ' Si el objeto es un array de bytes (BLOB)
data = o
out.WriteBytes(Array As Byte(T_BLOB), 0, 1)
' Escribe la longitud de los datos antes de los datos mismos.
WriteInt(data.Length, out)
Else ' Trata todo lo demás como un String
out.WriteBytes(Array As Byte(T_STRING), 0, 1)
data = bc.StringToBytes(o, "UTF8")
' Escribe la longitud del string antes del string.
WriteInt(data.Length, out)
End If
' Escribe los bytes del dato.
If data.Length > 0 Then out.WriteBytes(data, 0, data.Length)
End Sub
' Deserializador principal para el protocolo V1. Lee un objeto del stream.
Private Sub ReadObject(In As InputStream) As Object
' Lee el primer byte para determinar el tipo de dato.
Dim data(1) As Byte
In.ReadBytes(data, 0, 1)
Select data(0)
Case T_NULL
Return Null
Case T_SHORT
Dim data(2) As Byte
Return bc.ShortsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_INT
Dim data(4) As Byte
Return bc.IntsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_LONG
Dim data(8) As Byte
Return bc.LongsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_FLOAT
Dim data(4) As Byte
Return bc.FloatsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_DOUBLE
Dim data(8) As Byte
Return bc.DoublesFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_BOOLEAN
Dim b As Byte = ReadByte(In)
Return b = 1
Case T_BLOB
' Lee la longitud, luego lee esa cantidad de bytes.
Dim len As Int = ReadInt(In)
Dim data(len) As Byte
Return ReadBytesFully(In, data, data.Length)
Case Else ' T_STRING
' Lee la longitud, luego lee esa cantidad de bytes y los convierte a string.
Dim len As Int = ReadInt(In)
Dim data(len) As Byte
ReadBytesFully(In, data, data.Length)
Return BytesToString(data, 0, data.Length, "UTF8")
End Select
End Sub
' Se asegura de leer exactamente la cantidad de bytes solicitada del stream.
Private Sub ReadBytesFully(In As InputStream, Data() As Byte, Len As Int) As Byte()
Dim count = 0, Read As Int
' Sigue leyendo en un bucle hasta llenar el buffer, por si los datos llegan en partes.
Do While count < Len And Read > -1
Read = In.ReadBytes(Data, count, Len - count)
count = count + Read
Loop
Return Data
End Sub
' Escribe un entero (4 bytes) en el stream.
Private Sub WriteInt(i As Int, out As OutputStream)
Dim data() As Byte
data = bc.IntsToBytes(Array As Int(i))
out.WriteBytes(data, 0, data.Length)
End Sub
' Lee un entero (4 bytes) del stream.
Private Sub ReadInt(In As InputStream) As Int
Dim data(4) As Byte
Return bc.IntsFromBytes(ReadBytesFully(In, data, data.Length))(0)
End Sub
' Lee un solo byte del stream.
Private Sub ReadByte(In As InputStream) As Byte
Dim data(1) As Byte
In.ReadBytes(data, 0, 1)
Return data(0)
End Sub
' Lee una lista de objetos del stream (protocolo V1).
Private Sub ReadList(in As InputStream) As List
' Primero lee la cantidad de elementos en la lista.
Dim len As Int = ReadInt(in)
Dim l1 As List
l1.Initialize
' Luego lee cada objeto uno por uno y lo añade a la lista.
For i = 0 To len - 1
l1.Add(ReadObject(in))
Next
Return l1
End Sub
'#end If
' Envía una respuesta de error en formato de texto plano.
' Esto evita la página de error HTML por defecto que genera resp.SendError.
' resp: El objeto ServletResponse para enviar la respuesta.
' statusCode: El código de estado HTTP (ej. 400 para Bad Request, 500 para Internal Server Error).
' errorMessage: El mensaje de error que se enviará al cliente.
Private Sub SendPlainTextError(resp As ServletResponse, statusCode As Int, errorMessage As String)
Try
' Establece el código de estado HTTP (ej. 400, 500).
resp.Status = statusCode
' Define el tipo de contenido como texto plano, con codificación UTF-8 para soportar acentos.
resp.ContentType = "text/plain; charset=utf-8"
' Obtiene el OutputStream de la respuesta para escribir los datos directamente.
Dim out As OutputStream = resp.OutputStream
' Convierte el mensaje de error a un array de bytes usando UTF-8.
Dim data() As Byte = errorMessage.GetBytes("UTF8")
' Escribe los bytes en el stream de salida.
out.WriteBytes(data, 0, data.Length)
' Cierra el stream para asegurar que todos los datos se envíen correctamente.
out.Close
Catch
' Si algo falla al intentar enviar la respuesta de error, lo registra en el log
' para que no se pierda la causa original del problema.
Log("Error sending plain text error response: " & LastException)
End Try
End Sub

View File

@@ -4,243 +4,282 @@ ModulesStructureVersion=1
Type=Class Type=Class
Version=10.3 Version=10.3
@EndOfDesignText@ @EndOfDesignText@
' Handler class for JSON requests from Web Clients (JavaScript/axios) ' Módulo de clase: DBHandlerJSON
' VERSIÓN 16 (Comentarios y Mensajes en Español): ' Este handler se encarga de procesar las peticiones HTTP que esperan o envían datos en formato JSON.
' - Se añaden comentarios detallados a la versión con mensajes de error en español. ' Es ideal para clientes web (JavaScript, axios, etc.) o servicios que interactúan con el servidor
' - Revisa que el 'query' exista en config.properties antes de continuar. ' mediante un API RESTful. Soporta tanto GET con JSON en un parámetro 'j' como POST con JSON
' - Asegura que la conexión a la BD se cierre en todos los 'Return' para evitar fugas. ' en el cuerpo de la petición.
Sub Class_Globals Sub Class_Globals
' Declara una variable privada para mantener una instancia del conector RDC. ' Declara una variable privada para mantener una instancia del conector RDC.
' Este objeto maneja la comunicación con la base de datos. ' Este objeto maneja la comunicación con la base de datos específica de la petición.
Private Connector As RDCConnector Private Connector As RDCConnector
End Sub End Sub
' Subrutina de inicialización de la clase. Se llama cuando se crea un objeto de esta clase. ' Subrutina de inicialización de la clase. Se llama cuando se crea un objeto de esta clase.
' En este caso, no se necesita ninguna inicialización específica.
Public Sub Initialize Public Sub Initialize
' No se requiere inicialización específica para esta clase en este momento.
End Sub End Sub
' Este es el método principal que maneja las peticiones HTTP entrantes (req) y prepara la respuesta (resp). ' Este es el método principal que maneja las peticiones HTTP entrantes (req) y prepara la respuesta (resp).
Sub Handle(req As ServletRequest, resp As ServletResponse) Sub Handle(req As ServletRequest, resp As ServletResponse)
Log("============== DB1JsonHandler ==============")
' --- Headers CORS (Cross-Origin Resource Sharing) --- ' --- Headers CORS (Cross-Origin Resource Sharing) ---
' Estos encabezados son necesarios para permitir que un cliente web (ej. una página con JavaScript) ' Estos encabezados son esenciales para permitir que aplicaciones web (clientes)
' que se encuentra en un dominio diferente pueda hacer peticiones a este servidor. ' alojadas en diferentes dominios puedan comunicarse con este servidor.
resp.SetHeader("Access-Control-Allow-Origin", "*") ' Permite peticiones desde cualquier origen. resp.SetHeader("Access-Control-Allow-Origin", "*") ' Permite peticiones desde cualquier origen.
resp.SetHeader("Access-Control-Allow-Methods", "GET, POST, OPTIONS") ' Métodos HTTP permitidos. resp.SetHeader("Access-Control-Allow-Methods", "GET, POST, OPTIONS") ' Métodos HTTP permitidos.
resp.SetHeader("Access-Control-Allow-Headers", "Content-Type") ' Encabezados permitidos en la petición. resp.SetHeader("Access-Control-Allow-Headers", "Content-Type") ' Encabezados permitidos.
' El método OPTIONS es una "petición de comprobación previa" (preflight request) que envían los navegadores ' Las peticiones OPTIONS son pre-vuelos de CORS y no deben procesar lógica de negocio ni contadores.
' para verificar los permisos CORS antes de enviar la petición real (ej. POST). If req.Method = "OPTIONS" Then
' Si es una petición OPTIONS, simplemente terminamos la ejecución sin procesar nada más. Return ' Salimos directamente para estas peticiones.
If req.Method = "OPTIONS" Then Return End If
' Establece "DB1" como el nombre de la base de datos por defecto. Dim start As Long = DateTime.Now ' Registra el tiempo de inicio de la petición para calcular la duración.
Dim DB As String = "DB1"
' Obtiene el objeto conector para la base de datos por defecto desde el objeto Main.
Connector = Main.Connectors.Get(DB)
' Declara una variable para la conexión SQL.
Dim con As SQL
' Inicia un bloque Try...Catch para manejar posibles errores durante la ejecución. ' Declaraciones de variables con alcance en toda la subrutina para asegurar la limpieza final.
Try Dim con As SQL ' La conexión a la BD, se inicializará más tarde.
' Obtiene el valor del parámetro 'j' de la petición. Se espera que contenga una cadena JSON. Dim queryNameForLog As String = "unknown_json_command" ' Nombre del comando para el log, con valor por defecto.
Dim jsonString As String = req.GetParameter("j") Dim duration As Long ' La duración total de la petición, calculada antes del log.
' Verifica si el parámetro 'j' es nulo o está vacío. Dim poolBusyConnectionsForLog As Int = 0 ' Contiene el número de conexiones ocupadas del pool.
Dim finalDbKey As String = "DB1" ' Identificador de la base de datos, con valor por defecto "DB1".
Dim requestsBeforeDecrement As Int = 0 ' Contador de peticiones activas antes de decrementar, inicializado en 0.
Dim Total As Int = 0
Try ' --- INICIO: Bloque Try que envuelve la lógica principal del Handler ---
Dim jsonString As String
' <<<< INICIO: Lógica para manejar peticiones POST con JSON en el cuerpo >>>>
If req.Method = "POST" And req.ContentType.Contains("application/json") Then
' Si es un POST con JSON en el cuerpo, leemos directamente del InputStream.
Dim Is0 As InputStream = req.InputStream
Dim bytes() As Byte = Bit.InputStreamToBytes(Is0) ' Lee el cuerpo completo de la petición.
jsonString = BytesToString(bytes, 0, bytes.Length, "UTF8") ' Convierte los bytes a una cadena JSON.
Is0.Close ' Cierra explícitamente el InputStream para liberar recursos.
Else
' De lo contrario, asumimos que el JSON viene en el parámetro 'j' de la URL (método legacy/GET).
jsonString = req.GetParameter("j")
End If
' <<<< FIN: Lógica para manejar peticiones POST con JSON en el cuerpo >>>>
' Validación inicial: Si no hay JSON, se envía un error 400.
If jsonString = Null Or jsonString = "" Then If jsonString = Null Or jsonString = "" Then
' Si falta el parámetro, envía una respuesta de error 400 (Bad Request) y termina la ejecución. Dim ErrorMsg As String = "Falta el parámetro 'j' en el URL o el cuerpo JSON en la petición."
SendErrorResponse(resp, 400, "Falta el parametro 'j' en el URL") SendErrorResponse(resp, 400, ErrorMsg)
Main.LogServerError("ERROR", "DBHandlerJSON.Handle", ErrorMsg, finalDbKey, queryNameForLog, req.RemoteAddress) ' <-- Nuevo Log
duration = DateTime.Now - start
CleanupAndLog(finalDbKey, queryNameForLog, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con)
Return Return
End If End If
' Crea un objeto JSONParser para analizar la cadena JSON.
Dim parser As JSONParser Dim parser As JSONParser
parser.Initialize(jsonString) parser.Initialize(jsonString) ' Inicializa el parser JSON con la cadena recibida.
' Convierte la cadena JSON en un objeto Map, que es como un diccionario (clave-valor). Dim RootMap As Map = parser.NextObject ' Parsea el JSON a un objeto Map.
Dim RootMap As Map = parser.NextObject
' Extrae los datos necesarios del JSON. Dim execType As String = RootMap.GetDefault("exec", "") ' Obtiene el tipo de ejecución (ej. "ExecuteQuery").
Dim execType As String = RootMap.GetDefault("exec", "") ' Tipo de ejecución: "executeQuery" o "executeCommand".
Dim queryName As String = RootMap.Get("query") ' Nombre del comando SQL (definido en config.properties). ' Obtiene el nombre de la query. Si no está en "query", busca en "exec".
Dim paramsMap As Map = RootMap.Get("params") ' Un mapa con los parámetros para la consulta. queryNameForLog = RootMap.GetDefault("query", "")
' Log(RootMap) If queryNameForLog = "" Then queryNameForLog = RootMap.GetDefault("exec", "unknown_json_command")
' Verifica si en el JSON se especificó un nombre de base de datos diferente con la clave "dbx".
If RootMap.Get("dbx") <> Null Then DB = RootMap.Get("dbx") ' Si se especifica, usamos la BD indicada, si no, se queda "DB1".
' Valida que el nombre de la base de datos (DB) exista en la lista de conexiones configuradas en Main. Dim paramsList As List = RootMap.Get("params") ' Obtiene la lista de parámetros para la query.
If Main.listaDeCP.IndexOf(DB) = -1 Then If paramsList = Null Or paramsList.IsInitialized = False Then
SendErrorResponse(resp, 400, "Parametro 'DB' invalido. El nombre '" & DB & "' no es válido.") paramsList.Initialize ' Si no hay parámetros, inicializa una lista vacía.
' Se añade Return para detener la ejecución si la BD no es válida. End If
' <<<< ¡CORRECCIÓN CLAVE: RESOLVEMOS finalDbKey del JSON ANTES de usarla para los contadores! >>>>
' Esto asegura que el contador y el conector usen la DB correcta.
If RootMap.Get("dbx") <> Null Then finalDbKey = RootMap.Get("dbx")
' <<<< ¡FIN DE CORRECCIÓN CLAVE! >>>>
' --- INICIO: Conteo de peticiones activas para esta finalDbKey (Incrementar) ---
' Este bloque incrementa un contador global que rastrea cuántas peticiones están
' activas para una base de datos específica en un momento dado.
' 1. Aseguramos que el valor inicial sea un Int y lo recuperamos como Int (usando .As(Int)).
Dim currentCountFromMap As Int = GlobalParameters.ActiveRequestsCountByDB.GetDefault(finalDbKey, 0).As(Int)
GlobalParameters.ActiveRequestsCountByDB.Put(finalDbKey, currentCountFromMap + 1)
' requestsBeforeDecrement es el valor del contador justo después de que esta petición lo incrementa.
' Este es el valor que se registrará en la tabla 'query_logs'.
requestsBeforeDecrement = currentCountFromMap + 1
' Los logs de depuración para el incremento del contador pueden ser descomentados para una depuración profunda.
' Log($"[DEBUG] Handle Increment (JSON): dbKey=${finalDbKey}, currentCountFromMap=${currentCountFromMap}, requestsBeforeDecrement=${requestsBeforeDecrement}, Map state: ${GlobalParameters.ActiveRequestsCountByDB}"$)
' --- FIN: Conteo de peticiones activas ---
' Inicializa el Connector con la finalDbKey resuelta.
Connector = Main.Connectors.Get(finalDbKey)
' Validación: Si el dbKey no es válido o no está configurado en Main.listaDeCP.
If Main.listaDeCP.IndexOf(finalDbKey) = -1 Then
Dim ErrorMsg As String = "Parámetro 'DB' inválido. El nombre '" & finalDbKey & "' no es válido."
SendErrorResponse(resp, 400, ErrorMsg)
Main.LogServerError("ERROR", "DBHandlerJSON.Handle", ErrorMsg, finalDbKey, queryNameForLog, req.RemoteAddress) ' <-- Nuevo Log
duration = DateTime.Now - start
CleanupAndLog(finalDbKey, queryNameForLog, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con)
Return Return
End If End If
' Prepara una lista para almacenar las claves de los parámetros. con = Connector.GetConnection(finalDbKey) ' ¡La conexión a la BD se obtiene aquí del pool de conexiones!
Dim paramKeys As List
paramKeys.Initialize ' <<<< ¡CAPTURAMOS BUSY_CONNECTIONS INMEDIATAMENTE DESPUÉS DE OBTENER LA CONEXIÓN! >>>>
' Si el mapa de parámetros existe y está inicializado... ' Este bloque captura el número de conexiones actualmente ocupadas en el pool
If paramsMap <> Null And paramsMap.IsInitialized Then ' *después* de que esta petición ha obtenido la suya.
' ...itera sobre todas las claves y las añade a la lista 'paramKeys'. If Connector.IsInitialized Then
For Each key As String In paramsMap.Keys Dim poolStats As Map = Connector.GetPoolStats
paramKeys.Add(key) If poolStats.ContainsKey("BusyConnections") Then
Next ' <<<< ¡CORRECCIÓN CLAVE: Aseguramos que el valor sea Int! >>>>
poolBusyConnectionsForLog = poolStats.Get("BusyConnections").As(Int) ' Capturamos el valor.
' Log($">>>>>>>>>> ${poolStats.Get("BusyConnections")} "$)
End If
End If End If
' Ordena las claves alfabéticamente. Esto es crucial para asegurar que los parámetros ' <<<< ¡FIN DE CAPTURA! >>>>
' se pasen a la consulta SQL en un orden consistente y predecible.
paramKeys.Sort(True) Dim cachedStatsJSON As Map = Main.LatestPoolStats.Get(finalDbKey).As(Map)
' Prepara una lista para almacenar los valores de los parámetros en el orden correcto. If cachedStatsJSON.IsInitialized Then
Dim orderedParams As List ' Los valores ya fueron capturados: poolBusyConnectionsForLog y requestsBeforeDecrement
orderedParams.Initialize cachedStatsJSON.Put("BusyConnections", poolBusyConnectionsForLog)
' Itera sobre la lista de claves ya ordenada. cachedStatsJSON.Put("HandlerActiveRequests", requestsBeforeDecrement)
For Each key As String In paramKeys If poolStats.ContainsKey("TotalConnections") Then
' Añade el valor correspondiente a cada clave a la lista 'orderedParams'. cachedStatsJSON.Put("TotalConnections", poolStats.Get("TotalConnections"))
orderedParams.Add(paramsMap.Get(key)) End If
Next If poolStats.ContainsKey("IdleConnections") Then
cachedStatsJSON.Put("IdleConnections", poolStats.Get("IdleConnections"))
End If
' Re-escribir el mapa en el cache global (es Thread-Safe)
Main.LatestPoolStats.Put(finalDbKey, cachedStatsJSON)
' Log(Main.LatestPoolStats)
End If
' Log($"Total: ${poolStats.Get("TotalConnections")}, Idle: ${poolStats.Get("IdleConnections")}, busy: ${poolBusyConnectionsForLog}, active: ${requestsBeforeDecrement}"$)
' Obtiene una conexión a la base de datos del pool de conexiones. ' Obtiene la sentencia SQL correspondiente al nombre del comando desde config.properties.
con = Connector.GetConnection(DB) Dim sqlCommand As String = Connector.GetCommand(finalDbKey, queryNameForLog)
' Obtiene la cadena SQL del archivo de configuración usando el nombre de la consulta (queryName).
Dim sqlCommand As String = Connector.GetCommand(DB, queryName)
' <<< INICIO NUEVA VALIDACIÓN: VERIFICAR SI EL COMANDO EXISTE >>> ' Validación: Si el comando SQL no fue encontrado en la configuración.
' Comprueba si el comando SQL (query) especificado en el JSON fue encontrado en el archivo de configuración.
If sqlCommand = Null Or sqlCommand = "null" Or sqlCommand.Trim = "" Then If sqlCommand = Null Or sqlCommand = "null" Or sqlCommand.Trim = "" Then
' Si no se encontró el comando, crea un mensaje de error claro. Dim errorMessage As String = $"El comando '${queryNameForLog}' no fue encontrado en el config.properties de '${finalDbKey}'."$
Dim errorMessage As String = $"El comando '${queryName}' no fue encontrado en el config.properties de '${DB}'."$
' Registra el error en el log del servidor para depuración.
Log(errorMessage) Log(errorMessage)
' Envía una respuesta de error 400 (Bad Request) al cliente en formato JSON. Main.LogServerError("ERROR", "DBHandlerJSON.Handle", errorMessage, finalDbKey, queryNameForLog, req.RemoteAddress) ' <-- Nuevo Log
SendErrorResponse(resp, 400, errorMessage) SendErrorResponse(resp, 400, errorMessage)
' Cierra la conexión a la base de datos antes de salir para evitar fugas de conexión. duration = DateTime.Now - start
If con <> Null And con.IsInitialized Then con.Close CleanupAndLog(finalDbKey, queryNameForLog, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con)
' Detiene la ejecución del método Handle para esta petición.
Return Return
End If End If
' <<< FIN NUEVA VALIDACIÓN >>>
' Comprueba el tipo de ejecución solicitado ("executeQuery" o "executeCommand"). ' --- Lógica para ejecutar diferentes tipos de comandos basados en el parámetro 'execType' ---
If execType.ToLowerCase = "executequery" Then If execType.ToLowerCase = "executequery" Then
' Declara una variable para almacenar el resultado de la consulta. ' --- INICIO VALIDACIÓN DE PARÁMETROS CENTRALIZADA ---
Dim rs As ResultSet Dim validationResult As ParameterValidationResult = ParameterValidationUtils.ValidateAndAdjustParameters(queryNameForLog, finalDbKey, sqlCommand, paramsList, Connector.IsParameterToleranceEnabled)
' Si el comando SQL contiene placeholders ('?'), significa que espera parámetros. If validationResult.Success = False Then
If sqlCommand.Contains("?") or orderedParams.Size > 0 Then SendErrorResponse(resp, 400, validationResult.ErrorMessage)
' ================================================================= duration = DateTime.Now - start
' === VALIDACIÓN DE CONTEO DE PARÁMETROS ========================== CleanupAndLog(finalDbKey, queryNameForLog, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con)
' ================================================================= Return ' Salida temprana.
' Calcula cuántos parámetros espera la consulta contando el número de '?'.
Dim expectedParams As Int = sqlCommand.Length - sqlCommand.Replace("?", "").Length
' Obtiene cuántos parámetros se recibieron.
Dim receivedParams As Int = orderedParams.Size
' Compara si la cantidad de parámetros esperados y recibidos es diferente.
Log($"expectedParams: ${expectedParams}, receivedParams: ${receivedParams}"$)
If expectedParams <> receivedParams Then
' Si no coinciden, envía un error 400 detallado.
SendErrorResponse(resp, 400, $"Número de parametros equivocado para '${queryName}'. Se esperaban ${expectedParams} y se recibieron ${receivedParams}."$)
' Cierra la conexión antes de salir para evitar fugas.
If con <> Null And con.IsInitialized Then con.Close
' Detiene la ejecución para evitar un error en la base de datos.
Return
End If
' =================================================================
' Ejecuta la consulta pasando el comando SQL y la lista ordenada de parámetros.
rs = con.ExecQuery2(sqlCommand, orderedParams)
Else
' Si no hay '?', ejecuta la consulta directamente sin parámetros.
rs = con.ExecQuery(sqlCommand)
End If End If
' --- Procesamiento de resultados --- Dim rs As ResultSet
' Prepara una lista para almacenar todas las filas del resultado. ' Ejecuta la consulta SQL con la lista de parámetros validada.
rs = con.ExecQuery2(sqlCommand, validationResult.ParamsToExecute)
' --- FIN VALIDACIÓN DE PARÁMETROS CENTRALIZADA ---
Dim ResultList As List Dim ResultList As List
ResultList.Initialize ResultList.Initialize ' Lista para almacenar los resultados de la consulta.
' Usa un objeto JavaObject para acceder a los metadatos del resultado (info de columnas). Dim jrs As JavaObject = rs ' Objeto Java subyacente del ResultSet para metadatos.
Dim jrs As JavaObject = rs Dim rsmd As JavaObject = jrs.RunMethod("getMetaData", Null) ' Metadatos del ResultSet.
Dim rsmd As JavaObject = jrs.RunMethod("getMetaData", Null) Dim cols As Int = rsmd.RunMethod("getColumnCount", Null) ' Número de columnas.
' Obtiene el número de columnas en el resultado.
Dim cols As Int = rsmd.RunMethod("getColumnCount", Null)
' Itera sobre cada fila del resultado (ResultSet). Do While rs.NextRow ' Itera sobre cada fila del resultado.
Do While rs.NextRow
' Crea un mapa para almacenar los datos de la fila actual (columna -> valor).
Dim RowMap As Map Dim RowMap As Map
RowMap.Initialize RowMap.Initialize ' Mapa para almacenar los datos de la fila actual.
' Itera sobre cada columna de la fila. For i = 1 To cols ' Itera sobre cada columna.
For i = 1 To cols Dim ColumnName As String = rsmd.RunMethod("getColumnName", Array(i)) ' Nombre de la columna.
' Obtiene el nombre de la columna. Dim value As Object = jrs.RunMethod("getObject", Array(i)) ' Valor de la columna.
Dim ColumnName As String = rsmd.RunMethod("getColumnName", Array(i)) RowMap.Put(ColumnName, value) ' Añade la columna y su valor al mapa de la fila.
' Obtiene el valor de la columna.
Dim value As Object = jrs.RunMethod("getObject", Array(i))
' Añade la pareja (nombre_columna, valor) al mapa de la fila.
RowMap.Put(ColumnName, value)
Next Next
' Añade el mapa de la fila a la lista de resultados. ResultList.Add(RowMap) ' Añade el mapa de la fila a la lista de resultados.
ResultList.Add(RowMap)
Loop Loop
' Cierra el ResultSet para liberar recursos de la base de datos. rs.Close ' Cierra el ResultSet.
rs.Close SendSuccessResponse(resp, CreateMap("result": ResultList)) ' Envía la respuesta JSON de éxito.
' Envía una respuesta de éxito con la lista de resultados en formato JSON.
SendSuccessResponse(resp, CreateMap("result": ResultList))
Else If execType.ToLowerCase = "executecommand" Then Else If execType.ToLowerCase = "executecommand" Then
' Si es un comando (INSERT, UPDATE, DELETE), también valida los parámetros. ' --- INICIO VALIDACIÓN DE PARÁMETROS CENTRALIZADA ---
If sqlCommand.Contains("?") Then Dim validationResult As ParameterValidationResult = ParameterValidationUtils.ValidateAndAdjustParameters(queryNameForLog, finalDbKey, sqlCommand, paramsList, Connector.IsParameterToleranceEnabled)
' =================================================================
' === VALIDACIÓN DE CONTEO DE PARÁMETROS (para Comandos) ========== If validationResult.Success = False Then
' ================================================================= SendErrorResponse(resp, 400, validationResult.ErrorMessage)
Dim expectedParams As Int = sqlCommand.Length - sqlCommand.Replace("?", "").Length duration = DateTime.Now - start
Dim receivedParams As Int = orderedParams.Size CleanupAndLog(finalDbKey, queryNameForLog, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con)
If expectedParams <> receivedParams Then Return ' Salida temprana.
SendErrorResponse(resp, 400, $"Número de parametros equivocado para '${queryName}'. Se esperaban ${expectedParams} y se recibieron ${receivedParams}."$)
' Cierra la conexión antes de salir.
If con <> Null And con.IsInitialized Then con.Close
' Detiene la ejecución.
Return
End If
' =================================================================
End If End If
Dim affectedCount As Int = 1 ' Asumimos éxito (1) si ExecNonQuery2 no lanza una excepción.
' Ejecuta el comando que no devuelve resultados (NonQuery) con sus parámetros. con.ExecNonQuery2(sqlCommand, validationResult.ParamsToExecute) ' Ejecuta un comando con la lista de parámetros validada.
con.ExecNonQuery2(sqlCommand, orderedParams) SendSuccessResponse(resp, CreateMap("affectedRows": affectedCount, "message": "Command executed successfully")) ' Envía confirmación de éxito.
' Envía una respuesta de éxito con un mensaje de confirmación. ' --- FIN VALIDACIÓN DE PARÁMETROS CENTRALIZADA ---
SendSuccessResponse(resp, CreateMap("message": "Command executed successfully"))
Else Else
' Si el valor de 'exec' no es ni "executeQuery" ni "executeCommand", envía un error. Dim ErrorMsg As String = "Parámetro 'exec' inválido. '" & execType & "' no es un valor permitido."
SendErrorResponse(resp, 400, "Parametro 'exec' inválido. '" & execType & "' no es un valor permitido.") SendErrorResponse(resp, 400, ErrorMsg)
Main.LogServerError("ERROR", "DBHandlerJSON.Handle", ErrorMsg, finalDbKey, queryNameForLog, req.RemoteAddress) ' <-- Nuevo Log
' El flujo continúa hasta la limpieza final si no hay un Return explícito.
End If End If
Catch ' --- CATCH: Maneja errores generales de ejecución o de SQL/JSON ---
Log(LastException) ' Registra la excepción completa en el log.
Main.LogServerError("ERROR", "DBHandlerJSON.Handle", LastException.Message, finalDbKey, queryNameForLog, req.RemoteAddress) ' <-- Nuevo Log
SendErrorResponse(resp, 500, LastException.Message) ' Envía un error 500 al cliente.
queryNameForLog = "error_processing_json" ' Para registrar que hubo un error en el log.
End Try ' --- FIN: Bloque Try principal ---
Catch ' --- Lógica de logging y limpieza final (para rutas de ejecución normal o después de Catch) ---
' Si ocurre cualquier error inesperado en el bloque Try... ' Este bloque se asegura de que, independientemente de cómo termine la petición (éxito o error),
' Registra la excepción completa en el log del servidor para diagnóstico. ' la duración se calcule y se llamen las subrutinas de limpieza y logging.
Log(LastException) duration = DateTime.Now - start ' Calcula la duración total de la petición.
' Envía una respuesta de error 500 (Internal Server Error) con el mensaje de la excepción. ' Llama a la subrutina centralizada para registrar el rendimiento y limpiar recursos.
SendErrorResponse(resp, 500, LastException.Message) CleanupAndLog(finalDbKey, queryNameForLog, duration, req.RemoteAddress, requestsBeforeDecrement, poolBusyConnectionsForLog, con)
End Try
' Este bloque se ejecuta siempre al final, haya habido error o no, *excepto si se usó Return antes*.
' Comprueba si el objeto de conexión fue inicializado y sigue abierto.
If con <> Null And con.IsInitialized Then
' Cierra la conexión para devolverla al pool y que pueda ser reutilizada.
' Esto es fundamental para no agotar las conexiones a la base de datos.
con.Close
End If
End Sub End Sub
' --- NUEVA SUBRUTINA: Centraliza el logging de rendimiento y la limpieza de recursos ---
' Esta subrutina es llamada por Handle en todos los puntos de salida, asegurando
' que los contadores se decrementen y las conexiones se cierren de forma consistente.
Private Sub CleanupAndLog(dbKey As String, qName As String, durMs As Long, clientIp As String, handlerReqs As Int, poolBusyConns As Int, conn As SQL)
' Los logs de depuración para CleanupAndLog pueden ser descomentados para una depuración profunda.
' Log($"[DEBUG] CleanupAndLog Entry (JSON): dbKey=${dbKey}, handlerReqs=${handlerReqs}, Map state: ${GlobalParameters.ActiveRequestsCountByDB}"$)
' 1. Llama a la subrutina centralizada en Main para registrar el rendimiento en SQLite.
Main.LogQueryPerformance(qName, durMs, dbKey, clientIp, handlerReqs, poolBusyConns)
' <<<< ¡CORRECCIÓN CLAVE: Aseguramos que currentCount sea Int al obtenerlo del mapa! >>>>
' 2. Decrementa el contador de peticiones activas para esta dbKey de forma robusta.
Dim currentCount As Int = GlobalParameters.ActiveRequestsCountByDB.GetDefault(dbKey, 0).As(Int)
' Log($"[DEBUG] CleanupAndLog Before Decrement (JSON): dbKey=${dbKey}, currentCount (as Int)=${currentCount}, Map state: ${GlobalParameters.ActiveRequestsCountByDB}"$)
If currentCount > 0 Then
' Si el contador es positivo, lo decrementamos.
GlobalParameters.ActiveRequestsCountByDB.Put(dbKey, currentCount - 1)
Else
' Si el contador ya está en 0 o negativo (lo cual no debería ocurrir con la lógica actual,
' pero se maneja para robustez), registramos una advertencia y lo aseguramos en 0.
' Log($"ADVERTENCIA: Intento de decrementar ActiveRequestsCountByDB para ${dbKey} que ya estaba en ${currentCount}. Asegurando a 0."$)
GlobalParameters.ActiveRequestsCountByDB.Put(dbKey, 0)
End If
' Log($"[DEBUG] CleanupAndLog After Decrement (JSON): dbKey=${dbKey}, New count (as Int)=${GlobalParameters.ActiveRequestsCountByDB.GetDefault(dbKey,0).As(Int)}, Map state: ${GlobalParameters.ActiveRequestsCountByDB}"$)
' <<<< ¡FIN DE CORRECCIÓN CLAVE! >>>>
' 3. Asegura que la conexión a la BD siempre se cierre y se devuelva al pool de conexiones.
If conn <> Null And conn.IsInitialized Then conn.Close
End Sub
' --- Subrutinas de ayuda para respuestas JSON --- ' --- Subrutinas de ayuda para respuestas JSON ---
' Construye y envía una respuesta JSON de éxito. ' Construye y envía una respuesta JSON de éxito.
' resp: El objeto ServletResponse para enviar la respuesta.
' dataMap: Un mapa que contiene los datos a incluir en la respuesta JSON.
Private Sub SendSuccessResponse(resp As ServletResponse, dataMap As Map) Private Sub SendSuccessResponse(resp As ServletResponse, dataMap As Map)
' Añade el campo "success": true al mapa de datos para indicar que todo salió bien. ' Añade el campo "success": true al mapa de datos para indicar que todo salió bien.
dataMap.Put("success", True) dataMap.Put("success", True)
' Crea un generador de JSON. ' Crea un generador de JSON.
Dim jsonGenerator As JSONGenerator Dim jsonGenerator As JSONGenerator
jsonGenerator.Initialize(dataMap) jsonGenerator.Initialize(dataMap)
' Establece el tipo de contenido de la respuesta a "application/json". ' Establece el tipo de contenido de la respuesta a "application/json".
resp.ContentType = "application/json" resp.ContentType = "application/json"
' Escribe la cadena JSON generada en el cuerpo de la respuesta HTTP. ' Escribe la cadena JSON generada en el cuerpo de la respuesta HTTP.
@@ -248,19 +287,25 @@ Private Sub SendSuccessResponse(resp As ServletResponse, dataMap As Map)
End Sub End Sub
' Construye y envía una respuesta JSON de error. ' Construye y envía una respuesta JSON de error.
' resp: El objeto ServletResponse para enviar la respuesta.
' statusCode: El código de estado HTTP (ej. 400 para error del cliente, 500 para error del servidor).
' errorMessage: El mensaje de error que se enviará al cliente.
Private Sub SendErrorResponse(resp As ServletResponse, statusCode As Int, errorMessage As String) Private Sub SendErrorResponse(resp As ServletResponse, statusCode As Int, errorMessage As String)
' Personaliza el mensaje de error si es un error común de parámetros de Oracle o JDBC. ' Personaliza el mensaje de error si es un error común de parámetros de Oracle o JDBC.
If errorMessage.Contains("Índice de columnas no válido") Or errorMessage.Contains("ORA-17003") Then errorMessage = "NUMERO DE PARAMETROS EQUIVOCADO: " & errorMessage If errorMessage.Contains("Índice de columnas no válido") Or errorMessage.Contains("ORA-17003") Then
errorMessage = "NUMERO DE PARAMETROS EQUIVOCADO: " & errorMessage
End If
' Crea un mapa con el estado de error y el mensaje. ' Crea un mapa con el estado de error y el mensaje.
Dim resMap As Map = CreateMap("success": False, "error": errorMessage) Dim resMap As Map = CreateMap("success": False, "error": errorMessage)
' Genera la cadena JSON a partir del mapa. ' Genera la cadena JSON a partir del mapa.
Dim jsonGenerator As JSONGenerator Dim jsonGenerator As JSONGenerator
jsonGenerator.Initialize(resMap) jsonGenerator.Initialize(resMap)
' Establece el código de estado HTTP (ej. 400 para error del cliente, 500 para error del servidor). ' Establece el código de estado HTTP (ej. 400 para error del cliente, 500 para error del servidor).
resp.Status = statusCode resp.Status = statusCode
' Establece el tipo de contenido y escribe la respuesta de error. ' Establece el tipo de contenido y escribe la respuesta de error.
resp.ContentType = "application/json" resp.ContentType = "application/json"
resp.Write(jsonGenerator.ToString) resp.Write(jsonGenerator.ToString)
End Sub End Sub

View File

@@ -10,7 +10,7 @@ Sub Class_Globals
End Sub End Sub
Public Sub Initialize Public Sub Initialize
' bc.Initialize bc.Initialize("BC")
End Sub End Sub
Public Sub Handle(req As ServletRequest, resp As ServletResponse) Public Sub Handle(req As ServletRequest, resp As ServletResponse)

View File

@@ -1,85 +1,29 @@
#Lines starting with '#' are comments. #Lines starting with '#' are comments.
#Backslash character at the end of line means that the command continues in the next line. #Backslash character at the end of line means that the command continues in the next line.
DriverClass=oracle.jdbc.driver.OracleDriver
#JdbcUrl=jdbc:mysql://localhost/test?characterEncoding=utf8
#SQL Server #DATABASE CONFIGURATION
DriverClass=com.mysql.jdbc.Driver
JdbcUrl=jdbc:mysql://localhost/$DB$?characterEncoding=utf8
User=root
Password=
#Java server port
ServerPort=17178
#example of MS SQL Server configuration:
#DriverClass=net.sourceforge.jtds.jdbc.Driver #DriverClass=net.sourceforge.jtds.jdbc.Driver
#JdbcUrl=jdbc:jtds:sqlserver://<server address>/<database>
# este para produccion GHAN JdbcUrl=jdbc:oracle:thin:@//192.168.15.53:1521/DBKMT #example of postegres configuration:
#GOHAN ---> server #JdbcUrl=jdbc:postgresql://localhost/test
#JdbcUrl=jdbc:oracle:thin:@//10.0.0.205:1521/DBKMT #DriverClass=org.postgresql.Driver
#JdbcUrl=jdbc:oracle:thin:@//10.0.0.236:1521/DBKMT
JdbcUrl=jdbc:oracle:thin:@//192.168.101.13:1521/DBKMT
# SVR-KEYMON-PRODUCCION--> Usuario
User=SALMA
Password=SALMAD2016M
#User=TORRADOCONAUTO
#Password=TORRADOCONAUTOD2016M
#--> Puertos
#SAC - DFR - MDA / GOHAN -->COBRANZA
#ServerPort=1783
#GUNA - SALMA - DURAKELO - DBC / SVR-KEYMON-PRODUCCION --> DISTRIBUIDORAS
ServerPort=9010
#CMG - TORRADO / TRUNKS -->COBRANZA/ GM
#ServerPort=1781
#If Debug is true then this file will be reloaded on every query.
#This is useful if you need to modify the queries.
Debug=true
#SQL COMMANDS #SQL COMMANDS
sql.create_table=CREATE TABLE IF NOT EXISTS animals (\
################## id INTEGER PRIMARY KEY AUTO_INCREMENT,\
################# name CHAR(30) NOT NULL,\
################ S O P O R T E image BLOB)
################# sql.insert_animal=INSERT INTO animals VALUES (null, ?,?)
################## sql.select_animal=SELECT name, image, id FROM animals WHERE id = ?;
sql.create_table=CREATE TABLE article (col1 numeric(10,4) ,col2 text);
sql.traeConexion=select 'DB2' as conexion from dual sql.select=select * from article
sql.select_soporte=select * from GUNA.soporte sql.insert=INSERT INTO article VALUES(?, ?)
sql.select_conexion=SELECT 'OK' AS VALOR FROM DUAL
sql.select_version=select cat_ve_version from cat_version
sql.select_version_GV2=select cat_ve_version from GUNA.cat_version
sql.selectAlmacen=select * from cat_almacen where cat_al_id = ?
sql.sv=select * from cat_rutas where CAT_RU_RUTA = ?
sql.update_usuario_guna_nobajas=UPDATE GUNA.CAT_LOGINS SET CAT_LO_ESTATUS = 'Activo',CAT_LO_CONECTADO ='0' WHERE CAT_LO_ESTATUS != 'Baja' and CAT_LO_USUARIO = (?)
sql.proc_usuario=BEGIN EXECUTE IMMEDIATE ('DECLARE Cursor_SYS Sys_Refcursor; BEGIN SP_ACTIVAR_USUARIO( '''||(?)||''',Cursor_SYS); end;'); END;
sql.select_almacenes_KELL=select CAT_AG_ID, CAT_AG_NOMBRE from KELLOGGS.cat_agencias order by CAT_AG_NOMBRE
sql.select_almacenes_GUNA=select CAT_AG_ID, CAT_AG_NOMBRE from GUNA.cat_agencias order by CAT_AG_NOMBRE
sql.select_almacenes_SALMA=select CAT_AG_ID, CAT_AG_NOMBRE from SALMA.cat_agencias order by CAT_AG_NOMBRE
sql.select_almacenes_DANVIT=select CAT_AG_ID, CAT_AG_NOMBRE from DANVIT.cat_agencias order by CAT_AG_NOMBRE
sql.proc_QUITAR_VENTA_KELL=BEGIN EXECUTE IMMEDIATE ('DECLARE Cursor_SYS Sys_Refcursor; BEGIN KELLOGGS.SP_QUITAR_VENTA_X_TIPO( '''||(?)||''', '''||(?)||''', '''||(?)||''', '''||(?)||''', '''||(?)||''', Cursor_SYS); end;'); END;
sql.proc_QUITAR_VENTA_GUNA=BEGIN EXECUTE IMMEDIATE ('DECLARE Cursor_SYS Sys_Refcursor; BEGIN GUNA.SP_QUITAR_VENTA( '''||(?)||''', '''||(?)||''', '''||(?)||''', Cursor_SYS, '''||(?)||'''); end;'); END;
sql.proc_QUITAR_VENTA_SALMA=BEGIN EXECUTE IMMEDIATE ('DECLARE Cursor_SYS Sys_Refcursor; BEGIN SALMA.SP_QUITAR_VENTA( '''||(?)||''', '''||(?)||''', '''||(?)||''', Cursor_SYS); end;'); END;
sql.proc_QUITAR_VENTA_DANVIT=BEGIN EXECUTE IMMEDIATE ('DECLARE Cursor_SYS Sys_Refcursor; BEGIN DANVIT.SP_QUITAR_VENTA( '''||(?)||''', '''||(?)||''', '''||(?)||''', Cursor_SYS); end;'); END;
sql.proc_QUITAR_PAGOPAGARE_KELLOGGS=BEGIN EXECUTE IMMEDIATE ('DECLARE Cursor_SYS Sys_Refcursor; BEGIN KELLOGGS.SP_ELIMINAS_PAGOS_PAGARES_REP( '''||(?)||''', '''||(?)||''', '''||(?)||''', Cursor_SYS); end;'); END;
sql.proc_LIBERA_BANDERA_FACTURACION_KELLOGGS=BEGIN EXECUTE IMMEDIATE ('DECLARE Cursor_SYS Sys_Refcursor; BEGIN KELLOGGS.SP_LIBERA_FACTURACION(Cursor_SYS); end;'); END;
sql.proc_LIBERA_BANDERA_CARGAFORANEA_KELLOGGS=BEGIN EXECUTE IMMEDIATE ('DECLARE Cursor_SYS Sys_Refcursor; BEGIN KELLOGGS.SP_LLENAR_FILTROS ( '''||(?)||''', '''||(?)||''', Cursor_SYS); end;'); END;
sql.proc_QUITAR_TICKET_KELLOGGS=BEGIN EXECUTE IMMEDIATE ('DECLARE Cursor_SYS Sys_Refcursor; BEGIN KELLOGGS.SP_QUITAR_TICKET( '''||(?)||''', '''||(?)||''', '''||(?)||''', Cursor_SYS); end;'); END;
sql.revisa_liquidada_Guna=SELECT COUNT(*) as liquidada FROM GUNA.HIST_VENTAS_DETALLE WHERE trunc(HVD_DTESYNC) = trunc(sysdate) and hvd_almacen = (?) and hvd_ruta = (?) AND (HVD_DESCUENTO != 0 or HVD_FECHA_AVION IS NOT NULL)
sql.revisa_liquidada_Kell=SELECT COUNT(*) as liquidada FROM KELLOGGS.HIST_VENTAS_DETALLE WHERE trunc(HVD_DTESYNC) = trunc(sysdate) and hvd_almacen = (?) and hvd_ruta = (?) and HVD_TIPOVENTA = (?) AND HVD_ESTATUS = 'Liquidado'
sql.select_todos_soporte=select cat_lo_usuario, cat_lo_estatus, cat_lo_nombre, cat_lo_contrasena, cat_lo_agencia, cat_agencias.cat_ag_nombre, cat_lo_ruta from cat_logins left join cat_agencias on cat_lo_agencia = cat_ag_id where (cat_lo_usuario LIKE ('%'||(?)||'%') or cat_lo_nombre LIKE ('%'||(?)||'%')) and cat_ag_nombre LIKE ('%'||(?)||'%') and cat_lo_ruta LIKE ('%'||(?)||'%') and rownum <= 20
sql.select_todosGUNA_soporte=select cat_lo_usuario, cat_lo_estatus, cat_lo_nombre, cat_lo_contrasena, cat_lo_agencia, cat_agencias.cat_ag_nombre, cat_ru_ruta from cat_logins left join cat_agencias on cat_lo_agencia = cat_ag_id left join cat_rutas on cat_lo_usuario = cat_ru_vendedor where (cat_lo_usuario LIKE ('%'||(?)||'%') or cat_lo_nombre LIKE ('%'||(?)||'%')) and cat_ag_nombre LIKE ('%'||(?)||'%') and cat_ru_ruta LIKE ('%'||(?)||'%') and rownum <= 20
sql.select_todosKELLOGGS_soporte=select cat_lo_usuario, cat_lo_estatus, cat_lo_nombre, cat_lo_contrasena, cat_lo_agencia, cat_agencias.cat_ag_nombre, cat_ru_ruta from KELLOGGS.cat_logins left join KELLOGGS.cat_agencias on cat_lo_agencia = cat_ag_id left join KELLOGGS.cat_rutas on cat_lo_usuario = cat_ru_vendedor where (cat_lo_usuario LIKE ('%'||(?)||'%') or cat_lo_nombre LIKE ('%'||(?)||'%')) and cat_ag_nombre LIKE ('%'||(?)||'%') and cat_ru_ruta LIKE ('%'||(?)||'%') and rownum <= 20
sql.select_todosSALMA_soporte=select cat_lo_usuario, cat_lo_estatus, cat_lo_nombre, cat_lo_contrasena, cat_lo_agencia, cat_agencias.cat_ag_nombre, cat_lo_ruta as cat_ru_ruta from SALMA.cat_logins left join SALMA.cat_agencias on cat_lo_agencia = cat_ag_id where (cat_lo_usuario LIKE ('%'||(?)||'%') or cat_lo_nombre LIKE ('%'||(?)||'%')) and cat_ag_nombre LIKE ('%'||(?)||'%') and cat_lo_ruta LIKE ('%'||(?)||'%') and rownum <= 20
sql.select_todosDANVIT_soporte=select cat_lo_usuario, cat_lo_estatus, cat_lo_nombre, cat_lo_contrasena, cat_lo_agencia, cat_agencias.cat_ag_nombre, cat_ru_ruta from DANVIT.cat_logins left join DANVIT.cat_agencias on cat_lo_agencia = cat_ag_id left join DANVIT.cat_rutas on cat_lo_usuario = cat_ru_vendedor where (cat_lo_usuario LIKE ('%'||(?)||'%') or cat_lo_nombre LIKE ('%'||(?)||'%')) and cat_ag_nombre LIKE ('%'||(?)||'%') and cat_ru_ruta LIKE ('%'||(?)||'%') and rownum <= 20
sql.select_ventaXrutaGuna_soporte=select hvd_ruta, sum(hvd_costo_tot) as monto, hvd_tipoventa from hist_ventas_detalle where trunc(hvd_fecha)=trunc(sysdate) and hvd_ruta=(?) and hvd_almacen=(?) AND hvd_codpromo <> 'BASICA' group by hvd_ruta, hvd_tipoventa
sql.select_ventaXrutaKelloggs_soporte=select hvd_ruta, sum(hvd_costo_tot) as monto, hvd_tipoventa from KELLOGGS.hist_ventas_detalle where trunc(hvd_fecha)=trunc(sysdate) and hvd_ruta=(?) and hvd_almacen=(?) and hvd_tipoventa=(?) AND hvd_codpromo <> 'BASICA' group by hvd_ruta, hvd_tipoventa
sql.select_ventaXrutaSalma_soporte=select hvd_ruta, sum(hvd_costo_tot) as monto, hvd_tipoventa from SALMA.hist_ventas_detalle where trunc(hvd_fecha)=trunc(sysdate) and hvd_ruta=(?) and hvd_almacen=(?) AND hvd_codpromo <> 'BASICA' group by hvd_ruta, hvd_tipoventa
sql.select_ventaXrutaDanvit_soporte=select hvd_ruta, sum(hvd_costo_tot) as monto, hvd_tipoventa from DANVIT.hist_ventas_detalle where trunc(hvd_fecha)=trunc(sysdate) and hvd_ruta=(?) and hvd_almacen=(?) AND hvd_codpromo <> 'BASICA' group by hvd_ruta, hvd_tipoventa
sql.select_prodsTicket_Kelloggs=SELECT HVD_CLIENTE CLIENTE, HVD_PROID PRODUCTO_ID, HVD_PRONOMBRE NOMBRE_PRODUCTO, HVD_CANT CANTIDAD, HVD_COSTO_TOT COSTO_TOTAL, HVD_RUTA RUTA, HVD_CODPROMO CODPROMO,NVL(HVD_TIPOVENTA,' ') TIPOVENTA, NVL(HVD_ESTATUS,' ') ESTATUS, hvd_cedis FROM KELLOGGS.HIST_VENTAS_DETALLE WHERE TRUNC(HVD_FECHA) = TRUNC(SYSDATE) AND HVD_ALMACEN = (?) AND HVD_CLIENTE = (?) and hvd_rechazo is null ORDER BY HVD_CODPROMO, HVD_PRONOMBRE

View File

@@ -1,76 +1,29 @@
#Lines starting with '#' are comments. #Lines starting with '#' are comments.
#Backslash character at the end of line means that the command continues in the next line. #Backslash character at the end of line means that the command continues in the next line.
DriverClass=oracle.jdbc.driver.OracleDriver
#JdbcUrl=jdbc:mysql://localhost/test?characterEncoding=utf8
#SQL Server #DATABASE CONFIGURATION
DriverClass=com.mysql.jdbc.Driver
JdbcUrl=jdbc:mysql://localhost/$DB$?characterEncoding=utf8
User=root
Password=
#Java server port
ServerPort=17178
#example of MS SQL Server configuration:
#DriverClass=net.sourceforge.jtds.jdbc.Driver #DriverClass=net.sourceforge.jtds.jdbc.Driver
#JdbcUrl=jdbc:jtds:sqlserver://<server address>/<database>
# este para produccion GHAN JdbcUrl=jdbc:oracle:thin:@//192.168.15.53:1521/DBKMT #example of postegres configuration:
#GOHAN ---> server #JdbcUrl=jdbc:postgresql://localhost/test
#JdbcUrl=jdbc:oracle:thin:@//10.0.0.205:1521/DBKMT #DriverClass=org.postgresql.Driver
#JdbcUrl=jdbc:oracle:thin:@//10.0.0.236:1521/DBKMT
JdbcUrl=jdbc:oracle:thin:@//192.168.101.12:1521/DBKMT
# SVR-KEYMON-PRODUCCION--> Usuario
#User=GUNA
#Password=GUNAD2015M
User=TORRADOCONAUTO
Password=TORRADOCONAUTOD2016M
#--> Puertos
#SAC - DFR - MDA / GOHAN -->COBRANZA
#ServerPort=1783
#GUNA - SALMA - DURAKELO - DBC / SVR-KEYMON-PRODUCCION --> DISTRIBUIDORAS
ServerPort=9010
#CMG - TORRADO / TRUNKS -->COBRANZA/ GM
#ServerPort=1781
#If Debug is true then this file will be reloaded on every query.
#This is useful if you need to modify the queries.
Debug=true
#SQL COMMANDS #SQL COMMANDS
sql.create_table=CREATE TABLE IF NOT EXISTS animals (\
################## id INTEGER PRIMARY KEY AUTO_INCREMENT,\
################# name CHAR(30) NOT NULL,\
################ S O P O R T E image BLOB)
################# sql.insert_animal=INSERT INTO animals VALUES (null, ?,?)
################## sql.select_animal=SELECT name, image, id FROM animals WHERE id = ?;
sql.create_table=CREATE TABLE article (col1 numeric(10,4) ,col2 text);
sql.traeConexion=select 'DB3' as conexion from dual sql.select=select * from article
sql.select_soporte=select * from GUNA.soporte sql.insert=INSERT INTO article VALUES(?, ?)
sql.select_almacenes_KELL=select CAT_AG_ID, CAT_AG_NOMBRE from KELLOGGS.cat_agencias order by CAT_AG_NOMBRE
sql.select_almacenes_GUNA=select CAT_AG_ID, CAT_AG_NOMBRE from GUNA.cat_agencias order by CAT_AG_NOMBRE
sql.select_almacenes_SALMA=select CAT_AG_ID, CAT_AG_NOMBRE from SALMA.cat_agencias order by CAT_AG_NOMBRE
sql.select_almacenes_DANVIT=select CAT_AG_ID, CAT_AG_NOMBRE from DANVIT.cat_agencias order by CAT_AG_NOMBRE
sql.proc_QUITAR_VENTA_KELL=BEGIN EXECUTE IMMEDIATE ('DECLARE Cursor_SYS Sys_Refcursor; BEGIN KELLOGGS.SP_QUITAR_VENTA_X_TIPO( '''||(?)||''', '''||(?)||''', '''||(?)||''', '''||(?)||''', '''||(?)||''', Cursor_SYS); end;'); END;
sql.proc_QUITAR_VENTA_GUNA=BEGIN EXECUTE IMMEDIATE ('DECLARE Cursor_SYS Sys_Refcursor; BEGIN GUNA.SP_QUITAR_VENTA( '''||(?)||''', '''||(?)||''', '''||(?)||''', Cursor_SYS, '''||(?)||'''); end;'); END;
sql.proc_QUITAR_VENTA_SALMA=BEGIN EXECUTE IMMEDIATE ('DECLARE Cursor_SYS Sys_Refcursor; BEGIN SALMA.SP_QUITAR_VENTA( '''||(?)||''', '''||(?)||''', '''||(?)||''', Cursor_SYS); end;'); END;
sql.proc_QUITAR_VENTA_DANVIT=BEGIN EXECUTE IMMEDIATE ('DECLARE Cursor_SYS Sys_Refcursor; BEGIN DANVIT.SP_QUITAR_VENTA( '''||(?)||''', '''||(?)||''', '''||(?)||''', Cursor_SYS); end;'); END;
sql.proc_QUITAR_PAGOPAGARE_KELLOGGS=BEGIN EXECUTE IMMEDIATE ('DECLARE Cursor_SYS Sys_Refcursor; BEGIN KELLOGGS.SP_ELIMINAS_PAGOS_PAGARES_REP( '''||(?)||''', '''||(?)||''', '''||(?)||''', Cursor_SYS); end;'); END;
sql.proc_LIBERA_BANDERA_FACTURACION_KELLOGGS=BEGIN EXECUTE IMMEDIATE ('DECLARE Cursor_SYS Sys_Refcursor; BEGIN KELLOGGS.SP_LIBERA_FACTURACION(Cursor_SYS); end;'); END;
sql.proc_LIBERA_BANDERA_CARGAFORANEA_KELLOGGS=BEGIN EXECUTE IMMEDIATE ('DECLARE Cursor_SYS Sys_Refcursor; BEGIN KELLOGGS.SP_LLENAR_FILTROS ( '''||(?)||''', '''||(?)||''', Cursor_SYS); end;'); END;
sql.proc_QUITAR_TICKET_KELLOGGS=BEGIN EXECUTE IMMEDIATE ('DECLARE Cursor_SYS Sys_Refcursor; BEGIN KELLOGGS.SP_QUITAR_TICKET( '''||(?)||''', '''||(?)||''', '''||(?)||''', Cursor_SYS); end;'); END;
sql.revisa_liquidada_Guna=SELECT COUNT(*) as liquidada FROM GUNA.HIST_VENTAS_DETALLE WHERE trunc(HVD_DTESYNC) = trunc(sysdate) and hvd_almacen = (?) and hvd_ruta = (?) AND (HVD_DESCUENTO != 0 or HVD_FECHA_AVION IS NOT NULL)
sql.revisa_liquidada_Kell=SELECT COUNT(*) as liquidada FROM KELLOGGS.HIST_VENTAS_DETALLE WHERE trunc(HVD_DTESYNC) = trunc(sysdate) and hvd_almacen = (?) and hvd_ruta = (?) and HVD_TIPOVENTA = (?) AND HVD_ESTATUS = 'Liquidado'
sql.select_todos_soporte=select cat_lo_usuario, cat_lo_estatus, cat_lo_nombre, cat_lo_contrasena, cat_lo_agencia, cat_agencias.cat_ag_nombre, cat_lo_ruta from cat_logins left join cat_agencias on cat_lo_agencia = cat_ag_id where (cat_lo_usuario LIKE ('%'||(?)||'%') or cat_lo_nombre LIKE ('%'||(?)||'%')) and cat_ag_nombre LIKE ('%'||(?)||'%') and cat_lo_ruta LIKE ('%'||(?)||'%') and rownum <= 20
sql.select_todosGUNA_soporte=select cat_lo_usuario, cat_lo_estatus, cat_lo_nombre, cat_lo_contrasena, cat_lo_agencia, cat_agencias.cat_ag_nombre, cat_ru_ruta from cat_logins left join cat_agencias on cat_lo_agencia = cat_ag_id left join cat_rutas on cat_lo_usuario = cat_ru_vendedor where (cat_lo_usuario LIKE ('%'||(?)||'%') or cat_lo_nombre LIKE ('%'||(?)||'%')) and cat_ag_nombre LIKE ('%'||(?)||'%') and cat_ru_ruta LIKE ('%'||(?)||'%') and rownum <= 20
sql.select_todosKELLOGGS_soporte=select cat_lo_usuario, cat_lo_estatus, cat_lo_nombre, cat_lo_contrasena, cat_lo_agencia, cat_agencias.cat_ag_nombre, cat_ru_ruta from KELLOGGS.cat_logins left join KELLOGGS.cat_agencias on cat_lo_agencia = cat_ag_id left join KELLOGGS.cat_rutas on cat_lo_usuario = cat_ru_vendedor where (cat_lo_usuario LIKE ('%'||(?)||'%') or cat_lo_nombre LIKE ('%'||(?)||'%')) and cat_ag_nombre LIKE ('%'||(?)||'%') and cat_ru_ruta LIKE ('%'||(?)||'%') and rownum <= 20
sql.select_todosSALMA_soporte=select cat_lo_usuario, cat_lo_estatus, cat_lo_nombre, cat_lo_contrasena, cat_lo_agencia, cat_agencias.cat_ag_nombre, cat_lo_ruta as cat_ru_ruta from SALMA.cat_logins left join SALMA.cat_agencias on cat_lo_agencia = cat_ag_id where (cat_lo_usuario LIKE ('%'||(?)||'%') or cat_lo_nombre LIKE ('%'||(?)||'%')) and cat_ag_nombre LIKE ('%'||(?)||'%') and cat_lo_ruta LIKE ('%'||(?)||'%') and rownum <= 20
sql.select_todosDANVIT_soporte=select cat_lo_usuario, cat_lo_estatus, cat_lo_nombre, cat_lo_contrasena, cat_lo_agencia, cat_agencias.cat_ag_nombre, cat_ru_ruta from DANVIT.cat_logins left join DANVIT.cat_agencias on cat_lo_agencia = cat_ag_id left join DANVIT.cat_rutas on cat_lo_usuario = cat_ru_vendedor where (cat_lo_usuario LIKE ('%'||(?)||'%') or cat_lo_nombre LIKE ('%'||(?)||'%')) and cat_ag_nombre LIKE ('%'||(?)||'%') and cat_ru_ruta LIKE ('%'||(?)||'%') and rownum <= 20
sql.select_ventaXrutaGuna_soporte=select hvd_ruta, sum(hvd_costo_tot) as monto, hvd_tipoventa from hist_ventas_detalle where trunc(hvd_fecha)=trunc(sysdate) and hvd_ruta=(?) and hvd_almacen=(?) AND hvd_codpromo <> 'BASICA' group by hvd_ruta, hvd_tipoventa
sql.select_ventaXrutaKelloggs_soporte=select hvd_ruta, sum(hvd_costo_tot) as monto, hvd_tipoventa from KELLOGGS.hist_ventas_detalle where trunc(hvd_fecha)=trunc(sysdate) and hvd_ruta=(?) and hvd_almacen=(?) and hvd_tipoventa=(?) AND hvd_codpromo <> 'BASICA' group by hvd_ruta, hvd_tipoventa
sql.select_ventaXrutaSalma_soporte=select hvd_ruta, sum(hvd_costo_tot) as monto, hvd_tipoventa from SALMA.hist_ventas_detalle where trunc(hvd_fecha)=trunc(sysdate) and hvd_ruta=(?) and hvd_almacen=(?) AND hvd_codpromo <> 'BASICA' group by hvd_ruta, hvd_tipoventa
sql.select_ventaXrutaDanvit_soporte=select hvd_ruta, sum(hvd_costo_tot) as monto, hvd_tipoventa from DANVIT.hist_ventas_detalle where trunc(hvd_fecha)=trunc(sysdate) and hvd_ruta=(?) and hvd_almacen=(?) AND hvd_codpromo <> 'BASICA' group by hvd_ruta, hvd_tipoventa
sql.select_prodsTicket_Kelloggs=SELECT HVD_CLIENTE CLIENTE, HVD_PROID PRODUCTO_ID, HVD_PRONOMBRE NOMBRE_PRODUCTO, HVD_CANT CANTIDAD, HVD_COSTO_TOT COSTO_TOTAL, HVD_RUTA RUTA, HVD_CODPROMO CODPROMO,NVL(HVD_TIPOVENTA,' ') TIPOVENTA, NVL(HVD_ESTATUS,' ') ESTATUS, hvd_cedis FROM KELLOGGS.HIST_VENTAS_DETALLE WHERE TRUNC(HVD_FECHA) = TRUNC(SYSDATE) AND HVD_ALMACEN = (?) AND HVD_CLIENTE = (?) and hvd_rechazo is null ORDER BY HVD_CODPROMO, HVD_PRONOMBRE

View File

@@ -1,77 +1,29 @@
#Lines starting with '#' are comments. #Lines starting with '#' are comments.
#Backslash character at the end of line means that the command continues in the next line. #Backslash character at the end of line means that the command continues in the next line.
DriverClass=oracle.jdbc.driver.OracleDriver
#JdbcUrl=jdbc:mysql://localhost/test?characterEncoding=utf8
#SQL Server #DATABASE CONFIGURATION
DriverClass=com.mysql.jdbc.Driver
JdbcUrl=jdbc:mysql://localhost/$DB$?characterEncoding=utf8
User=root
Password=
#Java server port
ServerPort=17178
#example of MS SQL Server configuration:
#DriverClass=net.sourceforge.jtds.jdbc.Driver #DriverClass=net.sourceforge.jtds.jdbc.Driver
#JdbcUrl=jdbc:jtds:sqlserver://<server address>/<database>
# este para produccion GHAN JdbcUrl=jdbc:oracle:thin:@//192.168.15.53:1521/DBKMT #example of postegres configuration:
#GOHAN ---> server #JdbcUrl=jdbc:postgresql://localhost/test
#JdbcUrl=jdbc:oracle:thin:@//10.0.0.205:1521/DBKMT #DriverClass=org.postgresql.Driver
#JdbcUrl=jdbc:oracle:thin:@//10.0.0.236:1521/DBKMT
JdbcUrl=jdbc:oracle:thin:@//192.168.101.13:1521/DBKMT
# SVR-KEYMON-PRODUCCION--> Usuario
User=SALMA
Password=SALMAD2016M
#User=TORRADOCONAUTO
#Password=TORRADOCONAUTOD2016M
#--> Puertos
#SAC - DFR - MDA / GOHAN -->COBRANZA
#ServerPort=1783
#GUNA - SALMA - DURAKELO - DBC / SVR-KEYMON-PRODUCCION --> DISTRIBUIDORAS
ServerPort=9000
#CMG - TORRADO / TRUNKS -->COBRANZA/ GM
#ServerPort=1781
#If Debug is true then this file will be reloaded on every query.
#This is useful if you need to modify the queries.
Debug=true
#SQL COMMANDS #SQL COMMANDS
sql.create_table=CREATE TABLE IF NOT EXISTS animals (\
################## id INTEGER PRIMARY KEY AUTO_INCREMENT,\
################# name CHAR(30) NOT NULL,\
################ S O P O R T E image BLOB)
################# sql.insert_animal=INSERT INTO animals VALUES (null, ?,?)
################## sql.select_animal=SELECT name, image, id FROM animals WHERE id = ?;
sql.create_table=CREATE TABLE article (col1 numeric(10,4) ,col2 text);
sql.traeConexion=select 'DB4' as conexion from dual sql.select=select * from article
sql.select_soporte=select * from GUNA.soporte sql.insert=INSERT INTO article VALUES(?, ?)
sql.select_conexion=SELECT 'OK' AS VALOR FROM DUAL
sql.select_almacenes_KELL=select CAT_AG_ID, CAT_AG_NOMBRE from KELLOGGS.cat_agencias order by CAT_AG_NOMBRE
sql.select_almacenes_GUNA=select CAT_AG_ID, CAT_AG_NOMBRE from GUNA.cat_agencias order by CAT_AG_NOMBRE
sql.select_almacenes_SALMA=select CAT_AG_ID, CAT_AG_NOMBRE from SALMA.cat_agencias order by CAT_AG_NOMBRE
sql.select_almacenes_DANVIT=select CAT_AG_ID, CAT_AG_NOMBRE from DANVIT.cat_agencias order by CAT_AG_NOMBRE
sql.proc_QUITAR_VENTA_KELL=BEGIN EXECUTE IMMEDIATE ('DECLARE Cursor_SYS Sys_Refcursor; BEGIN KELLOGGS.SP_QUITAR_VENTA_X_TIPO( '''||(?)||''', '''||(?)||''', '''||(?)||''', '''||(?)||''', '''||(?)||''', Cursor_SYS); end;'); END;
sql.proc_QUITAR_VENTA_GUNA=BEGIN EXECUTE IMMEDIATE ('DECLARE Cursor_SYS Sys_Refcursor; BEGIN GUNA.SP_QUITAR_VENTA( '''||(?)||''', '''||(?)||''', '''||(?)||''', Cursor_SYS, '''||(?)||'''); end;'); END;
sql.proc_QUITAR_VENTA_SALMA=BEGIN EXECUTE IMMEDIATE ('DECLARE Cursor_SYS Sys_Refcursor; BEGIN SALMA.SP_QUITAR_VENTA( '''||(?)||''', '''||(?)||''', '''||(?)||''', Cursor_SYS); end;'); END;
sql.proc_QUITAR_VENTA_DANVIT=BEGIN EXECUTE IMMEDIATE ('DECLARE Cursor_SYS Sys_Refcursor; BEGIN DANVIT.SP_QUITAR_VENTA( '''||(?)||''', '''||(?)||''', '''||(?)||''', Cursor_SYS); end;'); END;
sql.proc_QUITAR_PAGOPAGARE_KELLOGGS=BEGIN EXECUTE IMMEDIATE ('DECLARE Cursor_SYS Sys_Refcursor; BEGIN KELLOGGS.SP_ELIMINAS_PAGOS_PAGARES_REP( '''||(?)||''', '''||(?)||''', '''||(?)||''', Cursor_SYS); end;'); END;
sql.proc_LIBERA_BANDERA_FACTURACION_KELLOGGS=BEGIN EXECUTE IMMEDIATE ('DECLARE Cursor_SYS Sys_Refcursor; BEGIN KELLOGGS.SP_LIBERA_FACTURACION(Cursor_SYS); end;'); END;
sql.proc_LIBERA_BANDERA_CARGAFORANEA_KELLOGGS=BEGIN EXECUTE IMMEDIATE ('DECLARE Cursor_SYS Sys_Refcursor; BEGIN KELLOGGS.SP_LLENAR_FILTROS ( '''||(?)||''', '''||(?)||''', Cursor_SYS); end;'); END;
sql.proc_QUITAR_TICKET_KELLOGGS=BEGIN EXECUTE IMMEDIATE ('DECLARE Cursor_SYS Sys_Refcursor; BEGIN KELLOGGS.SP_QUITAR_TICKET( '''||(?)||''', '''||(?)||''', '''||(?)||''', Cursor_SYS); end;'); END;
sql.revisa_liquidada_Guna=SELECT COUNT(*) as liquidada FROM GUNA.HIST_VENTAS_DETALLE WHERE trunc(HVD_DTESYNC) = trunc(sysdate) and hvd_almacen = (?) and hvd_ruta = (?) AND (HVD_DESCUENTO != 0 or HVD_FECHA_AVION IS NOT NULL)
sql.revisa_liquidada_Kell=SELECT COUNT(*) as liquidada FROM KELLOGGS.HIST_VENTAS_DETALLE WHERE trunc(HVD_DTESYNC) = trunc(sysdate) and hvd_almacen = (?) and hvd_ruta = (?) and HVD_TIPOVENTA = (?) AND HVD_ESTATUS = 'Liquidado'
sql.select_todos_soporte=select cat_lo_usuario, cat_lo_estatus, cat_lo_nombre, cat_lo_contrasena, cat_lo_agencia, cat_agencias.cat_ag_nombre, cat_lo_ruta from cat_logins left join cat_agencias on cat_lo_agencia = cat_ag_id where (cat_lo_usuario LIKE ('%'||(?)||'%') or cat_lo_nombre LIKE ('%'||(?)||'%')) and cat_ag_nombre LIKE ('%'||(?)||'%') and cat_lo_ruta LIKE ('%'||(?)||'%') and rownum <= 20
sql.select_todosGUNA_soporte=select cat_lo_usuario, cat_lo_estatus, cat_lo_nombre, cat_lo_contrasena, cat_lo_agencia, cat_agencias.cat_ag_nombre, cat_ru_ruta from cat_logins left join cat_agencias on cat_lo_agencia = cat_ag_id left join cat_rutas on cat_lo_usuario = cat_ru_vendedor where (cat_lo_usuario LIKE ('%'||(?)||'%') or cat_lo_nombre LIKE ('%'||(?)||'%')) and cat_ag_nombre LIKE ('%'||(?)||'%') and cat_ru_ruta LIKE ('%'||(?)||'%') and rownum <= 20
sql.select_todosKELLOGGS_soporte=select cat_lo_usuario, cat_lo_estatus, cat_lo_nombre, cat_lo_contrasena, cat_lo_agencia, cat_agencias.cat_ag_nombre, cat_ru_ruta from KELLOGGS.cat_logins left join KELLOGGS.cat_agencias on cat_lo_agencia = cat_ag_id left join KELLOGGS.cat_rutas on cat_lo_usuario = cat_ru_vendedor where (cat_lo_usuario LIKE ('%'||(?)||'%') or cat_lo_nombre LIKE ('%'||(?)||'%')) and cat_ag_nombre LIKE ('%'||(?)||'%') and cat_ru_ruta LIKE ('%'||(?)||'%') and rownum <= 20
sql.select_todosSALMA_soporte=select cat_lo_usuario, cat_lo_estatus, cat_lo_nombre, cat_lo_contrasena, cat_lo_agencia, cat_agencias.cat_ag_nombre, cat_lo_ruta as cat_ru_ruta from SALMA.cat_logins left join SALMA.cat_agencias on cat_lo_agencia = cat_ag_id where (cat_lo_usuario LIKE ('%'||(?)||'%') or cat_lo_nombre LIKE ('%'||(?)||'%')) and cat_ag_nombre LIKE ('%'||(?)||'%') and cat_lo_ruta LIKE ('%'||(?)||'%') and rownum <= 20
sql.select_todosDANVIT_soporte=select cat_lo_usuario, cat_lo_estatus, cat_lo_nombre, cat_lo_contrasena, cat_lo_agencia, cat_agencias.cat_ag_nombre, cat_ru_ruta from DANVIT.cat_logins left join DANVIT.cat_agencias on cat_lo_agencia = cat_ag_id left join DANVIT.cat_rutas on cat_lo_usuario = cat_ru_vendedor where (cat_lo_usuario LIKE ('%'||(?)||'%') or cat_lo_nombre LIKE ('%'||(?)||'%')) and cat_ag_nombre LIKE ('%'||(?)||'%') and cat_ru_ruta LIKE ('%'||(?)||'%') and rownum <= 20
sql.select_ventaXrutaGuna_soporte=select hvd_ruta, sum(hvd_costo_tot) as monto, hvd_tipoventa from hist_ventas_detalle where trunc(hvd_fecha)=trunc(sysdate) and hvd_ruta=(?) and hvd_almacen=(?) AND hvd_codpromo <> 'BASICA' group by hvd_ruta, hvd_tipoventa
sql.select_ventaXrutaKelloggs_soporte=select hvd_ruta, sum(hvd_costo_tot) as monto, hvd_tipoventa from KELLOGGS.hist_ventas_detalle where trunc(hvd_fecha)=trunc(sysdate) and hvd_ruta=(?) and hvd_almacen=(?) and hvd_tipoventa=(?) AND hvd_codpromo <> 'BASICA' group by hvd_ruta, hvd_tipoventa
sql.select_ventaXrutaSalma_soporte=select hvd_ruta, sum(hvd_costo_tot) as monto, hvd_tipoventa from SALMA.hist_ventas_detalle where trunc(hvd_fecha)=trunc(sysdate) and hvd_ruta=(?) and hvd_almacen=(?) AND hvd_codpromo <> 'BASICA' group by hvd_ruta, hvd_tipoventa
sql.select_ventaXrutaDanvit_soporte=select hvd_ruta, sum(hvd_costo_tot) as monto, hvd_tipoventa from DANVIT.hist_ventas_detalle where trunc(hvd_fecha)=trunc(sysdate) and hvd_ruta=(?) and hvd_almacen=(?) AND hvd_codpromo <> 'BASICA' group by hvd_ruta, hvd_tipoventa
sql.select_prodsTicket_Kelloggs=SELECT HVD_CLIENTE CLIENTE, HVD_PROID PRODUCTO_ID, HVD_PRONOMBRE NOMBRE_PRODUCTO, HVD_CANT CANTIDAD, HVD_COSTO_TOT COSTO_TOTAL, HVD_RUTA RUTA, HVD_CODPROMO CODPROMO,NVL(HVD_TIPOVENTA,' ') TIPOVENTA, NVL(HVD_ESTATUS,' ') ESTATUS, hvd_cedis FROM KELLOGGS.HIST_VENTAS_DETALLE WHERE TRUNC(HVD_FECHA) = TRUNC(SYSDATE) AND HVD_ALMACEN = (?) AND HVD_CLIENTE = (?) and hvd_rechazo is null ORDER BY HVD_CODPROMO, HVD_PRONOMBRE

View File

@@ -1,57 +1,29 @@
#Lines starting with '#' are comments. #Lines starting with '#' are comments.
#Backslash character at the end of line means that the command continues in the next line. #Backslash character at the end of line means that the command continues in the next line.
DriverClass=oracle.jdbc.driver.OracleDriver
#JdbcUrl=jdbc:mysql://localhost/test?characterEncoding=utf8
#SQL Server #DATABASE CONFIGURATION
DriverClass=com.mysql.jdbc.Driver
JdbcUrl=jdbc:mysql://localhost/$DB$?characterEncoding=utf8
User=root
Password=
#Java server port
ServerPort=17178
#example of MS SQL Server configuration:
#DriverClass=net.sourceforge.jtds.jdbc.Driver #DriverClass=net.sourceforge.jtds.jdbc.Driver
#JdbcUrl=jdbc:jtds:sqlserver://<server address>/<database>
# este para produccion GHAN JdbcUrl=jdbc:oracle:thin:@//192.168.15.53:1521/DBKMT #example of postegres configuration:
#GOHAN ---> server #JdbcUrl=jdbc:postgresql://localhost/test
#JdbcUrl=jdbc:oracle:thin:@//10.0.0.205:1521/DBKMT #DriverClass=org.postgresql.Driver
#JdbcUrl=jdbc:oracle:thin:@//10.0.0.236:1521/DBKMT
JdbcUrl=jdbc:oracle:thin:@//192.168.101.10:1521/DBKMT?oracle.jdbc.defaultClientIdentifier=jRDC_Multi
# SVR-KEYMON-PRODUCCION--> Usuario
User=GUNA
Password=GUNAD2015M
#User=TORRADOCONAUTO
#Password=TORRADOCONAUTOD2016M
#--> Puertos
#SAC - DFR - MDA / GOHAN -->COBRANZA
#ServerPort=1783
#GUNA - SALMA - DURAKELO - DBC / SVR-KEYMON-PRODUCCION --> DISTRIBUIDORAS
ServerPort=9010
#CMG - TORRADO / TRUNKS -->COBRANZA/ GM
#ServerPort=1781
#If Debug is true then this file will be reloaded on every query.
#This is useful if you need to modify the queries.
Debug=true
#SQL COMMANDS #SQL COMMANDS
sql.create_table=CREATE TABLE IF NOT EXISTS animals (\
################## id INTEGER PRIMARY KEY AUTO_INCREMENT,\
################# name CHAR(30) NOT NULL,\
################ S O P O R T E image BLOB)
################# sql.insert_animal=INSERT INTO animals VALUES (null, ?,?)
################## sql.select_animal=SELECT name, image, id FROM animals WHERE id = ?;
sql.create_table=CREATE TABLE article (col1 numeric(10,4) ,col2 text);
sql.select_revisaClienteCredito_GUNA2=select (select count(CAT_CL_CODIGO) from GUNA.CAT_CLIENTES where CAT_CL_CODIGO = ? and CAT_CL_IDALMACEN <> '100') as cuantos, (select count(ID_CLIENTE) from GUNA.CAT_CLIENTES_CREDITO where ID_CLIENTE = ?) as cuantosCredito from DUAL sql.select=select * from article
sql.insert=INSERT INTO article VALUES(?, ?)
sql.traeConexion=select 'DB1' as conexion from dual
sql.traeConexion2=select 'DB1' as conexion from dual
sql.select_soporte=select * from GUNA.soporte
sql.select_conexion=SELECT 'OK' AS VALOR FROM DUAL
sql.selectAlmacen=select cat_al_id, cat_al_desc, cat_al_archftp from cat_almacen where cat_al_id = ?
sql.select_version=select cat_ve_version from cat_version
sql.select_version_GV2=select cat_ve_version from GUNA.cat_version
sql.update_usuario_guna_nobajas=UPDATE GUNA.CAT_LOGINS SET CAT_LO_ESTATUS = 'Activo',CAT_LO_CONECTADO ='0' WHERE CAT_LO_ESTATUS != 'Baja' and CAT_LO_USUARIO = (?)
sql.proc_usuario=BEGIN EXECUTE IMMEDIATE ('DECLARE Cursor_SYS Sys_Refcursor; BEGIN SP_ACTIVAR_USUARIO( '''||(?)||''',Cursor_SYS); end;'); END;

View File

@@ -1,21 +0,0 @@
<!DOCTYPE html>
<html lang="es">
<head>
<meta charset="UTF-8">
<title>Login jRDC Server</title>
<style>
body { font-family: sans-serif; display: flex; justify-content: center; align-items: center; height: 100vh; background-color: #f0f0f0; }
form { background: white; padding: 2em; border-radius: 8px; box-shadow: 0 4px 8px rgba(0,0,0,0.1); }
input { display: block; margin-bottom: 1em; padding: 0.5em; width: 200px; }
button { padding: 0.7em; width: 100%; border: none; background-color: #007bff; color: white; cursor: pointer; border-radius: 4px; }
</style>
</head>
<body>
<form action="/dologin" method="post">
<h2>Acceso al Manager</h2>
<input type="text" name="username" placeholder="Usuario" required>
<input type="password" name="password" placeholder="Contraseña" required>
<button type="submit">Entrar</button>
</form>
</body>
</html>

View File

@@ -4,6 +4,6 @@
set "params=%*" set "params=%*"
cd /d "%~dp0" && ( if exist "%temp%\getadmin.vbs" del "%temp%\getadmin.vbs" ) && fsutil dirty query %systemdrive% 1>nul 2>nul || ( echo Set UAC = CreateObject^("Shell.Application"^) : UAC.ShellExecute "cmd.exe", "/k cd ""%~sdp0"" && ""%~s0"" %params%", "", "runas", 1 >> "%temp%\getadmin.vbs" && "%temp%\getadmin.vbs" && exit /B ) cd /d "%~dp0" && ( if exist "%temp%\getadmin.vbs" del "%temp%\getadmin.vbs" ) && fsutil dirty query %systemdrive% 1>nul 2>nul || ( echo Set UAC = CreateObject^("Shell.Application"^) : UAC.ShellExecute "cmd.exe", "/k cd ""%~sdp0"" && ""%~s0"" %params%", "", "runas", 1 >> "%temp%\getadmin.vbs" && "%temp%\getadmin.vbs" && exit /B )
pm2 start RDC-Multi pm2 restart jRDC-Multi
exit exit

392
Files/www/manager.html Normal file
View File

@@ -0,0 +1,392 @@
<!DOCTYPE html>
<html lang="es">
<head>
<meta charset="UTF-8" />
<meta name="viewport" content="width=device-width, initial-scale=1.0" />
<title>jRDC2-Multi - Panel de Administración</title>
<style>
body {
font-family: -apple-system, BlinkMacSystemFont, "Segoe UI", Roboto,
Helvetica, Arial, sans-serif;
background-color: #f8f9fa;
color: #212529;
margin: 0;
padding: 0;
}
.admin-menu {
background-color: #e9ecef;
padding: 1.5em 2em;
border-bottom: 1px solid #dee2e6;
}
.admin-menu h2 {
margin: 0 0 0.2em 0;
color: #343a40;
}
.admin-menu p {
margin: 0 0 1em 0;
color: #495057;
}
.admin-menu a {
color: #007bff;
text-decoration: none;
font-weight: 500;
margin-right: 0.5em;
padding-right: 0.5em;
border-right: 1px solid #ccc;
cursor: pointer;
}
.admin-menu a:last-child {
border-right: none;
}
.admin-menu a:hover {
text-decoration: underline;
}
.main-content {
padding: 2em;
}
#output-container {
background: #fff;
padding: 1em;
border: 1px solid #eee;
border-radius: 8px;
font-family: monospace;
white-space: pre-wrap;
word-wrap: break-word;
min-height: 200px;
overflow-x: auto;
}
table {
width: 100%;
border-collapse: collapse;
margin-top: 1.5em;
font-family: sans-serif;
font-size: 0.9em;
}
th,
td {
padding: 10px 12px;
text-align: center;
border-bottom: 1px solid #dee2e6;
}
thead {
background-color: #007bff;
color: #fff;
}
th {
font-weight: 600;
cursor: help;
}
tbody td:first-child {
font-weight: bold;
color: #0056b3;
text-align: left;
}
/* --- ESTILOS PARA EL INDICADOR SSE --- */
.sse-status-container {
display: flex;
align-items: center;
margin-top: 1em;
font-size: 0.8em;
}
.sse-status {
display: inline-block;
padding: 4px 8px;
border-radius: 4px;
font-weight: bold;
margin-left: 10px;
min-width: 80px;
text-align: center;
}
.sse-connected {
background-color: #28a745;
color: white;
}
.sse-disconnected {
background-color: #dc3545;
color: white;
}
.sse-connecting {
background-color: #ffc107;
color: #212529;
}
.cell-update {
animation: flash 0.7s ease-out;
}
@keyframes flash {
0% {
background-color: #ffc107;
}
100% {
background-color: transparent;
}
}
</style>
</head>
<body>
<div class="admin-menu">
<h2>Panel de Administración jRDC</h2>
<p>Bienvenido, <strong>admin</strong></p>
<nav id="main-nav">
<a data-command="test">Test</a>
<a data-command="ping">Ping</a>
<a data-command="reload">Reload</a>
<a data-command="slowqueries">Queries Lentas</a>
<a data-command="getstats">Estadísticas Pool</a>
<a data-command="rpm2">Reiniciar (pm2)</a>
<a data-command="reviveBow">Revive Bow</a>
<a data-command="getconfiginfo">Info</a>
</nav>
<div class="sse-status-container">
<span>Estado de Estadísticas en Tiempo Real:</span>
<span id="sse-status" class="sse-status sse-disconnected"
>Desconectado</span
>
</div>
</div>
<div class="main-content">
<h1 id="content-title">Bienvenido</h1>
<div id="output-container">
<p style="font-family: sans-serif">
Selecciona una opción del menú para comenzar.
</p>
</div>
</div>
<script>
const outputContainer = document.getElementById("output-container");
const contentTitle = document.getElementById("content-title");
const sseStatus = document.getElementById("sse-status");
let sseConnection = null;
// --- CONFIGURACIÓN PARA LA TABLA DE ESTADÍSTICAS ---
const COLUMN_ORDER = [
"InitialPoolSize",
"MinPoolSize",
"MaxPoolSize",
"AcquireIncrement",
"TotalConnections",
"BusyConnections",
"IdleConnections",
"CheckoutTimeout",
"MaxIdleTime",
"MaxConnectionAge",
];
const HEADER_TOOLTIPS = {
InitialPoolSize:
"Número de conexiones que el pool intenta adquirir al arrancar.",
MinPoolSize: "Número mínimo de conexiones que el pool mantendrá.",
MaxPoolSize: "Número máximo de conexiones que el pool puede mantener.",
AcquireIncrement:
"Número de conexiones a adquirir cuando el pool se queda sin conexiones.",
TotalConnections: "Número total de conexiones (ocupadas + libres).",
BusyConnections: "Número de conexiones activamente en uso.",
IdleConnections: "Número de conexiones disponibles en el pool.",
CheckoutTimeout: "Tiempo máximo de espera por una conexión (ms).",
MaxIdleTime:
"Tiempo máximo que una conexión puede estar inactiva (segundos).",
MaxConnectionAge: "Tiempo máximo de vida de una conexión (segundos).",
};
// --- MANEJO DE LA CONEXIÓN SSE ---
function connectSSE() {
if (sseConnection && sseConnection.readyState !== EventSource.CLOSED) {
return; // Ya está conectado o conectando
}
outputContainer.innerHTML =
'<p style="font-family: sans-serif;">Esperando datos del pool de conexiones...</p>';
updateSSEStatus("connecting");
// La ruta debe coincidir con la que registraste en srvr.AddHandler
const SSE_ENDPOINT = "/stats-stream";
sseConnection = new EventSource(SSE_ENDPOINT);
sseConnection.onopen = () => {
console.log("Conexión SSE establecida.");
updateSSEStatus("connected");
};
// Escucha el evento específico "stats_update"
sseConnection.addEventListener("stats_update", (event) => {
try {
const data = JSON.parse(event.data);
renderOrUpdateStatsTable(data);
} catch (e) {
console.error("Error al parsear datos SSE:", e);
}
});
sseConnection.onerror = () => {
console.error("Error en la conexión SSE. Reintentando...");
updateSSEStatus("disconnected");
sseConnection.close();
// El navegador reintentará automáticamente la conexión
};
}
function disconnectSSE() {
if (sseConnection) {
sseConnection.close();
sseConnection = null;
console.log("Conexión SSE cerrada.");
updateSSEStatus("disconnected");
}
}
function updateSSEStatus(status) {
switch (status) {
case "connected":
sseStatus.textContent = "Conectado";
sseStatus.className = "sse-status sse-connected";
break;
case "connecting":
sseStatus.textContent = "Conectando";
sseStatus.className = "sse-status sse-connecting";
break;
case "disconnected":
sseStatus.textContent = "Desconectado";
sseStatus.className = "sse-status sse-disconnected";
break;
}
}
// --- RENDERIZADO Y ACTUALIZACIÓN DE LA TABLA ---
function renderOrUpdateStatsTable(data) {
const table = document.getElementById("stats-table");
// Si la tabla no existe, la crea
if (!table) {
outputContainer.innerHTML = createStatsTableHTML(data);
return;
}
// Si la tabla ya existe, solo actualiza las celdas
for (const dbKey in data) {
const poolData = data[dbKey];
COLUMN_ORDER.forEach((metric) => {
const cell = document.getElementById(`${dbKey}_${metric}`);
if (cell && cell.textContent != poolData[metric]) {
cell.textContent = poolData[metric];
cell.classList.add("cell-update");
setTimeout(() => cell.classList.remove("cell-update"), 700);
}
});
}
}
function createStatsTableHTML(data) {
let tableHtml = `<table id="stats-table"><thead><tr><th title="Nombre de la Base de Datos">DB Key</th>`;
COLUMN_ORDER.forEach((key) => {
tableHtml += `<th title="${HEADER_TOOLTIPS[key] || ""}">${key}</th>`;
});
tableHtml += `</tr></thead><tbody>`;
for (const dbKey in data) {
const poolData = data[dbKey];
tableHtml += `<tr><td>${dbKey}</td>`;
COLUMN_ORDER.forEach((metric) => {
// Se añade un ID único a cada celda: "DB1_TotalConnections"
tableHtml += `<td id="${dbKey}_${metric}">${
poolData[metric] ?? "N/A"
}</td>`;
});
tableHtml += `</tr>`;
}
tableHtml += `</tbody></table>`;
return tableHtml;
}
// --- MANEJO DE COMANDOS ESTÁTICOS (SIN CAMBIOS) ---
async function loadStaticContent(command) {
contentTitle.textContent = `Resultado del Comando: '${command}'`;
outputContainer.innerHTML = "Cargando...";
try {
const response = await fetch(`/manager?command=${command}`);
const responseText = await response.text();
if (!response.ok)
throw new Error(
`Error del servidor (${response.status}): ${responseText}`
);
const contentType = response.headers.get("content-type");
if (contentType && contentType.includes("application/json")) {
const data = JSON.parse(responseText);
if (command === "slowqueries") {
outputContainer.innerHTML = data.message
? `<p>${data.message}</p>`
: createTableFromJSON(data.data);
} else {
outputContainer.textContent = JSON.stringify(data, null, 2);
}
} else {
outputContainer.textContent = responseText;
}
} catch (error) {
outputContainer.textContent = `Error al procesar la respuesta:\n${error.message}`;
}
}
function createTableFromJSON(data) {
if (!data || data.length === 0)
return "<p>No se encontraron queries lentas.</p>";
const headers = Object.keys(data[0]);
let table = "<table><thead><tr>";
headers.forEach((h) => (table += `<th>${h.replace(/_/g, " ")}</th>`));
table += "</tr></thead><tbody>";
data.forEach((row) => {
table += "<tr>";
headers.forEach((h) => (table += `<td>${row[h]}</td>`));
table += "</tr>";
});
table += "</tbody></table>";
return table;
}
// --- EVENT LISTENER PRINCIPAL ---
document.getElementById("main-nav").addEventListener("click", (event) => {
if (event.target.tagName === "A") {
const command = event.target.dataset.command;
if (!command) return;
if (command === "reload") {
// Pedimos al usuario la DB Key. Si la deja vacía, se asume recarga total.
const dbKey = prompt(
"Ingrese la llave de la DB a recargar (ej: DB2, DB3). Deje vacío para recargar TODAS:",
""
);
if (dbKey === null) {
// El usuario presionó Cancelar o cerró la ventana. NO HACER NADA.
outputContainer.textContent = "Recarga cancelada por el usuario.";
contentTitle.textContent = "Administración";
return;
}
let finalCommand = "reload";
if (dbKey && dbKey.trim() !== "") {
// Si el usuario especificó una DB (ej. DB2), construimos el comando con el parámetro 'db'.
const key = dbKey.toUpperCase().trim();
finalCommand = `reload&db=${key}`;
outputContainer.innerHTML = `<p style="font-family: sans-serif;">Intentando recargar: <b>${key}</b> (Hot-Swap)...</p>`;
} else {
// Recarga total.
outputContainer.innerHTML = `<p style="font-family: sans-serif;">Intentando recargar: <b>TODAS</b> (Hot-Swap)...</p>`;
}
disconnectSSE();
// Llamamos a la función loadStaticContent con el comando completo (ej: 'reload&db=DB2' o 'reload')
loadStaticContent(finalCommand);
} else if (command === "getstats") {
contentTitle.textContent = `Estadísticas del Pool en Tiempo Real`;
connectSSE();
} else {
// Si se selecciona cualquier otro comando, se desconecta del SSE
disconnectSSE();
loadStaticContent(command);
}
}
});
</script>
</body>
</html>

View File

@@ -14,4 +14,5 @@ Sub Process_Globals
Public mpTotalRequests As Map Public mpTotalRequests As Map
Public mpTotalConnections As Map Public mpTotalConnections As Map
Public mpBlockConnection As Map Public mpBlockConnection As Map
Public ActiveRequestsCountByDB As Map ' Mapa para contar las peticiones activas por DB
End Sub End Sub

View File

@@ -1,609 +0,0 @@
B4J=true
Group=Default Group
ModulesStructureVersion=1
Type=Class
Version=10.3
@EndOfDesignText@
' Handler genérico para peticiones desde clientes B4A/B4i (DBRequestManager)
' Determina la base de datos a utilizar dinámicamente a partir de la URL de la petición.
' Versión con validación de parámetros y errores en texto plano.
Sub Class_Globals
' Estas constantes y variables solo se compilan si se usa la #if VERSION1,
' lo que sugiere que es para dar soporte a una versión antigua del protocolo de comunicación.
' #if VERSION1
' Constantes para identificar los tipos de datos en la serialización personalizada (protocolo V1).
Private const T_NULL = 0, T_STRING = 1, T_SHORT = 2, T_INT = 3, T_LONG = 4, T_FLOAT = 5 _
,T_DOUBLE = 6, T_BOOLEAN = 7, T_BLOB = 8 As Byte
' Utilidades para convertir entre tipos de datos y arrays de bytes.
Private bc As ByteConverter
' Utilidad para comprimir/descomprimir streams de datos (usado en V1).
Private cs As CompressedStreams
' #end if
' Mapa para convertir tipos de columna JDBC de fecha/hora a métodos de obtención de datos.
Private DateTimeMethods As Map
' Objeto que gestiona las conexiones a las diferentes bases de datos definidas en config.properties.
Private Connector As RDCConnector
End Sub
' Se ejecuta una vez cuando se crea una instancia de esta clase.
Public Sub Initialize
' Inicializa el mapa que asocia los códigos de tipo de columna de fecha/hora de JDBC
' con los nombres de los métodos correspondientes para leerlos correctamente.
DateTimeMethods = CreateMap(91: "getDate", 92: "getTime", 93: "getTimestamp")
End Sub
' Método principal que maneja cada petición HTTP que llega a este servlet.
Sub Handle(req As ServletRequest, resp As ServletResponse)
' === INICIO DE LA LÓGICA DINÁMICA ===
' Extrae la URI completa de la petición (ej. /DB1/endpoint).
Dim URI As String = req.RequestURI
' Variable para almacenar la "llave" o identificador de la base de datos (ej. "DB1").
Dim dbKey As String
' Comprueba si la URI tiene contenido y empieza con "/".
If URI.Length > 1 And URI.StartsWith("/") Then
' Extrae la parte de la URI que viene después del primer "/".
dbKey = URI.Substring(1)
' Si la llave contiene más "/", se queda solo con la primera parte.
' Esto permite URLs como /DB1/clientes o /DB2/productos, extrayendo "DB1" o "DB2".
If dbKey.Contains("/") Then
dbKey = dbKey.SubString2(0, dbKey.IndexOf("/"))
End If
Else
' Si la URI está vacía o es "/", usa "DB1" como la base de datos por defecto.
dbKey = "DB1"
End If
' Convierte la llave a mayúsculas para que no sea sensible a mayúsculas/minúsculas (ej. "db1" se convierte en "DB1").
dbKey = dbKey.ToUpperCase
' Verifica si la llave de la base de datos extraída existe en la configuración de conectores.
If Main.Connectors.ContainsKey(dbKey) = False Then
' Si no existe, crea un mensaje de error claro.
Dim ErrorMsg As String = $"Invalid DB key specified in URL: '${dbKey}'. Valid keys are: ${Main.listaDeCP}"$
' Registra el error en el log del servidor.
Log(ErrorMsg)
' Envía una respuesta de error 400 (Bad Request) al cliente en formato de texto plano.
SendPlainTextError(resp, 400, ErrorMsg)
' Termina la ejecución de este método.
Return
End If
' === FIN DE LA LÓGICA DINÁMICA ===
Log("********************* " & dbKey & " ********************")
' Guarda el tiempo de inicio para medir la duración de la petición.
Dim start As Long = DateTime.Now
' Variable para almacenar el nombre del comando SQL a ejecutar.
Dim q As String
' Obtiene el stream de entrada de la petición, que contiene los datos enviados por el cliente.
Dim in As InputStream = req.InputStream
' Obtiene el parámetro "method" de la URL (ej. ?method=query2).
Dim method As String = req.GetParameter("method")
' Obtiene el conector correspondiente a la base de datos seleccionada.
Connector = Main.Connectors.Get(dbKey)
' Declara la variable para la conexión a la base de datos.
Dim con As SQL
Try
' Obtiene una conexión del pool de conexiones.
con = Connector.GetConnection(dbKey)
Log("Metodo: " & method)
' Determina qué función ejecutar basándose en el parámetro "method".
If method = "query2" Then
' Ejecuta una consulta usando el protocolo más nuevo (B4XSerializator).
q = ExecuteQuery2(dbKey, con, in, resp)
'#if VERSION1
Else if method = "query" Then
' Protocolo antiguo: descomprime el stream y ejecuta la consulta.
in = cs.WrapInputStream(in, "gzip")
q = ExecuteQuery(dbKey, con, in, resp)
Else if method = "batch" Then
' Protocolo antiguo: descomprime el stream y ejecuta un lote de comandos.
in = cs.WrapInputStream(in, "gzip")
q = ExecuteBatch(dbKey, con, in, resp)
'#end if
Else if method = "batch2" Then
' Ejecuta un lote de comandos usando el protocolo más nuevo.
q = ExecuteBatch2(dbKey, con, in, resp)
Else
' Si el método es desconocido, lo registra y envía un error.
Log("Unknown method: " & method)
SendPlainTextError(resp, 500, "unknown method")
End If
Catch
' Si ocurre cualquier error en el bloque Try, lo captura.
Log(LastException)
' Envía un error 500 (Internal Server Error) al cliente con el mensaje de la excepción.
SendPlainTextError(resp, 500, LastException.Message)
End Try
' Asegura que la conexión a la BD se cierre y se devuelva al pool.
If con <> Null And con.IsInitialized Then con.Close
' Registra en el log el comando ejecutado, cuánto tiempo tardó y la IP del cliente.
Log($"Command: ${q}, took: ${DateTime.Now - start}ms, client=${req.RemoteAddress}"$)
End Sub
' Ejecuta una consulta única usando el protocolo V2 (B4XSerializator).
Private Sub ExecuteQuery2 (DB As String, con As SQL, in As InputStream, resp As ServletResponse) As String
' Objeto para deserializar los datos enviados desde el cliente.
Dim ser As B4XSerializator
' Convierte el stream de entrada a un array de bytes y luego a un objeto Mapa.
Dim m As Map = ser.ConvertBytesToObject(Bit.InputStreamToBytes(in))
' Extrae el objeto DBCommand del mapa.
Dim cmd As DBCommand = m.Get("command")
' Extrae el límite de filas a devolver.
Dim limit As Int = m.Get("limit")
' Obtiene la sentencia SQL correspondiente al nombre del comando desde config.properties.
Dim sqlCommand As String = Connector.GetCommand(DB, cmd.Name)
' <<< INICIO NUEVA VALIDACIÓN: VERIFICAR SI EL COMANDO EXISTE >>>
' Comprueba si el comando no fue encontrado en el archivo de configuración.
If sqlCommand = Null Or sqlCommand = "null" Or sqlCommand.Trim = "" Then
Dim errorMessage As String = $"El comando '${cmd.Name}' no fue encontrado en el config.properties de '${DB}'."$
Log(errorMessage)
' Envía un error 400 (Bad Request) al cliente informando del problema.
SendPlainTextError(resp, 400, errorMessage)
Return "error" ' Retorna un texto para el log.
End If
' <<< FIN NUEVA VALIDACIÓN >>>
' --- INICIO VALIDACIÓN DE PARÁMETROS ---
' Comprueba si el SQL espera parámetros o si se recibieron parámetros.
If sqlCommand.Contains("?") Or (cmd.Parameters <> Null And cmd.Parameters.Length > 0) Then
' Cuenta cuántos '?' hay en la sentencia SQL para saber cuántos parámetros se esperan.
Dim expectedParams As Int = sqlCommand.Length - sqlCommand.Replace("?", "").Length
' Cuenta cuántos parámetros se recibieron.
Dim receivedParams As Int
If cmd.Parameters = Null Then receivedParams = 0 Else receivedParams = cmd.Parameters.Length
' Compara el número de parámetros esperados con los recibidos.
If expectedParams <> receivedParams Then
Dim errorMessage As String = $"Número de parametros equivocado para "${cmd.Name}". Se esperaban ${expectedParams} y se recibieron ${receivedParams}."$
Log(errorMessage)
' Si no coinciden, envía un error 400 al cliente.
SendPlainTextError(resp, 400, errorMessage)
Return "error"
End If
End If
' --- FIN VALIDACIÓN ---
' Ejecuta la consulta SQL con los parámetros proporcionados.
Dim rs As ResultSet = con.ExecQuery2(sqlCommand, cmd.Parameters)
' Si el límite es 0 o negativo, lo establece a un valor muy alto (máximo entero).
If limit <= 0 Then limit = 0x7fffffff 'max int
' Obtiene el objeto Java subyacente del ResultSet para acceder a métodos adicionales.
Dim jrs As JavaObject = rs
' Obtiene los metadatos del ResultSet (información sobre las columnas).
Dim rsmd As JavaObject = jrs.RunMethod("getMetaData", Null)
' Obtiene el número de columnas del resultado.
Dim cols As Int = rs.ColumnCount
' Crea un objeto DBResult para empaquetar la respuesta.
Dim res As DBResult
res.Initialize
res.columns.Initialize
res.Tag = Null
' Llena el mapa de columnas con el nombre de cada columna y su índice.
For i = 0 To cols - 1
res.columns.Put(rs.GetColumnName(i), i)
Next
' Inicializa la lista de filas.
res.Rows.Initialize
' Itera sobre cada fila del ResultSet, hasta llegar al límite.
Do While rs.NextRow And limit > 0
Dim row(cols) As Object
' Itera sobre cada columna de la fila actual.
For i = 0 To cols - 1
' Obtiene el tipo de dato de la columna según JDBC.
Dim ct As Int = rsmd.RunMethod("getColumnType", Array(i + 1))
' Maneja diferentes tipos de datos para leerlos de la forma correcta.
If ct = -2 Or ct = 2004 Or ct = -3 Or ct = -4 Then ' Tipos BLOB/binarios
row(i) = rs.GetBlob2(i)
Else If ct = 2005 Then ' Tipo CLOB (texto largo)
row(i) = rs.GetString2(i)
Else if ct = 2 Or ct = 3 Then ' Tipos numéricos que pueden tener decimales
row(i) = rs.GetDouble2(i)
Else If DateTimeMethods.ContainsKey(ct) Then ' Tipos de Fecha/Hora
' Obtiene el objeto de tiempo/fecha de Java.
Dim SQLTime As JavaObject = jrs.RunMethodJO(DateTimeMethods.Get(ct), Array(i + 1))
If SQLTime.IsInitialized Then
' Lo convierte a milisegundos (Long) para B4X.
row(i) = SQLTime.RunMethod("getTime", Null)
Else
row(i) = Null
End If
Else ' Para todos los demás tipos de datos
' Usa getObject que funciona para la mayoría de los tipos estándar.
row(i) = jrs.RunMethod("getObject", Array(i + 1))
End If
Next
' Añade la fila completa a la lista de resultados.
res.Rows.Add(row)
limit = limit - 1
Loop
' Cierra el ResultSet para liberar recursos.
rs.Close
' Serializa el objeto DBResult completo a un array de bytes.
Dim data() As Byte = ser.ConvertObjectToBytes(res)
' Escribe los datos serializados en el stream de respuesta.
resp.OutputStream.WriteBytes(data, 0, data.Length)
' Devuelve el nombre del comando para el log.
Return "query: " & cmd.Name
End Sub
' Ejecuta un lote de comandos (INSERT, UPDATE, DELETE) usando el protocolo V2.
Private Sub ExecuteBatch2(DB As String, con As SQL, in As InputStream, resp As ServletResponse) As String
Dim ser As B4XSerializator
' Deserializa el mapa que contiene la lista de comandos.
Dim m As Map = ser.ConvertBytesToObject(Bit.InputStreamToBytes(in))
' Obtiene la lista de objetos DBCommand.
Dim commands As List = m.Get("commands")
' Prepara un objeto DBResult para la respuesta (aunque para batch no devuelve datos, solo confirmación).
Dim res As DBResult
res.Initialize
res.columns = CreateMap("AffectedRows (N/A)": 0)
res.Rows.Initialize
res.Tag = Null
Try
' Inicia una transacción. Todos los comandos del lote se ejecutarán como una unidad.
con.BeginTransaction
' Itera sobre cada comando en la lista.
For Each cmd As DBCommand In commands
' Obtiene la sentencia SQL para el comando actual.
Dim sqlCommand As String = Connector.GetCommand(DB, cmd.Name)
' <<< INICIO NUEVA VALIDACIÓN: VERIFICAR SI EL COMANDO EXISTE DENTRO DEL BATCH >>>
If sqlCommand = Null Or sqlCommand = "null" Or sqlCommand.Trim = "" Then
con.Rollback ' Deshace la transacción si un comando es inválido.
Dim errorMessage As String = $"El comando '${cmd.Name}' no fue encontrado en el config.properties de '${DB}'."$
Log(errorMessage)
SendPlainTextError(resp, 400, errorMessage)
Return "error"
End If
' <<< FIN NUEVA VALIDACIÓN >>>
' --- INICIO VALIDACIÓN DE PARÁMETROS DENTRO DEL BATCH ---
If sqlCommand.Contains("?") Or (cmd.Parameters <> Null And cmd.Parameters.Length > 0) Then
Dim expectedParams As Int = sqlCommand.Length - sqlCommand.Replace("?", "").Length
Dim receivedParams As Int
If cmd.Parameters = Null Then receivedParams = 0 Else receivedParams = cmd.Parameters.Length
' Si el número de parámetros no coincide, deshace la transacción y envía error.
If expectedParams <> receivedParams Then
con.Rollback
Dim errorMessage As String = $"Número de parametros equivocado para "${cmd.Name}". Se esperaban ${expectedParams} y se recibieron ${receivedParams}."$
Log(errorMessage)
SendPlainTextError(resp, 400, errorMessage)
Return "error"
End If
End If
' --- FIN VALIDACIÓN ---
' Ejecuta el comando (no es una consulta, no devuelve filas).
con.ExecNonQuery2(sqlCommand, cmd.Parameters)
Next
' Añade una fila simbólica al resultado para indicar éxito.
res.Rows.Add(Array As Object(0))
' Si todos los comandos se ejecutaron sin error, confirma la transacción.
con.TransactionSuccessful
Catch
' Si cualquier comando falla, se captura el error.
con.Rollback ' Se deshacen todos los cambios hechos en la transacción.
Log(LastException)
SendPlainTextError(resp, 500, LastException.Message)
End Try
' Serializa y envía la respuesta al cliente.
Dim data() As Byte = ser.ConvertObjectToBytes(res)
resp.OutputStream.WriteBytes(data, 0, data.Length)
' Devuelve un resumen para el log.
Return $"batch (size=${commands.Size})"$
End Sub
' Código compilado condicionalmente para el protocolo antiguo (V1).
'#if VERSION1
' Ejecuta un lote de comandos usando el protocolo V1.
Private Sub ExecuteBatch(DB As String, con As SQL, in As InputStream, resp As ServletResponse) As String
' Lee y descarta la versión del cliente.
Dim clientVersion As Float = ReadObject(in) 'ignore
' Lee cuántos comandos vienen en el lote.
Dim numberOfStatements As Int = ReadInt(in)
Dim res(numberOfStatements) As Int ' Array para resultados (aunque no se usa).
Try
con.BeginTransaction
' Itera para procesar cada comando del lote.
For i = 0 To numberOfStatements - 1
' Lee el nombre del comando y la lista de parámetros usando el deserializador V1.
Dim queryName As String = ReadObject(in)
Dim params As List = ReadList(in)
Dim sqlCommand As String = Connector.GetCommand(DB, queryName)
' <<< INICIO NUEVA VALIDACIÓN: VERIFICAR SI EL COMANDO EXISTE (V1) >>>
If sqlCommand = Null Or sqlCommand = "null" Or sqlCommand.Trim = "" Then
con.Rollback
Dim errorMessage As String = $"El comando '${queryName}' no fue encontrado en el config.properties de '${DB}'."$
Log(errorMessage)
SendPlainTextError(resp, 400, errorMessage)
Return "error"
End If
' <<< FIN NUEVA VALIDACIÓN >>>
' --- INICIO VALIDACIÓN DE PARÁMETROS DENTRO DEL BATCH (V1) ---
If sqlCommand.Contains("?") Or (params <> Null And params.Size > 0) Then
Dim expectedParams As Int = sqlCommand.Length - sqlCommand.Replace("?", "").Length
Dim receivedParams As Int
If params = Null Then receivedParams = 0 Else receivedParams = params.Size
If expectedParams <> receivedParams Then
con.Rollback
Dim errorMessage As String = $"Número de parametros equivocado para "${queryName}". Se esperaban ${expectedParams} y se recibieron ${receivedParams}."$
Log(errorMessage)
SendPlainTextError(resp, 400, errorMessage)
Return "error"
End If
End If
' --- FIN VALIDACIÓN ---
' Ejecuta el comando.
con.ExecNonQuery2(sqlCommand, params)
Next
' Confirma la transacción.
con.TransactionSuccessful
' Comprime la salida antes de enviarla.
Dim out As OutputStream = cs.WrapOutputStream(resp.OutputStream, "gzip")
' Escribe la respuesta usando el serializador V1.
WriteObject(Main.VERSION, out)
WriteObject("batch", out)
WriteInt(res.Length, out)
For Each r As Int In res
WriteInt(r, out)
Next
out.Close
Catch
con.Rollback
Log(LastException)
SendPlainTextError(resp, 500, LastException.Message)
End Try
Return $"batch (size=${numberOfStatements})"$
End Sub
' Ejecuta una consulta única usando el protocolo V1.
Private Sub ExecuteQuery(DB As String, con As SQL, in As InputStream, resp As ServletResponse) As String
Log("====================== ExecuteQuery =====================")
' Deserializa los datos de la petición usando el protocolo V1.
Dim clientVersion As Float = ReadObject(in) 'ignore
Dim queryName As String = ReadObject(in)
Dim limit As Int = ReadInt(in)
Dim params As List = ReadList(in)
' Obtiene la sentencia SQL.
Dim theSql As String = Connector.GetCommand(DB, queryName)
' Log(444 & "|" & theSql)
' <<< INICIO NUEVA VALIDACIÓN: VERIFICAR SI EL COMANDO EXISTE (V1) >>>
If theSql = Null Or theSql ="null" Or theSql.Trim = "" Then
Dim errorMessage As String = $"El comando '${queryName}' no fue encontrado en el config.properties de '${DB}'."$
Log(errorMessage)
SendPlainTextError(resp, 400, errorMessage)
Return "error"
End If
' <<< FIN NUEVA VALIDACIÓN >>>
' --- INICIO VALIDACIÓN DE PARÁMETROS (V1) ---
If theSql.Contains("?") Or (params <> Null And params.Size > 0) Then
Dim expectedParams As Int = theSql.Length - theSql.Replace("?", "").Length
Dim receivedParams As Int
If params = Null Then receivedParams = 0 Else receivedParams = params.Size
If expectedParams <> receivedParams Then
Dim errorMessage As String = $"Número de parametros equivocado para "${queryName}". Se esperaban ${expectedParams} y se recibieron ${receivedParams}."$
Log(errorMessage)
SendPlainTextError(resp, 400, errorMessage)
Return "error"
End If
End If
' --- FIN VALIDACIÓN ---
' Ejecuta la consulta.
Dim rs As ResultSet = con.ExecQuery2(theSql, params)
If limit <= 0 Then limit = 0x7fffffff 'max int
Dim jrs As JavaObject = rs
Dim rsmd As JavaObject = jrs.RunMethod("getMetaData", Null)
Dim cols As Int = rs.ColumnCount
' Comprime el stream de salida.
Dim out As OutputStream = cs.WrapOutputStream(resp.OutputStream, "gzip")
' Escribe la cabecera de la respuesta V1.
WriteObject(Main.VERSION, out)
WriteObject("query", out)
WriteInt(rs.ColumnCount, out)
' Escribe los nombres de las columnas.
For i = 0 To cols - 1
WriteObject(rs.GetColumnName(i), out)
Next
' Itera sobre las filas del resultado.
Do While rs.NextRow And limit > 0
' Escribe un byte '1' para indicar que viene una fila.
WriteByte(1, out)
' Itera sobre las columnas de la fila.
For i = 0 To cols - 1
Dim ct As Int = rsmd.RunMethod("getColumnType", Array(i + 1))
' Maneja los tipos de datos binarios de forma especial.
If ct = -2 Or ct = 2004 Or ct = -3 Or ct = -4 Then
WriteObject(rs.GetBlob2(i), out)
Else
' Escribe el valor de la columna.
WriteObject(jrs.RunMethod("getObject", Array(i + 1)), out)
End If
Next
limit = limit - 1
Loop
' Escribe un byte '0' para indicar el fin de las filas.
WriteByte(0, out)
out.Close
rs.Close
Return "query: " & queryName
End Sub
' Escribe un único byte en el stream de salida.
Private Sub WriteByte(value As Byte, out As OutputStream)
out.WriteBytes(Array As Byte(value), 0, 1)
End Sub
' Serializador principal para el protocolo V1. Escribe un objeto al stream.
Private Sub WriteObject(o As Object, out As OutputStream)
Dim data() As Byte
' Escribe un byte de tipo seguido de los datos.
If o = Null Then
out.WriteBytes(Array As Byte(T_NULL), 0, 1)
Else If o Is Short Then
out.WriteBytes(Array As Byte(T_SHORT), 0, 1)
data = bc.ShortsToBytes(Array As Short(o))
Else If o Is Int Then
out.WriteBytes(Array As Byte(T_INT), 0, 1)
data = bc.IntsToBytes(Array As Int(o))
Else If o Is Float Then
out.WriteBytes(Array As Byte(T_FLOAT), 0, 1)
data = bc.FloatsToBytes(Array As Float(o))
Else If o Is Double Then
out.WriteBytes(Array As Byte(T_DOUBLE), 0, 1)
data = bc.DoublesToBytes(Array As Double(o))
Else If o Is Long Then
out.WriteBytes(Array As Byte(T_LONG), 0, 1)
data = bc.LongsToBytes(Array As Long(o))
Else If o Is Boolean Then
out.WriteBytes(Array As Byte(T_BOOLEAN), 0, 1)
Dim b As Boolean = o
Dim data(1) As Byte
If b Then data(0) = 1 Else data(0) = 0
Else If GetType(o) = "[B" Then ' Si el objeto es un array de bytes (BLOB)
data = o
out.WriteBytes(Array As Byte(T_BLOB), 0, 1)
' Escribe la longitud de los datos antes de los datos mismos.
WriteInt(data.Length, out)
Else ' Trata todo lo demás como un String
out.WriteBytes(Array As Byte(T_STRING), 0, 1)
data = bc.StringToBytes(o, "UTF8")
' Escribe la longitud del string antes del string.
WriteInt(data.Length, out)
End If
' Escribe los bytes del dato.
If data.Length > 0 Then out.WriteBytes(data, 0, data.Length)
End Sub
' Deserializador principal para el protocolo V1. Lee un objeto del stream.
Private Sub ReadObject(In As InputStream) As Object
' Lee el primer byte para determinar el tipo de dato.
Dim data(1) As Byte
In.ReadBytes(data, 0, 1)
Select data(0)
Case T_NULL
Return Null
Case T_SHORT
Dim data(2) As Byte
Return bc.ShortsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_INT
Dim data(4) As Byte
Return bc.IntsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_LONG
Dim data(8) As Byte
Return bc.LongsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_FLOAT
Dim data(4) As Byte
Return bc.FloatsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_DOUBLE
Dim data(8) As Byte
Return bc.DoublesFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_BOOLEAN
Dim b As Byte = ReadByte(In)
Return b = 1
Case T_BLOB
' Lee la longitud, luego lee esa cantidad de bytes.
Dim len As Int = ReadInt(In)
Dim data(len) As Byte
Return ReadBytesFully(In, data, data.Length)
Case Else ' T_STRING
' Lee la longitud, luego lee esa cantidad de bytes y los convierte a string.
Dim len As Int = ReadInt(In)
Dim data(len) As Byte
ReadBytesFully(In, data, data.Length)
Return BytesToString(data, 0, data.Length, "UTF8")
End Select
End Sub
' Se asegura de leer exactamente la cantidad de bytes solicitada del stream.
Private Sub ReadBytesFully(In As InputStream, Data() As Byte, Len As Int) As Byte()
Dim count = 0, Read As Int
' Sigue leyendo en un bucle hasta llenar el buffer, por si los datos llegan en partes.
Do While count < Len And Read > -1
Read = In.ReadBytes(Data, count, Len - count)
count = count + Read
Loop
Return Data
End Sub
' Escribe un entero (4 bytes) en el stream.
Private Sub WriteInt(i As Int, out As OutputStream)
Dim data() As Byte
data = bc.IntsToBytes(Array As Int(i))
out.WriteBytes(data, 0, data.Length)
End Sub
' Lee un entero (4 bytes) del stream.
Private Sub ReadInt(In As InputStream) As Int
Dim data(4) As Byte
Return bc.IntsFromBytes(ReadBytesFully(In, data, data.Length))(0)
End Sub
' Lee un solo byte del stream.
Private Sub ReadByte(In As InputStream) As Byte
Dim data(1) As Byte
In.ReadBytes(data, 0, 1)
Return data(0)
End Sub
' Lee una lista de objetos del stream (protocolo V1).
Private Sub ReadList(in As InputStream) As List
' Primero lee la cantidad de elementos en la lista.
Dim len As Int = ReadInt(in)
Dim l1 As List
l1.Initialize
' Luego lee cada objeto uno por uno y lo añade a la lista.
For i = 0 To len - 1
l1.Add(ReadObject(in))
Next
Return l1
End Sub
'#end If
' Envía una respuesta de error en formato de texto plano.
' Esto evita la página de error HTML por defecto que genera resp.SendError.
' resp: El objeto ServletResponse para enviar la respuesta.
' statusCode: El código de estado HTTP (ej. 400 para Bad Request, 500 para Internal Server Error).
' errorMessage: El mensaje de error que se enviará al cliente.
Private Sub SendPlainTextError(resp As ServletResponse, statusCode As Int, errorMessage As String)
Try
' Establece el código de estado HTTP (ej. 400, 500).
resp.Status = statusCode
' Define el tipo de contenido como texto plano, con codificación UTF-8 para soportar acentos.
resp.ContentType = "text/plain; charset=utf-8"
' Obtiene el OutputStream de la respuesta para escribir los datos directamente.
Dim out As OutputStream = resp.OutputStream
' Convierte el mensaje de error a un array de bytes usando UTF-8.
Dim data() As Byte = errorMessage.GetBytes("UTF8")
' Escribe los bytes en el stream de salida.
out.WriteBytes(data, 0, data.Length)
' Cierra el stream para asegurar que todos los datos se envíen correctamente.
out.Close
Catch
' Si algo falla al intentar enviar la respuesta de error, lo registra en el log
' para que no se pierda la causa original del problema.
Log("Error sending plain text error response: " & LastException)
End Try
End Sub

View File

@@ -2,296 +2,474 @@
Group=Default Group Group=Default Group
ModulesStructureVersion=1 ModulesStructureVersion=1
Type=Class Type=Class
Version=8.8 Version=10.3
@EndOfDesignText@ @EndOfDesignText@
'Handler class ' Módulo de clase: Manager
' Este handler proporciona un panel de administración web para el servidor jRDC2-Multi.
' Permite monitorear el estado del servidor, recargar configuraciones de bases de datos,
' ver estadísticas de rendimiento, reiniciar servicios externos, y gestionar la autenticación de usuarios.
Sub Class_Globals Sub Class_Globals
' Objeto para generar respuestas JSON. Se utiliza para mostrar mapas de datos de forma legible.
Dim j As JSONGenerator Dim j As JSONGenerator
' Dim rdcc As RDCConnector ' La clase BCrypt no se usa directamente en este módulo, pero se mantiene si hubiera planes futuros.
' Private bc As BCrypt
End Sub End Sub
' Subrutina de inicialización de la clase. Se llama cuando se crea un objeto de esta clase.
Public Sub Initialize Public Sub Initialize
' No se requiere inicialización específica para esta clase en este momento.
End Sub End Sub
' Método principal que maneja las peticiones HTTP para el panel de administración.
' req: El objeto ServletRequest que contiene la información de la petición entrante.
' resp: El objeto ServletResponse para construir y enviar la respuesta al cliente.
' Módulo de clase: Manager
' ... (tu código de Class_Globals e Initialize se queda igual) ...
' Método principal que maneja las peticiones HTTP para el panel de administración.
' Refactorizado para funcionar como una API con un frontend estático.
Sub Handle(req As ServletRequest, resp As ServletResponse) Sub Handle(req As ServletRequest, resp As ServletResponse)
' 1. --- Bloque de Seguridad ---
' --- 1. Bloque de Seguridad ---
If req.GetSession.GetAttribute2("user_is_authorized", False) = False Then If req.GetSession.GetAttribute2("user_is_authorized", False) = False Then
resp.SendRedirect("/login") resp.SendRedirect("/login")
Return Return
End If End If
Dim Command As String = req.GetParameter("command") Dim Command As String = req.GetParameter("command")
If Command = "" Then Command = "ping"
Log($"Command: ${Command}"$)
' --- MANEJO ESPECIAL PARA SNAPSHOT --- ' --- 2. Servidor de la Página Principal ---
' El comando "snapshot" no devuelve HTML, sino una imagen. Lo manejamos por separado al principio. If Command = "" Then
If Command = "snapshot" Then
Try Try
resp.ContentType = "image/png" resp.ContentType = "text/html; charset=utf-8"
Dim robot, toolkit As JavaObject resp.Write(File.ReadString(File.DirApp, "www/manager.html"))
robot.InitializeNewInstance("java.awt.Robot", Null)
toolkit.InitializeStatic("java.awt.Toolkit")
Dim screenRect As JavaObject
screenRect.InitializeNewInstance("java.awt.Rectangle", Array As Object( _
toolkit.RunMethodJO("getDefaultToolkit", Null).RunMethod("getScreenSize", Null)))
Dim image As JavaObject = robot.RunMethod("createScreenCapture", Array As Object(screenRect))
Dim ImageIO As JavaObject
ImageIO.InitializeStatic("javax.imageio.ImageIO").RunMethod("write", Array As Object(image, "png", resp.OutputStream))
Catch Catch
resp.SendError(500, LastException.Message) resp.SendError(500, "Error: No se pudo encontrar el archivo principal del panel (www/manager.html). " & LastException.Message)
End Try End Try
Return ' Detenemos la ejecución aquí para no enviar más HTML. Return
End If End If
' --- FIN DE MANEJO ESPECIAL ---
' Para todos los demás comandos, construimos la página HTML ' --- 3. Manejo de Comandos como API ---
resp.ContentType = "text/html" Select Command.ToLowerCase
Dim sb As StringBuilder
sb.Initialize ' --- Comandos que devuelven JSON (Métricas del Pool) ---
Case "getstatsold"
' --- Estilos y JavaScript (igual que antes) --- resp.ContentType = "application/json; charset=utf-8"
sb.Append("<html><head><style>") Dim allPoolStats As Map
sb.Append("body {font-family: sans-serif; margin: 2em; background-color: #f9f9f9;} ") allPoolStats.Initialize
sb.Append("h1, h2 {color: #333;} hr {margin: 2em 0; border: 0; border-top: 1px solid #ddd;} ") For Each dbKey As String In Main.listaDeCP
sb.Append("input {display: block; width: 95%; padding: 8px; margin-bottom: 10px; border: 1px solid #ccc; border-radius: 4px;} ") Dim connector As RDCConnector = Main.Connectors.Get(dbKey)
sb.Append("button {padding: 10px 15px; border: none; background-color: #007bff; color: white; cursor: pointer; border-radius: 4px; margin-right: 1em;} ") If connector.IsInitialized Then
sb.Append(".nav a, .logout a {text-decoration: none; margin-right: 10px; color: #007bff;} ") allPoolStats.Put(dbKey, connector.GetPoolStats)
sb.Append(".output {background: #fff; padding: 1em; border: 1px solid #eee; border-radius: 8px; font-family: monospace; white-space: pre-wrap; word-wrap: break-word;} ") Else
sb.Append("#changePassForm {background: #f0f0f0; padding: 1.5em; border-radius: 8px; max-width: 400px; margin-top: 1em;} ") allPoolStats.Put(dbKey, CreateMap("Error": "Conector no inicializado"))
sb.Append("</style>") End If
sb.Append("<script>function toggleForm() {var form = document.getElementById('changePassForm'); if (form.style.display === 'none') {form.style.display = 'block';} else {form.style.display = 'none';}}</script>")
sb.Append("</head><body>")
' --- Cabecera, Botón y Formulario Oculto (igual que antes) ---
sb.Append("<h1>Panel de Administración jRDC</h1>")
sb.Append($"Bienvenido, <b>${req.GetSession.GetAttribute("username")}</b><br>"$)
sb.Append("<p class='nav'><a href='/manager?command=test'>Test</a> | <a href='/manager?command=ping'>Ping</a> | <a href='/manager?command=reload'>Reload</a> | <a href='/manager?command=rpm2'>Reiniciar (pm2)</a> | <a href='/manager?command=reviveBow'>Revive Bow</a></p><hr>")
' sb.Append("<button onclick='toggleForm()'>Cambiar Contraseña</button>")
sb.Append("<div id='changePassForm' style='display:none;'>")
sb.Append("<h2>Cambiar Contraseña</h2><form action='/changepass' method='post'>")
sb.Append("Contraseña Actual: <input type='password' name='current_password' required><br>")
sb.Append("Nueva Contraseña: <input type='password' name='new_password' required><br>")
sb.Append("Confirmar Nueva Contraseña: <input type='password' name='confirm_password' required><br>")
sb.Append("<button type='submit'>Actualizar Contraseña</button> <button onclick='toggleForm()'>Cancelar</button></form></div>")
' --- Resultado del Comando ---
sb.Append("<h2>Resultado del Comando: '" & Command & "'</h2>")
sb.Append("<div class='output'>")
' =========================================================================
' ### INICIO DE TU LÓGICA DE COMANDOS INTEGRADA ###
' =========================================================================
If Command = "reload" Then
Private estaDB As String = ""
For i = 0 To Main.listaDeCP.Size - 1
Main.Connectors.Get(Main.listaDeCP.get(i)).As(RDCConnector).Initialize(Main.listaDeCP.get(i))
If Main.listaDeCP.get(i) <> "DB1" Then estaDB = "." & Main.listaDeCP.get(i) Else estaDB = ""
sb.Append($"Recargando config${estaDB}.properties ($DateTime{DateTime.Now})<br/>"$)
sb.Append($"Queries en config.properties: <b>${Main.Connectors.Get(Main.listaDeCP.get(i)).As(RDCConnector).commands.Size}</b><br/>"$)
sb.Append($"<b>JdbcUrl:</b> ${Main.Connectors.Get(Main.listaDeCP.get(i)).As(RDCConnector).config.Get("JdbcUrl")}</b><br/>"$)
sb.Append($"<b>User:</b> ${Main.Connectors.Get(Main.listaDeCP.get(i)).As(RDCConnector).config.Get("User")}</b><br/>"$)
sb.Append($"<b>ServerPort:</b> ${Main.srvr.Port}</b><br/><br/>"$)
Next
Else If Command = "test" Then
Try
Dim con As SQL = Main.Connectors.Get("DB1").As(RDCConnector).GetConnection("")
sb.Append("Connection successful.</br></br>")
Private estaDB As String = ""
Log(Main.listaDeCP)
For i = 0 To Main.listaDeCP.Size - 1
If Main.listaDeCP.get(i) <> "" Then estaDB = "." & Main.listaDeCP.get(i)
sb.Append($"Using config${estaDB}.properties<br/>"$)
Next Next
con.Close j.Initialize(allPoolStats)
Catch resp.Write(j.ToString)
resp.Write("Error fetching connection.") Return
End Try
Else If Command = "stop" Then Case "getstats"
' Public shl As Shell... resp.ContentType = "application/json; charset=utf-8"
Else If Command = "rsx" Then Dim allPoolStats As Map
Log($"Ejecutamos ${File.DirApp}\start.bat"$)
sb.Append($"Ejecutamos ${File.DirApp}\start.bat"$) ' Leemos del caché global actualizado por el Timer SSE
' Public shl As Shell... allPoolStats = Main.LatestPoolStats
Else If Command = "rpm2" Then
Log($"Ejecutamos ${File.DirApp}\reiniciaProcesoPM2.bat"$) For Each dbKey As String In Main.listaDeCP
sb.Append($"Ejecutamos ${File.DirApp}\reiniciaProcesoPM2.bat"$) If allPoolStats.ContainsKey(dbKey) = False Then
' Public shl As Shell... allPoolStats.Put(dbKey, CreateMap("Error": "Métricas no disponibles/Pool no inicializado"))
Else If Command = "reviveBow" Then End If
Log($"Ejecutamos ${File.DirApp}\reiniciaProcesoBow.bat"$) Next
sb.Append($"Ejecutamos ${File.DirApp}\reiniciaProcesoBow.bat<br><br>"$)
sb.Append($"!!!BOW REINICIANDO!!!"$) j.Initialize(allPoolStats)
Public shl As Shell resp.Write(j.ToString)
shl.Initialize("shl","cmd",Array("/c",File.DirApp & "\reiniciaProcesoBow.bat " & Main.srvr.Port)) Return
shl.WorkingDirectory = File.DirApp
shl.Run(-1) Case "slowqueries"
Else If Command = "paused" Then resp.ContentType = "application/json; charset=utf-8"
GlobalParameters.IsPaused = 1 Dim results As List
sb.Append("Servidor pausado.") results.Initialize
Else If Command = "continue" Then
GlobalParameters.IsPaused = 0 Try
sb.Append("Servidor reanudado.") ' Verifica la existencia de la tabla de logs antes de consultar
Else If Command = "logs" Then Dim tableExists As Boolean = Main.SQL1.ExecQuerySingleResult($"SELECT name FROM sqlite_master WHERE type='table' AND name='query_logs';"$) <> Null
If GlobalParameters.mpLogs.IsInitialized Then
j.Initialize(GlobalParameters.mpLogs) If tableExists = False Then
sb.Append(j.ToString) j.Initialize(CreateMap("message": "La tabla de logs ('query_logs') no existe. Habilita 'enableSQLiteLogs=1' en la configuración."))
End If resp.Write(j.ToString)
Else If Command = "block" Then Return
Dim BlockedConIP As String = req.GetParameter("IP") End If
If GlobalParameters.mpBlockConnection.IsInitialized Then
GlobalParameters.mpBlockConnection.Put(BlockedConIP, BlockedConIP) ' Consulta las 20 queries más lentas de la última hora
sb.Append("IP bloqueada: " & BlockedConIP) Dim oneHourAgoMs As Long = DateTime.Now - 3600000
End If Dim rs As ResultSet = Main.SQL1.ExecQuery($"SELECT query_name, duration_ms, datetime(timestamp / 1000, 'unixepoch', 'localtime') as timestamp_local, db_key, client_ip, busy_connections, handler_active_requests FROM query_logs WHERE timestamp >= ${oneHourAgoMs} ORDER BY duration_ms DESC LIMIT 20"$)
Else If Command = "unblock" Then
Dim UnBlockedConIP As String = req.GetParameter("IP") Do While rs.NextRow
If GlobalParameters.mpBlockConnection.IsInitialized Then Dim row As Map
GlobalParameters.mpBlockConnection.Remove(UnBlockedConIP) row.Initialize
sb.Append("IP desbloqueada: " & UnBlockedConIP) row.Put("Query", rs.GetString("query_name"))
End If row.Put("Duracion_ms", rs.GetLong("duration_ms"))
Else If Command = "restartserver" Then row.Put("Fecha_Hora", rs.GetString("timestamp_local"))
Log($"Ejecutamos ${File.DirApp}/restarServer.bat"$) row.Put("DB_Key", rs.GetString("db_key"))
sb.Append("Reiniciando servidor...") row.Put("Cliente_IP", rs.GetString("client_ip"))
Else If Command = "runatstartup" Then row.Put("Conexiones_Ocupadas", rs.GetInt("busy_connections"))
File.Copy("C:\jrdcinterface", "startup.bat", "C:\ProgramData\Microsoft\Windows\Start Menu\Programs\StartUp", "startup.bat") row.Put("Peticiones_Activas", rs.GetInt("handler_active_requests"))
sb.Append("Script de inicio añadido.") results.Add(row)
Else If Command = "stoprunatstartup" Then Loop
File.Delete("C:\ProgramData\Microsoft\Windows\Start Menu\Programs\StartUp", "startup.bat") rs.Close
sb.Append("Script de inicio eliminado.")
Else If Command = "totalrequests" Then Dim root As Map
If GlobalParameters.mpTotalRequests.IsInitialized Then root.Initialize
j.Initialize(GlobalParameters.mpTotalRequests) root.Put("data", results)
sb.Append(j.ToString) j.Initialize(root)
End If resp.Write(j.ToString)
Else If Command = "totalblocked" Then
If GlobalParameters.mpBlockConnection.IsInitialized Then Catch
' j.Initialize(Global.mpBlockConnection) Log("Error CRÍTICO al obtener queries lentas en Manager API: " & LastException.Message)
sb.Append(j.ToString) resp.Status = 500
End If
Else If Command = "totalcon" Then Dim root As Map
If GlobalParameters.mpTotalConnections.IsInitialized Then root.Initialize
j.Initialize(GlobalParameters.mpTotalConnections) root.Put("data", results)
sb.Append(j.ToString) j.Initialize(root)
End If resp.Write(j.ToString)
Else If Command = "ping" Then End Try
sb.Append($"Pong ($DateTime{DateTime.Now})"$) Return
End If
' ========================================================================= Case "logs", "totalrequests", "totalblocked"
' ### FIN DE TU LÓGICA DE COMANDOS ### resp.ContentType = "application/json; charset=utf-8"
' ========================================================================= Dim mp As Map
If Command = "logs" And GlobalParameters.mpLogs.IsInitialized Then mp = GlobalParameters.mpLogs
If Command = "totalrequests" And GlobalParameters.mpTotalRequests.IsInitialized Then mp = GlobalParameters.mpTotalRequests
If Command = "totalblocked" And GlobalParameters.mpBlockConnection.IsInitialized Then mp = GlobalParameters.mpBlockConnection
If mp.IsInitialized Then
j.Initialize(mp)
resp.Write(j.ToString)
Else
resp.Write("{}")
End If
Return
' --- Comandos que devuelven TEXTO PLANO ---
Case "ping"
resp.ContentType = "text/plain"
resp.Write($"Pong ($DateTime{DateTime.Now})"$)
Return
Case "reload"
resp.ContentType = "text/plain; charset=utf-8"
Dim sbTemp As StringBuilder
sbTemp.Initialize
' ***** LÓGICA DE RECARGA GRANULAR/SELECTIVA *****
Dim dbKeyToReload As String = req.GetParameter("db").ToUpperCase ' Leer parámetro 'db' opcional (ej: /manager?command=reload&db=DB3)
Dim targets As List ' Lista de DBKeys a recargar.
targets.Initialize
' 1. Determinar el alcance de la recarga (selectiva o total)
If dbKeyToReload.Length > 0 Then
' Recarga selectiva
If Main.listaDeCP.IndexOf(dbKeyToReload) = -1 Then
resp.Write($"ERROR: DBKey '${dbKeyToReload}' no es válida o no está configurada."$)
Return
End If
targets.Add(dbKeyToReload)
sbTemp.Append($"Iniciando recarga selectiva de ${dbKeyToReload} (Hot-Swap)..."$).Append(" " & CRLF)
Else
' Recarga completa (comportamiento por defecto)
targets.AddAll(Main.listaDeCP)
sbTemp.Append($"Iniciando recarga COMPLETA de configuración (Hot-Swap) ($DateTime{DateTime.Now})"$).Append(" " & CRLF)
End If
' 2. Deshabilitar el Timer de logs (si es necesario)
Dim oldTimerState As Boolean = Main.timerLogs.Enabled
If oldTimerState Then
Main.timerLogs.Enabled = False
sbTemp.Append(" -> Timer de limpieza de logs (SQLite) detenido temporalmente.").Append(" " & CRLF)
End If
Dim reloadSuccessful As Boolean = True
Dim oldConnectorsToClose As Map ' Guardaremos los conectores antiguos aquí.
oldConnectorsToClose.Initialize
' 3. Procesar solo los conectores objetivos
For Each dbKey As String In targets
sbTemp.Append($" -> Procesando recarga de ${dbKey}..."$).Append(CRLF)
Dim newRDC As RDCConnector
Try
' Crear el nuevo conector con la configuración fresca
newRDC.Initialize(dbKey)
' Adquirimos el lock para el reemplazo atómico
Main.MainConnectorsLock.RunMethod("lock", Null)
' Guardamos el conector antiguo (si existe)
Dim oldRDC As RDCConnector = Main.Connectors.Get(dbKey)
' Reemplazo atómico en el mapa global compartido
Main.Connectors.Put(dbKey, newRDC)
' Liberamos el bloqueo inmediatamente
Main.MainConnectorsLock.RunMethod("unlock", Null)
' Si había un conector antiguo, lo guardamos para cerrarlo después
If oldRDC.IsInitialized Then
oldConnectorsToClose.Put(dbKey, oldRDC)
End If
' 4. Actualizar el estado de logs (Granular)
Dim enableLogsSetting As Int = newRDC.config.GetDefault("enableSQLiteLogs", 0)
Dim isEnabled As Boolean = (enableLogsSetting = 1)
Main.SQLiteLoggingStatusByDB.Put(dbKey, isEnabled)
sbTemp.Append($" -> ${dbKey} recargado. Logs (config): ${isEnabled}"$).Append(CRLF)
Catch
' Si falla la inicialización del pool, no actualizamos Main.Connectors
' ¡CRÍTICO! Aseguramos que el lock se libere si hubo excepción antes de liberar.
If Main.MainConnectorsLock.RunMethod("isHeldByCurrentThread", Null).As(Boolean) Then
Main.MainConnectorsLock.RunMethod("unlock", Null)
End If
sbTemp.Append($" -> ERROR CRÍTICO al inicializar conector para ${dbKey}: ${LastException.Message}"$).Append(" " & CRLF)
reloadSuccessful = False
Exit
End Try
Next
' 5. Cerrar los pools antiguos liberados (FUERA del Lock)
If reloadSuccessful Then
For Each dbKey As String In oldConnectorsToClose.Keys
Dim oldRDC As RDCConnector = oldConnectorsToClose.Get(dbKey)
oldRDC.Close ' Cierre limpio del pool C3P0
sbTemp.Append($" -> Pool antiguo de ${dbKey} cerrado limpiamente."$).Append(" " & CRLF)
Next
' 6. Re-evaluar el estado global de Logs (CRÍTICO: debe revisar TODAS las DBs)
Main.IsAnySQLiteLoggingEnabled = False
For Each dbKey As String In Main.listaDeCP
' Revisamos el estado de log de CADA conector activo
If Main.SQLiteLoggingStatusByDB.GetDefault(dbKey, False) Then
Main.IsAnySQLiteLoggingEnabled = True
Exit
End If
Next
If Main.IsAnySQLiteLoggingEnabled Then
Main.timerLogs.Enabled = True
sbTemp.Append($" -> Timer de limpieza de logs ACTIVADO (estado global: HABILITADO)."$).Append(" " & CRLF)
Else
Main.timerLogs.Enabled = False
sbTemp.Append($" -> Timer de limpieza de logs DESHABILITADO (estado global: DESHABILITADO)."$).Append(" " & CRLF)
End If
sbTemp.Append($"¡Recarga de configuración completada con éxito!"$).Append(" " & CRLF)
Else
' Si falló, restauramos el estado del timer anterior.
If oldTimerState Then
Main.timerLogs.Enabled = True
sbTemp.Append(" -> Restaurando Timer de limpieza de logs al estado ACTIVO debido a fallo en recarga.").Append(" " & CRLF)
End If
sbTemp.Append($"¡ERROR: La recarga de configuración falló! Los conectores antiguos siguen activos."$).Append(" " & CRLF)
End If
resp.Write(sbTemp.ToString)
Return
Case "test"
resp.ContentType = "text/plain; charset=utf-8"
Dim sb As StringBuilder
sb.Initialize
sb.Append("--- INICIANDO PRUEBA DE CONECTIVIDAD A TODOS LOS POOLS CONFIGURADOS ---").Append(CRLF).Append(CRLF)
' --- Cerramos la página y la enviamos --- ' Iteramos sobre la lista de DB Keys cargadas al inicio (DB1, DB2, etc.)
sb.Append("</div><p class='logout'><a href='/logout'>Cerrar Sesión</a> | <a href=# onclick='toggleForm()'>Cambiar Contraseña</a></p></body></html>") For Each dbKey As String In Main.listaDeCP
resp.Write(sb.ToString) Dim success As Boolean = False
Dim errorMsg As String = ""
Dim con As SQL ' Conexión para la prueba
Try
' 1. Obtener el RDCConnector para esta DBKey
Dim connector As RDCConnector = Main.Connectors.Get(dbKey)
If connector.IsInitialized = False Then
errorMsg = "Conector no inicializado (revisa logs de AppStart)"
Else
' 2. Forzar la adquisición de una conexión del pool C3P0
con = connector.GetConnection(dbKey)
If con.IsInitialized Then
' 3. Si la conexión es válida, la cerramos inmediatamente para devolverla al pool
con.Close
success = True
Else
errorMsg = "La conexión devuelta no es válida (SQL.IsInitialized = False)"
End If
End If
Catch
' Capturamos cualquier excepción (ej. fallo de JDBC, timeout de C3P0)
errorMsg = LastException.Message
End Try
If success Then
sb.Append($"* ${dbKey}: Conexión adquirida y liberada correctamente."$).Append(CRLF)
Else
' Si falla, registramos el error para el administrador.
Main.LogServerError("ERROR", "Manager.TestCommand", $"Falló la prueba de conectividad para ${dbKey}: ${errorMsg}"$, dbKey, "test_command", req.RemoteAddress)
sb.Append($"[FALLO] ${dbKey}: ERROR CRÍTICO al obtener conexión. Mensaje: ${errorMsg}"$).Append(CRLF)
End If
Next
sb.Append(CRLF).Append("--- FIN DE PRUEBA DE CONEXIONES ---").Append(CRLF)
' Mantenemos la lista original de archivos de configuración cargados (esto es informativo)
sb.Append(CRLF).Append("Archivos de configuración cargados:").Append(CRLF)
For Each item As String In Main.listaDeCP
Dim configName As String = "config"
If item <> "DB1" Then configName = configName & "." & item
sb.Append($" -> Usando ${configName}.properties"$).Append(CRLF)
Next
resp.Write(sb.ToString)
Return
Case "rsx", "rpm2", "revivebow", "restartserver"
resp.ContentType = "text/plain; charset=utf-8"
Dim batFile As String
Select Command
Case "rsx": batFile = "start.bat"
Case "rpm2": batFile = "reiniciaProcesoPM2.bat"
Case "reviveBow": batFile = "reiniciaProcesoBow.bat"
Case "restartserver": batFile = "restarServer.bat" ' Nota: este bat no estaba definido, se usó el nombre del comando
End Select
Log($"Ejecutando ${File.DirApp}\${batFile}"$)
Try
Dim shl As Shell
shl.Initialize("shl","cmd", Array("/c", File.DirApp & "\" & batFile & " " & Main.srvr.Port))
shl.WorkingDirectory = File.DirApp
shl.Run(-1)
resp.Write($"Comando '${Command}' ejecutado. Script invocado: ${batFile}"$)
Catch
resp.Write($"Error al ejecutar el script para '${Command}': ${LastException.Message}"$)
End Try
Return
Case "paused", "continue"
resp.ContentType = "text/plain; charset=utf-8"
If Command = "paused" Then
GlobalParameters.IsPaused = 1
resp.Write("Servidor pausado.")
Else
GlobalParameters.IsPaused = 0
resp.Write("Servidor reanudado.")
End If
Return
Case "block", "unblock"
resp.ContentType = "text/plain; charset=utf-8"
Dim ip As String = req.GetParameter("IP")
If ip = "" Then
resp.Write("Error: El parámetro IP es requerido.")
Return
End If
If GlobalParameters.mpBlockConnection.IsInitialized Then
If Command = "block" Then
GlobalParameters.mpBlockConnection.Put(ip, ip)
resp.Write($"IP bloqueada: ${ip}"$)
Else
GlobalParameters.mpBlockConnection.Remove(ip)
resp.Write($"IP desbloqueada: ${ip}"$)
End If
Else
resp.Write("Error: El mapa de bloqueo no está inicializado.")
End If
Return
Case "getconfiginfo"
resp.ContentType = "text/plain; charset=utf-8"
Dim sbInfo As StringBuilder
sbInfo.Initialize
' sbInfo.Append($"--- CONFIGURACIÓN ACTUAL DEL SERVIDOR jRDC2-Multi ($DateTime{DateTime.Now}) ---"$).Append(CRLF).Append(CRLF)
If GlobalParameters.mpLogs.IsInitialized Then GlobalParameters.mpLogs.Put(Command, "Manager : " & Command & " - Time : " & DateTime.Time(DateTime.Now)) Dim allKeys As List
End Sub allKeys.Initialize
allKeys.AddAll(Main.listaDeCP) ' DB1, DB2, ...
sbInfo.Append("======================================================================").Append(CRLF)
sbInfo.Append($"=== CONFIGURACIÓN jRDC2-Multi V$1.2{Main.VERSION} (ACTIVA) ($DateTime{DateTime.Now}) ==="$).Append(CRLF)
sbInfo.Append("======================================================================").Append(CRLF).Append(CRLF)
Sub Handle0(req As ServletRequest, resp As ServletResponse) ' ***** GLOSARIO DE PARÁMETROS CONFIGURABLES *****
' 1. --- Bloque de Seguridad (se mantiene igual) --- sbInfo.Append("### GLOSARIO DE PARÁMETROS PERMITIDOS EN CONFIG.PROPERTIES ###").Append(CRLF)
If req.GetSession.GetAttribute2("user_is_authorized", False) = False Then sbInfo.Append("--------------------------------------------------").Append(CRLF)
resp.SendRedirect("/login")
Return sbInfo.Append("DriverClass: Clase del driver JDBC (ej: oracle.jdbc.driver.OracleDriver).").Append(CRLF)
End If sbInfo.Append("JdbcUrl: URL de conexión a la base de datos (IP, puerto, servicio).").Append(CRLF)
sbInfo.Append("User/Password: Credenciales de acceso a la BD.").Append(CRLF)
sbInfo.Append("ServerPort: Puerto de escucha del servidor B4J (solo lo toma de config.properties).").Append(CRLF)
sbInfo.Append("Debug: Si es 'true', los comandos SQL se recargan en cada petición (DESHABILITADO, USAR COMANDO RELOAD).").Append(CRLF)
sbInfo.Append("parameterTolerance: Define si se recortan (1) o se rechazan (0) los parámetros SQL sobrantes a los requeridos por el query.").Append(CRLF)
sbInfo.Append("enableSQLiteLogs: Control granular. Habilita (1) o deshabilita (0) la escritura de logs en users.db para esta DB.").Append(CRLF)
sbInfo.Append("InitialPoolSize: Conexiones que el pool establece al iniciar (c3p0).").Append(CRLF)
sbInfo.Append("MinPoolSize: Mínimo de conexiones inactivas que se mantendrán.").Append(CRLF)
sbInfo.Append("MaxPoolSize: Máximo de conexiones simultáneas permitido.").Append(CRLF)
sbInfo.Append("AcquireIncrement: Número de conexiones nuevas que se adquieren en lote al necesitar más.").Append(CRLF)
sbInfo.Append("MaxIdleTime: Tiempo máximo (segundos) de inactividad antes de cerrar una conexión.").Append(CRLF)
sbInfo.Append("MaxConnectionAge: Tiempo máximo de vida (segundos) de una conexión.").Append(CRLF)
sbInfo.Append("CheckoutTimeout: Tiempo máximo de espera (milisegundos) por una conexión disponible.").Append(CRLF)
sbInfo.Append(CRLF)
For Each dbKey As String In allKeys
Dim Command As String = req.GetParameter("command") ' --- COMIENZA EL DETALLE POR CONECTOR ---
If Command = "" Then Command = "ping"
Log($"Command: ${Command}"$) Dim connector As RDCConnector = Main.Connectors.Get(dbKey)
resp.ContentType = "text/html"
sbInfo.Append("--------------------------------------------------").Append(CRLF).Append(CRLF)
sbInfo.Append($"---------------- ${dbKey} ------------------"$).Append(CRLF).Append(CRLF)
sbInfo.Append("--------------------------------------------------").Append(CRLF).Append(CRLF)
If connector.IsInitialized Then
Dim configMap As Map = connector.config
sbInfo.Append($"DriverClass: ${configMap.GetDefault("DriverClass", "N/A")}"$).Append(CRLF)
sbInfo.Append($"JdbcUrl: ${configMap.GetDefault("JdbcUrl", "N/A")}"$).Append(CRLF)
sbInfo.Append($"User: ${configMap.GetDefault("User", "N/A")}"$).Append(CRLF)
sbInfo.Append($"ServerPort: ${configMap.GetDefault("ServerPort", "N/A")}"$).Append(CRLF).Append(CRLF)
sbInfo.Append("--- CONFIGURACIÓN DEL POOL (C3P0) ---").Append(CRLF)
sbInfo.Append($"InitialPoolSize: ${configMap.GetDefault("InitialPoolSize", 3)}"$).Append(CRLF)
sbInfo.Append($"MinPoolSize: ${configMap.GetDefault("MinPoolSize", 2)}"$).Append(CRLF)
sbInfo.Append($"MaxPoolSize: ${configMap.GetDefault("MaxPoolSize", 5)}"$).Append(CRLF)
sbInfo.Append($"AcquireIncrement: ${configMap.GetDefault("AcquireIncrement", 5)}"$).Append(CRLF)
sbInfo.Append($"MaxIdleTime (s): ${configMap.GetDefault("MaxIdleTime", 300)}"$).Append(CRLF)
sbInfo.Append($"MaxConnectionAge (s): ${configMap.GetDefault("MaxConnectionAge", 900)}"$).Append(CRLF)
sbInfo.Append($"CheckoutTimeout (ms): ${configMap.GetDefault("CheckoutTimeout", 60000)}"$).Append(CRLF).Append(CRLF)
' 2. --- Construimos la ESTRUCTURA de la página --- sbInfo.Append("--- COMPORTAMIENTO ---").Append(CRLF)
Dim sb As StringBuilder sbInfo.Append($"Debug (Recarga Queries - DESHABILITADO): ${configMap.GetDefault("Debug", "false")}"$).Append(CRLF)
sb.Initialize
' Lectura explícita de las nuevas propiedades, asegurando un Int.
' Estilos para la página Dim tolerance As Int = configMap.GetDefault("parameterTolerance", 0).As(Int)
sb.Append("<html><head><style>") sbInfo.Append($"ParameterTolerance: ${tolerance} (0=Estricto, 1=Habilitado)"$).Append(CRLF)
sb.Append("body {font-family: sans-serif; margin: 2em; background-color: #f9f9f9;} ")
sb.Append("h1, h2 {color: #333;} hr {margin: 2em 0; border: 0; border-top: 1px solid #ddd;} ") Dim logsEnabled As Int = configMap.GetDefault("enableSQLiteLogs", 1).As(Int)
sb.Append("form {background: #f0f0f0; padding: 1.5em; border-radius: 8px; max-width: 400px; margin-bottom: 2em;} ") sbInfo.Append($"EnableSQLiteLogs: ${logsEnabled} (0=Deshabilitado, 1=Habilitado)"$).Append(CRLF)
sb.Append("input {display: block; width: 95%; padding: 8px; margin-bottom: 10px; border: 1px solid #ccc; border-radius: 4px;} ")
sb.Append("button {padding: 10px 15px; border: none; background-color: #007bff; color: white; cursor: pointer; border-radius: 4px;} ") sbInfo.Append(CRLF)
sb.Append(".nav a, .logout a {text-decoration: none; margin-right: 10px; color: #007bff;} ")
sb.Append(".output {background: #fff; padding: 1em; border: 1px solid #eee; border-radius: 8px;} ") Else
sb.Append("</style></head><body>") sbInfo.Append($"ERROR: Conector ${dbKey} no inicializado o falló al inicio."$).Append(CRLF).Append(CRLF)
End If
' Cabecera y bienvenida Next
sb.Append("<h1>Panel de Administración jRDC</h1>")
sb.Append($"Bienvenido, <b>${req.GetSession.GetAttribute("username")}</b><br>"$)
' Menú de navegación (se define una sola vez)
sb.Append("<p class='nav'>")
sb.Append($"<a href="/test">Test</a> | <a href="/manager?command=ping">Ping</a> | <a href="/manager?command=reload">Reload</a> | <a href="/manager?command=rpm2">Reiniciar (pm2)</a> | <a href="/manager?command=reviveBow">Revive Bow</a>"$)
sb.Append("</p>")
' Formulario para cambiar contraseña
sb.Append("<hr>")
sb.Append("<h2>Cambiar Contraseña</h2>")
sb.Append("<form action='/changepass' method='post'>")
sb.Append("Contraseña Actual: <input type='password' name='current_password' required><br>")
sb.Append("Nueva Contraseña: <input type='password' name='new_password' required><br>")
sb.Append("Confirmar Nueva Contraseña: <input type='password' name='confirm_password' required><br>")
sb.Append("<button type='submit'>Actualizar Contraseña</button>")
sb.Append("</form>")
' Sección para el resultado del comando
sb.Append("<hr><h2>Resultado del Comando: '" & Command & "'</h2>")
sb.Append("<div class='output'>")
' 3. --- Lógica de TUS COMANDOS (modificada para usar sb.Append) ---
If Command = "reload" Then
Private estaDB As String = ""
For i = 0 To Main.listaDeCP.Size - 1
Main.Connectors.Get(Main.listaDeCP.get(i)).As(RDCConnector).Initialize(Main.listaDeCP.get(i))
If Main.listaDeCP.get(i) <> "DB1" Then estaDB = "." & Main.listaDeCP.get(i) Else estaDB = ""
sb.Append($"Recargando config${estaDB}.properties ($DateTime{DateTime.Now})<br/>"$)
sb.Append($"Queries en config.properties: <b>${Main.Connectors.Get(Main.listaDeCP.get(i)).As(RDCConnector).commands.Size}</b><br/>"$)
sb.Append($"<b>JdbcUrl:</b> ${Main.Connectors.Get(Main.listaDeCP.get(i)).As(RDCConnector).config.Get("JdbcUrl")}</b><br/>"$)
sb.Append($"<b>User:</b> ${Main.Connectors.Get(Main.listaDeCP.get(i)).As(RDCConnector).config.Get("User")}</b><br/>"$)
sb.Append($"<b>ServerPort:</b> ${Main.srvr.Port}</b><br/><br/>"$)
Next
else If Command = "stop" Then
' Tu código para "stop"
else If Command = "rsx" Then
Log($"Ejecutamos ${File.DirApp}\start.bat"$)
sb.Append($"Ejecutamos ${File.DirApp}\start.bat"$)
Public shl As Shell
shl.Initialize("shl","cmd",Array("/c",File.DirApp & "\start.bat " & Main.srvr.Port))
shl.WorkingDirectory = File.DirApp
shl.Run(-1)
else If Command = "rpm2" Then
Log($"Ejecutamos ${File.DirApp}\reiniciaProcesoPM2.bat"$)
sb.Append($"Ejecutamos ${File.DirApp}\reiniciaProcesoPM2.bat"$)
Public shl As Shell
shl.Initialize("shl","cmd",Array("/c",File.DirApp & "\reiniciaProcesoPM2.bat " & Main.srvr.Port))
shl.WorkingDirectory = File.DirApp
shl.Run(-1)
else If Command = "reviveBow" Then
Log($"Ejecutamos ${File.DirApp}\reiniciaProcesoBow.bat"$)
sb.Append($"Ejecutamos ${File.DirApp}\reiniciaProcesoBow.bat<br><br>"$)
sb.Append($"!!!BOW REINICIANDO!!!"$)
Public shl As Shell
shl.Initialize("shl","cmd",Array("/c",File.DirApp & "\reiniciaProcesoBow.bat " & Main.srvr.Port))
shl.WorkingDirectory = File.DirApp
shl.Run(-1)
else if Command = "totalrequests" Then
If GlobalParameters.mpTotalRequests.IsInitialized Then
j.Initialize(GlobalParameters.mpTotalRequests)
sb.Append(j.ToString)
End If
else if Command = "ping" Then
sb.Append($"Pong ($DateTime{DateTime.Now})"$)
End If
'...(aquí continuaría el resto de tus Else If)...
' 4. --- Cerramos la página y la enviamos TODA JUNTA ---
sb.Append("</div>") ' Cierre de div.output
sb.Append("<p class='logout'><a href='/logout'>Cerrar Sesión</a></p>")
sb.Append("</body></html>")
resp.Write(sb.ToString) ' Se envía toda la página de una vez
' Lógica final de logs (se mantiene igual)
If GlobalParameters.mpLogs.IsInitialized Then GlobalParameters.mpLogs.Put(Command, "Manager : " & Command & " - Time : " & DateTime.Time(DateTime.Now))
End Sub
resp.Write(sbInfo.ToString)
Return
Case Else
resp.ContentType = "text/plain; charset=utf-8"
resp.SendError(404, $"Comando desconocido: '{Command}'"$)
Return
End Select
End Sub

View File

@@ -0,0 +1,70 @@
B4J=true
Group=Default Group
ModulesStructureVersion=1
Type=StaticCode
Version=10.3
@EndOfDesignText@
' Archivo: ParameterValidationUtils.bas
' Módulo de utilidad: ParameterValidationUtils
' Centraliza la lógica de validación y ajuste de parámetros SQL.
' Ahora soporta recorte de parámetros excesivos.
Sub Process_Globals
' El Type ParameterValidationResult está declarado en Main.bas, no se declara aquí.
End Sub
' Valida y ajusta la lista de parámetros para la ejecución SQL, aplicando la lógica de tolerancia.
' Retorna un ParameterValidationResult indicando éxito/error y los parámetros a usar.
Public Sub ValidateAndAdjustParameters (CommandName As String, DBKey As String, sqlCommand As String, receivedParams As List, IsToleranceEnabled As Boolean) As ParameterValidationResult
Dim res As ParameterValidationResult
res.Initialize
res.Success = True ' Asumimos éxito inicialmente
' Log(">>>> IsToleranceEnabled: " & IsToleranceEnabled)
' Aseguramos que receivedParams esté inicializada, incluso si está vacía o Null
If receivedParams = Null Or receivedParams.IsInitialized = False Then
receivedParams.Initialize ' Inicializa una lista vacía si es Null o no inicializada.
End If
' Contar cuántos '?' hay en la sentencia SQL para saber cuántos parámetros se esperan.
Dim expectedParams As Int = sqlCommand.Length - sqlCommand.Replace("?", "").Length
Dim receivedParamsSize As Int = receivedParams.Size
If receivedParamsSize < expectedParams Then
' Caso 1: Se recibieron MENOS parámetros de los esperados. Esto es un error.
res.Success = False
res.ErrorMessage = $"ERROR: Número de parámetros insuficiente para "${CommandName}" (DB: ${DBKey}). Se esperaban ${expectedParams} y se recibieron ${receivedParamsSize}."$
Log(res.ErrorMessage)
Main.LogServerError("ERROR", "ParameterValidationUtils.ValidateAndAdjustParameters", res.ErrorMessage, DBKey, CommandName, Null) ' <-- Nuevo Log
Return res
Else If receivedParamsSize > expectedParams Then
' Caso 2: Se recibieron MÁS parámetros de los esperados.
If IsToleranceEnabled Then ' Solo recortamos si la tolerancia está habilitada
Dim adjustedParams As List
adjustedParams.Initialize
For i = 0 To expectedParams - 1
adjustedParams.Add(receivedParams.Get(i))
Next
res.ParamsToExecute = adjustedParams
res.Success = True
Dim WarningMsg As String = $"ADVERTENCIA: Se recibieron más parámetros de los esperados para "${CommandName}" (DB: ${DBKey}). Se esperaban ${expectedParams} y se recibieron ${receivedParamsSize}. Se ajustó la lista de parámetros a ${expectedParams} elementos."$
Log(WarningMsg)
Log("Cache: " & Main.LOG_CACHE_THRESHOLD & "|" & Main.ErrorLogCache.Size)
Main.LogServerError("ADVERTENCIA", "ParameterValidationUtils.ValidateAndAdjustParameters", WarningMsg, DBKey, CommandName, Null) ' <-- Nuevo Log [6]
Else
' Si la tolerancia NO está habilitada, esto es un error crítico.
res.Success = False
res.ErrorMessage = $"ERROR: Número de parámetros excesivo para "${CommandName}" (DB: ${DBKey}). Se esperaban ${expectedParams} y se recibieron ${receivedParamsSize}. La tolerancia a parámetros de más está DESHABILITADA."$
Log(res.ErrorMessage)
Main.LogServerError("ERROR", "ParameterValidationUtils.ValidateAndAdjustParameters", res.ErrorMessage, DBKey, CommandName, Null)
Return res
End If
Else
' Caso 3: Se recibieron el número EXACTO de parámetros. Todo bien.
res.ParamsToExecute = receivedParams ' Usamos la lista original tal cual.
res.Success = True ' Confirmamos éxito.
End If
Return res
End Sub

View File

@@ -4,126 +4,348 @@ ModulesStructureVersion=1
Type=Class Type=Class
Version=4.19 Version=4.19
@EndOfDesignText@ @EndOfDesignText@
'Class module ' Módulo de clase: RDCConnector
' Esta clase gestiona el pool de conexiones a una base de datos específica utilizando la librería C3P0.
' Cada instancia de RDCConnector es responsable de una base de datos definida en un archivo 'config.DBx.properties'.
' Se encarga de inicializar el pool, obtener conexiones, cargar comandos SQL y proporcionar estadísticas del pool.
Sub Class_Globals Sub Class_Globals
' --- Variables globales de la clase ---
' Objeto principal para gestionar el pool de conexiones de la base de datos (usa C3P0 internamente).
Private pool As ConnectionPool Private pool As ConnectionPool
Private DebugQueries As Boolean
Dim commands As Map ' Bandera para activar/desactivar el modo de depuración de queries.
' Cuando está en True, los comandos SQL se recargan en cada petición (útil en desarrollo).
' Private DebugQueries As Boolean
' Almacena los comandos SQL específicos de esta base de datos, cargados de su archivo de configuración.
Public commands As Map
' El puerto que el servidor HTTP usará. Este valor se lee del 'config.properties' de la base de datos principal (DB1).
Public serverPort As Int Public serverPort As Int
' Indica si se debe usar el pool de conexiones. Siempre True en este diseño, ya que C3P0 es esencial.
Public usePool As Boolean = True Public usePool As Boolean = True
Dim config As Map
' Almacena la configuración completa (DriverClass, JdbcUrl, User, Password, InitialPoolSize, etc.)
' cargada de su respectivo archivo .properties.
Public config As Map
' Indica si la tolerancia a parámetros de más está activa.
Public IsParameterToleranceEnabled As Boolean
End Sub End Sub
'Initializes the object. You can add parameters to this method if needed. ' Subrutina de inicialización para el conector de una base de datos específica.
' Se llama una vez por cada base de datos (DB1, DB2, DB3, DB4) al iniciar el servidor en Main.AppStart.
' DB: El identificador único de la base de datos (ej. "DB1", "DB2").
Public Sub Initialize(DB As String) Public Sub Initialize(DB As String)
' Log("RDCConnector Initialize") ' Si el identificador es "DB1", se usa una cadena vacía para que File.ReadMap cargue "config.properties" (el archivo por defecto).
If DB.EqualsIgnoreCase("DB1") Then DB = "" 'Esto para el config.properties por default If DB.EqualsIgnoreCase("DB1") Then DB = ""
Dim config As Map = LoadConfigMap(DB)
Log($"Inicializamos ${DB}, usuario: ${config.Get("User")}"$)
pool.Initialize(config.Get("DriverClass"), config.Get("JdbcUrl"), config.Get("User"), config.Get("Password"))
Dim jo As JavaObject = pool
jo.RunMethod("setMaxPoolSize", Array(5)) 'number of concurrent connections
' com.mchange.v2.c3p0.ComboPooledDataSource [ ' PASO 1: Cargar la configuración desde el archivo .properties correspondiente.
' acquireIncrement -> 3, ' Es CRUCIAL que se asigne a la variable de CLASE 'config' (sin 'Dim' local)
' acquireRetryAttempts -> 30, ' para que la configuración cargada del archivo sea persistente para esta instancia del conector.
' acquireRetryDelay -> 1000, config = LoadConfigMap(DB)
' autoCommitOnClose -> False,
' automaticTestTable -> Null, ' Leer la configuración de tolerancia de parámetros
' breakAfterAcquireFailure -> False, Dim toleranceSetting As Int = config.GetDefault("parameterTolerance", 0).As(Int) ' Por defecto, 0 (estricto)
' checkoutTimeout -> 20000, IsParameterToleranceEnabled = (toleranceSetting = 1) ' La tolerancia se habilita si el valor es 1
' connectionCustomizerClassName -> Null,
' connectionTesterClassName -> com.mchange.v2.c3p0.impl.DefaultConnectionTester, If IsParameterToleranceEnabled Then
' contextClassLoaderSource -> caller, Log($"RDCConnector.Initialize para ${DB}: Tolerancia a parámetros de más, HABILITADA."$)
' dataSourceName -> 2rvxvdb7cyxd8zlw6dyb|63021689, Else
' debugUnreturnedConnectionStackTraces -> False, Log($"RDCConnector.Initialize para ${DB}: Tolerancia a parámetros de más, DESHABILITADA (modo estricto)."$)
' description -> Null, End If
' driverClass -> oracle.jdbc.driver.OracleDriver,
' extensions -> {}, ' Bloque Try-Catch para la inicialización y configuración del pool.
' factoryClassLocation -> Null, ' Esto es esencial para capturar cualquier error crítico que impida la conexión inicial a la base de datos.
' forceIgnoreUnresolvedTransactions -> False, Try
' forceSynchronousCheckins -> False, ' PASO 2: Inicializar el objeto B4X ConnectionPool.
' forceUseNamedDriverClass -> False, ' Esto crea la instancia subyacente de com.mchange.v2.c3p0.ComboPooledDataSource (la librería C3P0).
' identityToken -> 2rvxvdb7cyxd8zlw6dyb|63021689, ' Se le pasan los parámetros básicos para que C3P0 pueda construirse.
' idleConnectionTestPeriod -> 600, pool.Initialize(config.Get("DriverClass"), config.Get("JdbcUrl"), config.Get("User"), config.Get("Password"))
' initialPoolSize -> 3,
' jdbcUrl -> jdbc:oracle:thin:@//10.0.0.110:1521/DBKMT, ' Obtener la referencia JavaObject para acceder a métodos de configuración avanzados de C3P0.
' maxAdministrativeTaskTime -> 0, Dim jo As JavaObject = pool
' maxConnectionAge -> 0,
' maxIdleTime -> 1800, ' PASO 3: Aplicar *todas* las propiedades de configuración de C3P0 INMEDIATAMENTE.
' maxIdleTimeExcessConnections -> 0, ' Esto debe ocurrir *después* de 'pool.Initialize' pero *antes* de que C3P0 intente realmente adquirir conexiones.
' maxPoolSize -> 5, ' Esto asegura que las configuraciones sean efectivas desde el primer intento de conexión.
' maxStatements -> 150,
' maxStatementsPerConnection -> 0, ' Lectura de los valores desde el archivo de configuración, con valores por defecto si no se encuentran.
' minPoolSize -> 3, Dim initialPoolSize As Int = config.GetDefault("InitialPoolSize", 3)
' numHelperThreads -> 3, Dim minPoolSize As Int = config.GetDefault("MinPoolSize", 2)
' preferredTestQuery -> DBMS_SESSION.SET_IDENTIFIER('whatever'), Dim maxPoolSize As Int = config.GetDefault("MaxPoolSize", 5)
' privilegeSpawnedThreads -> False, Dim acquireIncrement As Int = config.GetDefault("AcquireIncrement", 5)
' properties -> {password=******, user=******}, Dim maxIdleTime As Int = config.GetDefault("MaxIdleTime", 300)
' propertyCycle -> 0, Dim maxConnectionAge As Int = config.GetDefault("MaxConnectionAge", 900)
' statementCacheNumDeferredCloseThreads -> 0, Dim checkoutTimeout As Int = config.GetDefault("CheckoutTimeout", 60000)
' testConnectionOnCheckin -> False,
' testConnectionOnCheckout -> True, ' Configuración de los parámetros del pool de conexiones C3P0:
' unreturnedConnectionTimeout -> 0, jo.RunMethod("setInitialPoolSize", Array(initialPoolSize)) ' Define el número de conexiones que se intentarán crear al iniciar el pool.
' userOverrides -> {}, jo.RunMethod("setMinPoolSize", Array(minPoolSize)) ' Fija el número mínimo de conexiones que el pool mantendrá abiertas.
jo.RunMethod("setMaxPoolSize", Array(maxPoolSize)) ' Define el número máximo de conexiones simultáneas.
jo.RunMethod("setAcquireIncrement", Array(acquireIncrement)) ' Cuántas conexiones nuevas se añaden en lote si el pool se queda sin disponibles.
jo.RunMethod("setMaxIdleTime", Array As Object(maxIdleTime)) ' Es el tiempo máximo (en segundos) que una conexión puede permanecer inactiva en el pool antes de ser cerrada para ahorrar recursos.
jo.RunMethod("setMaxConnectionAge", Array As Object(maxConnectionAge)) ' Tiempo máximo de vida de una conexión (segundos), previene conexiones viciadas.
jo.RunMethod("setCheckoutTimeout", Array As Object(checkoutTimeout)) ' Tiempo máximo de espera por una conexión del pool (milisegundos).
' LÍNEAS CRÍTICAS PARA FORZAR UN COMPORTAMIENTO NO SILENCIOSO DE C3P0:
' Por defecto, C3P0 puede reintentar muchas veces y no lanzar una excepción si las conexiones iniciales fallan.
' Estas líneas fuerzan a C3P0 a ser estricto y reportar errores de inmediato.
jo.RunMethod("setAcquireRetryAttempts", Array As Object(2)) ' Limita los intentos iniciales de adquisición a 1.
jo.RunMethod("setBreakAfterAcquireFailure", Array As Object(True)) ' ¡Forza a C3P0 a lanzar una excepción si falla al adquirir conexiones!
' PASO 4: Forzar la creación de conexiones iniciales y verificar el estado.
' Este paso es VITAL. Obliga a C3P0 a intentar establecer las conexiones iniciales (InitialPoolSize)
' *con la configuración ya establecida*. Si hay un problema de conectividad real, la excepción
' se capturará aquí y se reportará, evitando "fallos silenciosos".
Dim tempCon As SQL = pool.GetConnection ' Adquiere una conexión para forzar al pool a inicializarse.
If tempCon.IsInitialized Then
tempCon.Close ' Devolvemos la conexión inmediatamente al pool para que esté disponible.
End If
' Cargar configuración estática en el cache global
Dim dbKeyToStore As String = DB
If dbKeyToStore = "" Then dbKeyToStore = "DB1" ' Aseguramos la llave si era DB1
Dim initialPoolStats As Map = GetPoolStats ' Llama a la función que usa JavaObject
' PASO C: Almacenamos el mapa completo (estático + dinámico inicial) en el cache global.
Main.LatestPoolStats.Put(dbKeyToStore, initialPoolStats)
' Log(Main.LatestPoolStats)
' com.mchange.v2.c3p0.ComboPooledDataSource [
' acquireIncrement -> 3,
' acquireRetryAttempts -> 30,
' acquireRetryDelay -> 1000,
' autoCommitOnClose -> False,
' automaticTestTable -> Null,
' breakAfterAcquireFailure -> False,
' checkoutTimeout -> 20000,
' connectionCustomizerClassName -> Null,
' connectionTesterClassName -> com.mchange.v2.c3p0.impl.DefaultConnectionTester,
' contextClassLoaderSource -> caller,
' dataSourceName -> 2rvxvdb7cyxd8zlw6dyb|63021689,
' debugUnreturnedConnectionStackTraces -> False,
' description -> Null,
' driverClass -> oracle.jdbc.driver.OracleDriver,
' extensions -> {},
' factoryClassLocation -> Null,
' forceIgnoreUnresolvedTransactions -> False,
' forceSynchronousCheckins -> False,
' forceUseNamedDriverClass -> False,
' identityToken -> 2rvxvdb7cyxd8zlw6dyb|63021689,
' idleConnectionTestPeriod -> 600,
' initialPoolSize -> 3,
' jdbcUrl -> jdbc:oracle:thin:@//10.0.0.110:1521/DBKMT,
' maxAdministrativeTaskTime -> 0,
' maxConnectionAge -> 0,
' maxIdleTime -> 1800,
' maxIdleTimeExcessConnections -> 0,
' maxPoolSize -> 5,
' maxStatements -> 150,
' maxStatementsPerConnection -> 0,
' minPoolSize -> 3,
' numHelperThreads -> 3,
' preferredTestQuery -> DBMS_SESSION.SET_IDENTIFIER('whatever'),
' privilegeSpawnedThreads -> False,
' properties -> {password=******, user=******},
' propertyCycle -> 0,
' statementCacheNumDeferredCloseThreads -> 0,
' testConnectionOnCheckin -> False,
' testConnectionOnCheckout -> True,
' unreturnedConnectionTimeout -> 0,
' userOverrides -> {},
' usesTraditionalReflectiveProxies -> False ' usesTraditionalReflectiveProxies -> False
' ] ' ]
'
Catch
' Si ocurre un error durante la inicialización del pool o al forzar la conexión,
' este Log es CRÍTICO para el diagnóstico, especialmente en un entorno de producción.
Dim ErrorMsg As String = $"RDCConnector.Initialize para ${DB}: ERROR CRÍTICO al inicializar/forzar conexión: ${LastException.Message}"$
Log(ErrorMsg)
Main.LogServerError("ERROR", "RDCConnector.Initialize", ErrorMsg, DB, Null, Null)
End Try
' Dim jo2 As JavaObject = pool ' Configuración de depuración de queries. Se activa automáticamente si el proyecto se ejecuta en modo DEBUG.
' Log(jo2.GetField("END_TO_END_CLIENTID_INDEX")) ' #If DEBUG
' DebugQueries = True ' Descomentar para activar la recarga de comandos en cada petición en desarrollo.
' #Else
' DebugQueries = False
' #End If
' jo.RunMethod("setPreferredTestQuery", Array("BEGIN DBMS_SESSION.SET_IDENTIFIER('whatever'); END;")) ' Se obtiene el puerto del servidor HTTP desde la configuración de esta base de datos.
' jo.RunMethod("setPreferredTestQuery", Array("alter session set current_schema=MYSCHEMA")) ' Nota: En el diseño actual, el puerto principal lo define DB1 (config.properties).
' jo2.RunMethod("setClientIdentifier",Array( "MAX")) ' Tiempo máximo de inactividad antes de cerrar una conexión
#if DEBUG
DebugQueries = True
#else
DebugQueries = False
#end if
serverPort = config.Get("ServerPort") serverPort = config.Get("ServerPort")
' Asegura que el identificador DB no sea una cadena vacía para la carga de comandos.
' Esto es relevante si DB era "DB1" y se convirtió a "" al inicio de esta subrutina.
If DB = "" Then DB = "DB1" If DB = "" Then DB = "DB1"
' Carga los comandos SQL predefinidos de esta base de datos en el mapa global 'commandsMap' de Main.
LoadSQLCommands(config, DB) LoadSQLCommands(config, DB)
End Sub End Sub
' Carga el mapa de configuración (JdbcUrl, User, Password, etc.) desde el archivo .properties correspondiente.
' DB: El identificador de la base de datos (ej. "DB1", "DB2").
' Retorna un Mapa con la configuración leída.
Private Sub LoadConfigMap(DB As String) As Map Private Sub LoadConfigMap(DB As String) As Map
Private DBX As String = "" Private DBX As String = ""
If DB <> "" Then DBX = "." & DB If DB <> "" Then DBX = "." & DB ' Construye el sufijo del nombre de archivo (ej. ".DB2").
Log("===========================================") Log($"RDCConnector.LoadConfigMap: Leemos el config${DBX}.properties"$) ' Mantenemos este log para confirmación de carga.
Log($"Leemos el config${DBX}.properties"$)
Return File.ReadMap("./", "config" & DBX & ".properties") Return File.ReadMap("./", "config" & DBX & ".properties")
End Sub End Sub
' Obtiene la sentencia SQL completa para un comando dado desde el mapa de comandos cargado.
' DB: El identificador de la base de datos.
' Key: El nombre del comando SQL (ej. "select_user").
' Retorna la sentencia SQL como String.
Public Sub GetCommand(DB As String, Key As String) As String Public Sub GetCommand(DB As String, Key As String) As String
Log("==== GetCommand ====") ' Obtiene los comandos de la DB específica del mapa global Main.commandsMap.
' Log("|" & DB & "|" & Key & "|") commands = Main.commandsMap.Get(DB).As(Map)
commands = Main.commandsMap.get(DB).As(Map)
If commands.ContainsKey("sql." & Key) = False Then If commands.ContainsKey("sql." & Key) = False Then
Log("*** Command not found: " & Key) Dim ErrorMsg As String = $"RDCConnector.GetCommand: *** Comando no encontrado: '${Key}' para DB: '${DB}' ***"$
Log(ErrorMsg)
Main.LogServerError("ERROR", "RDCConnector.GetCommand", ErrorMsg, DB, Key, Null) ' Log importante si un comando no se encuentra.
End If End If
' Log(commands.ContainsKey("sql." & Key)) Return commands.Get("sql." & Key) ' Retorna la sentencia SQL.
Log("========= Traemos """ & Key & """ ==========")
Log(">>>>>> " & commands.Get("sql." & Key) & " <<<<<<")
Return commands.Get("sql." & Key)
End Sub End Sub
' Obtiene una conexión SQL funcional del pool de conexiones para la base de datos especificada.
' DB: El identificador de la base de datos.
' Retorna un objeto SQL (la conexión a la base de datos).
Public Sub GetConnection(DB As String) As SQL Public Sub GetConnection(DB As String) As SQL
Log("==== GetConnection ==== ") If DB.EqualsIgnoreCase("DB1") Then DB = ""
If DB.EqualsIgnoreCase("DB1") Then DB = "" 'Esto para el config.properties or default
If DebugQueries Then LoadSQLCommands(LoadConfigMap(DB), DB) ' En modo de depuración, recarga los comandos SQL en cada petición.
Return pool.GetConnection ' Esto permite modificar queries en config.properties sin reiniciar el servidor durante el desarrollo.
' If DebugQueries Then LoadSQLCommands(LoadConfigMap(DB), DB)
' <<<< Bloque de Logs de Depuración de Adquisición de Conexión (descomentar si es necesario) >>>>
' Log($"[DEBUG - ${DB}] RDCConnector.GetConnection: Solicitando conexión del pool..."$)
Dim conn As SQL = pool.GetConnection
' Log($"[DEBUG - ${DB}] RDCConnector.GetConnection: Conexión obtenida. IsInitialized: ${conn.IsInitialized}"$)
If pool.IsInitialized Then ' Doble verificación del estado del pool para logging más seguro
' Dim jo As JavaObject = pool
' Aseguramos que los valores de C3P0 sean Ints, manejando posibles retornos como Double.
' Dim busyCount As Int = jo.RunMethod("getNumBusyConnectionsAllUsers", Null).As(Object).As(Int)
' Dim totalCount As Int = jo.RunMethod("getNumConnectionsAllUsers", Null).As(Object).As(Int)
' Log($"[DEBUG - ${DB}] RDCConnector.GetConnection: Estadísticas del Pool (después de obtener): Busy=${busyCount}, Total=${totalCount}"$)
End If
' <<<< Fin del bloque de Logs de Depuración >>>>
Return conn ' Retorna una conexión del pool.
End Sub End Sub
' Carga todos los comandos SQL del mapa de configuración en el mapa global 'commandsMap' de Main.
' config2: El mapa de configuración de la DB actual (JdbcUrl, User, Password, etc.).
' DB: El identificador de la base de datos.
Private Sub LoadSQLCommands(config2 As Map, DB As String) Private Sub LoadSQLCommands(config2 As Map, DB As String)
Log("==== LoadSQLCommands ==== ")
Log($"Cargamos los comandos desde el config.${DB}.properties"$)
Dim newCommands As Map Dim newCommands As Map
newCommands.Initialize newCommands.Initialize
For Each k As String In config2.Keys For Each k As String In config2.Keys
If k.StartsWith("sql.") Then If k.StartsWith("sql.") Then ' Busca claves que comiencen con "sql." (ej. "sql.select_user").
newCommands.Put(k, config2.Get(k)) newCommands.Put(k, config2.Get(k)) ' Añade el comando al mapa.
End If End If
Next Next
commands = newCommands
' Log($"Inicializado: ${DB} "$ & Main.commandsMap.IsInitialized) commands = newCommands ' Actualiza el mapa de comandos de esta instancia de RDCConnector.
Main.commandsMap.Put(DB, commands) Main.commandsMap.Put(DB, commands) ' Almacena el mapa de comandos en el mapa global 'commandsMap' de Main.
End Sub End Sub
' Nuevo: Obtiene estadísticas detalladas del pool de conexiones.
' Es utilizado por el Manager para mostrar el estado del pool.
Public Sub GetPoolStats As Map
Dim stats As Map
stats.Initialize
' Log("--- RDCConnector.GetPoolStats llamado ---") ' Log de inicio (descomentar si es necesario)
If pool.IsInitialized Then
' Log("RDCConnector.GetPoolStats: Pool está inicializado. Intentando obtener métricas.") ' Log (descomentar si es necesario)
Dim jo As JavaObject = pool ' Convertimos el objeto pool a JavaObject para acceder a sus métodos internos de C3P0.
Try
' --- Métricas en tiempo real del pool ---
' Se obtienen los valores y se aseguran como objetos para su posterior manejo en el mapa.
Dim totalConn As Object = jo.RunMethod("getNumConnectionsAllUsers", Null)
stats.Put("TotalConnections", totalConn)
' Log($"RDCConnector.GetPoolStats: TotalConnections = ${totalConn}"$) ' Log (descomentar si es necesario)
Dim busyConn As Object = jo.RunMethod("getNumBusyConnectionsAllUsers", Null)
stats.Put("BusyConnections", busyConn)
' Log($"RDCConnector.GetPoolStats: BusyConnections = ${busyConn}"$) ' Log (descomentar si es necesario)
Dim idleConn As Object = jo.RunMethod("getNumIdleConnectionsAllUsers", Null)
stats.Put("IdleConnections", idleConn)
' Log($"RDCConnector.GetPoolStats: IdleConnections = ${idleConn}"$) ' Log (descomentar si es necesario)
' --- Valores de configuración del pool (para referencia) ---
' Se obtienen y almacenan los parámetros de configuración del pool.
Dim initialSize As Object = jo.RunMethod("getInitialPoolSize", Null)
stats.Put("InitialPoolSize", initialSize)
' Log($"RDCConnector.GetPoolStats: InitialPoolSize = ${initialSize}"$) ' Log (descomentar si es necesario)
Dim minSize As Object = jo.RunMethod("getMinPoolSize", Null)
stats.Put("MinPoolSize", minSize)
' Log($"RDCConnector.GetPoolStats: MinPoolSize = ${minSize}"$) ' Log (descomentar si es necesario)
Dim maxSize As Object = jo.RunMethod("getMaxPoolSize", Null)
stats.Put("MaxPoolSize", maxSize)
' Log($"RDCConnector.GetPoolStats: MaxPoolSize = ${maxSize}"$) ' Log (descomentar si es necesario)
Dim acquireInc As Object = jo.RunMethod("getAcquireIncrement", Null)
stats.Put("AcquireIncrement", acquireInc)
' Log($"RDCConnector.GetPoolStats: AcquireIncrement = ${acquireInc}"$) ' Log (descomentar si es necesario)
Dim maxIdle As Object = jo.RunMethod("getMaxIdleTime", Null)
stats.Put("MaxIdleTime", maxIdle)
' Log($"RDCConnector.GetPoolStats: MaxIdleTime = ${maxIdle}"$) ' Log (descomentar si es necesario)
Dim maxAge As Object = jo.RunMethod("getMaxConnectionAge", Null)
stats.Put("MaxConnectionAge", maxAge)
' Log($"RDCConnector.GetPoolStats: MaxConnectionAge = ${maxAge}"$) ' Log (descomentar si es necesario)
Dim checkoutTime As Object = jo.RunMethod("getCheckoutTimeout", Null)
stats.Put("CheckoutTimeout", checkoutTime)
' Log($"RDCConnector.GetPoolStats: CheckoutTimeout = ${checkoutTime}"$) ' Log (descomentar si es necesario)
Catch
' Si ocurre un error al obtener las estadísticas, se registra y se añade un mensaje de error al mapa.
Dim ErrorMsg As String = "RDCConnector.GetPoolStats: ERROR CRÍTICO al obtener estadísticas del pool: " & LastException.Message
Log(ErrorMsg)
Main.LogServerError("ERROR", "RDCConnector.GetPoolStats", ErrorMsg, "Todas", Null, Null) ' <-- Nuevo Log
stats.Put("Error", LastException.Message)
End Try
Else
' Si el pool no está inicializado, se registra una advertencia y se devuelve un mapa con un error.
Dim WarningMsg As String = "RDCConnector.GetPoolStats: ADVERTENCIA: Pool NO está inicializado. Retornando mapa con error."
Log(WarningMsg)
Main.LogServerError("ADVERTENCIA", "RDCConnector.GetPoolStats", WarningMsg, "Todas", Null, Null) ' <-- Nuevo Log
stats.Put("Error", "Pool de conexiones no inicializado para esta DB.")
End If
' Se utiliza JSONGenerator para serializar el mapa de estadísticas a String para el log,
' lo que permite una visualización estructurada y fácil de leer.
Dim tempJsonGen As JSONGenerator
tempJsonGen.Initialize(stats)
' Log("--- RDCConnector.GetPoolStats finalizado. Retornando stats: " & tempJsonGen.ToString & " ---") ' Log de fin (descomentar si es necesario)
Return stats
End Sub
' *** NUEVA SUBRUTINA: Cierra el pool de conexiones de forma ordenada usando JavaObject ***
' Este método es crucial para liberar los recursos de la base de datos cuando un conector RDC
' ya no es necesario o va a ser reemplazado (por ejemplo, durante un "Hot-Swap" de configuración).
Public Sub Close
If pool <> Null And pool.IsInitialized Then
' Log($"RDCConnector.Close: Cerrando pool de conexiones."$) ' Log (descomentar si es necesario)
' Convertimos el objeto pool de B4X a un JavaObject para poder llamar a su método 'close()'
' que no está expuesto directamente en la envoltura de B4X, asegurando un cierre limpio de C3P0.
Dim joPool As JavaObject = pool
joPool.RunMethod("close", Null) ' Llamamos al método 'close()' del objeto Java subyacente de C3P0.
End If
End Sub

View File

@@ -1,320 +0,0 @@
B4J=true
Group=Default Group
ModulesStructureVersion=1
Type=Class
Version=4.19
@EndOfDesignText@
'Handler class
Sub Class_Globals
' #if VERSION1
Private const T_NULL = 0, T_STRING = 1, T_SHORT = 2, T_INT = 3, T_LONG = 4, T_FLOAT = 5 _
,T_DOUBLE = 6, T_BOOLEAN = 7, T_BLOB = 8 As Byte
Private bc As ByteConverter
Private cs As CompressedStreams
' #end if
Private DateTimeMethods As Map
End Sub
Public Sub Initialize
DateTimeMethods = CreateMap(91: "getDate", 92: "getTime", 93: "getTimestamp")
End Sub
Sub Handle(req As ServletRequest, resp As ServletResponse)
Log("***********************************************")
Log(">>>> RDC")
Dim start As Long = DateTime.Now
Dim q As String
Dim in As InputStream = req.InputStream
Dim method As String = req.GetParameter("method")
Dim con As SQL
Try
con = Main.rdcConnector0.GetConnection("")
If method = "query2" Then
q = ExecuteQuery2(con, in, resp)
'#if VERSION1
Else if method = "query" Then
in = cs.WrapInputStream(in, "gzip")
q = ExecuteQuery(con, in, resp)
Else if method = "batch" Then
in = cs.WrapInputStream(in, "gzip")
q = ExecuteBatch(con, in, resp)
'#end if
Else if method = "batch2" Then
q = ExecuteBatch2(con, in, resp)
Else
Log("Unknown method: " & method)
resp.SendError(500, "unknown method")
End If
Catch
Log(LastException)
resp.SendError(500, LastException.Message)
End Try
If con <> Null And con.IsInitialized Then con.Close
Log($"Command: ${q}, took: ${DateTime.Now - start}ms, client=${req.RemoteAddress}"$)
End Sub
Private Sub ExecuteQuery2 (con As SQL, in As InputStream, resp As ServletResponse) As String
Dim ser As B4XSerializator
Dim m As Map = ser.ConvertBytesToObject(Bit.InputStreamToBytes(in))
Dim cmd As DBCommand = m.Get("command")
Dim limit As Int = m.Get("limit")
Dim rs As ResultSet = con.ExecQuery2(Main.rdcConnector0.GetCommand(cmd.Name), cmd.Parameters)
If limit <= 0 Then limit = 0x7fffffff 'max int
Dim jrs As JavaObject = rs
Dim rsmd As JavaObject = jrs.RunMethod("getMetaData", Null)
Dim cols As Int = rs.ColumnCount
Dim res As DBResult
res.Initialize
res.columns.Initialize
res.Tag = Null 'without this the Tag properly will not be serializable.
For i = 0 To cols - 1
res.columns.Put(rs.GetColumnName(i), i)
Next
res.Rows.Initialize
Do While rs.NextRow And limit > 0
Dim row(cols) As Object
For i = 0 To cols - 1
Dim ct As Int = rsmd.RunMethod("getColumnType", Array(i + 1))
'check whether it is a blob field
If ct = -2 Or ct = 2004 Or ct = -3 Or ct = -4 Then
row(i) = rs.GetBlob2(i)
Else If ct = 2005 Then
row(i) = rs.GetString2(i)
Else if ct = 2 Or ct = 3 Then
row(i) = rs.GetDouble2(i)
Else If DateTimeMethods.ContainsKey(ct) Then
Dim SQLTime As JavaObject = jrs.RunMethodJO(DateTimeMethods.Get(ct), Array(i + 1))
If SQLTime.IsInitialized Then
row(i) = SQLTime.RunMethod("getTime", Null)
Else
row(i) = Null
End If
Else
row(i) = jrs.RunMethod("getObject", Array(i + 1))
End If
Next
res.Rows.Add(row)
Loop
rs.Close
Dim data() As Byte = ser.ConvertObjectToBytes(res)
resp.OutputStream.WriteBytes(data, 0, data.Length)
Return "query: " & cmd.Name
End Sub
Private Sub ExecuteBatch2(con As SQL, in As InputStream, resp As ServletResponse) As String
Dim ser As B4XSerializator
Dim m As Map = ser.ConvertBytesToObject(Bit.InputStreamToBytes(in))
Dim commands As List = m.Get("commands")
Dim res As DBResult
res.Initialize
res.columns = CreateMap("AffectedRows (N/A)": 0)
res.Rows.Initialize
res.Tag = Null
Try
con.BeginTransaction
For Each cmd As DBCommand In commands
con.ExecNonQuery2(Main.rdcConnector0.GetCommand(cmd.Name), _
cmd.Parameters)
Next
res.Rows.Add(Array As Object(0))
con.TransactionSuccessful
Catch
con.Rollback
Log(LastException)
resp.SendError(500, LastException.Message)
End Try
Dim data() As Byte = ser.ConvertObjectToBytes(res)
resp.OutputStream.WriteBytes(data, 0, data.Length)
Return $"batch (size=${commands.Size})"$
End Sub
'#if VERSION1
Private Sub ExecuteBatch(con As SQL, in As InputStream, resp As ServletResponse) As String
Dim clientVersion As Float = ReadObject(in) 'ignore
Dim numberOfStatements As Int = ReadInt(in)
Dim res(numberOfStatements) As Int
Try
con.BeginTransaction
For i = 0 To numberOfStatements - 1
Dim queryName As String = ReadObject(in)
Dim params As List = ReadList(in)
con.ExecNonQuery2(Main.rdcConnector0.GetCommand(queryName), _
params)
Next
con.TransactionSuccessful
Dim out As OutputStream = cs.WrapOutputStream(resp.OutputStream, "gzip")
WriteObject(Main.VERSION, out)
WriteObject("batch", out)
WriteInt(res.Length, out)
For Each r As Int In res
WriteInt(r, out)
Next
out.Close
Catch
con.Rollback
Log(LastException)
resp.SendError(500, LastException.Message)
End Try
Return $"batch (size=${numberOfStatements})"$
End Sub
Private Sub ExecuteQuery (con As SQL, in As InputStream, resp As ServletResponse) As String
' Log("==== ExecuteQuery ==== ")
Dim clientVersion As Float = ReadObject(in) 'ignore
Dim queryName As String = ReadObject(in)
Dim limit As Int = ReadInt(in)
Dim params As List = ReadList(in)
' Log("EL QUERY: |" & queryName & "|")
Private theSql As String = Main.rdcConnector0.GetCommand(queryName)
' Log(theSql)
' Log(params)
' Log(params.Size)
Dim rs As ResultSet = con.ExecQuery2(theSql, params)
If limit <= 0 Then limit = 0x7fffffff 'max int
Dim jrs As JavaObject = rs
Dim rsmd As JavaObject = jrs.RunMethod("getMetaData", Null)
Dim cols As Int = rs.ColumnCount
Dim out As OutputStream = cs.WrapOutputStream(resp.OutputStream, "gzip")
WriteObject(Main.VERSION, out)
WriteObject("query", out)
WriteInt(rs.ColumnCount, out)
' Log($"cols: ${cols}"$)
For i = 0 To cols - 1
WriteObject(rs.GetColumnName(i), out)
Next
Do While rs.NextRow And limit > 0
WriteByte(1, out)
For i = 0 To cols - 1
Dim ct As Int = rsmd.RunMethod("getColumnType", Array(i + 1))
'check whether it is a blob field
If ct = -2 Or ct = 2004 Or ct = -3 Or ct = -4 Then
WriteObject(rs.GetBlob2(i), out)
Else
WriteObject(jrs.RunMethod("getObject", Array(i + 1)), out)
End If
Next
Loop
WriteByte(0, out)
out.Close
rs.Close
Return "query: " & queryName
End Sub
Private Sub WriteByte(value As Byte, out As OutputStream)
out.WriteBytes(Array As Byte(value), 0, 1)
End Sub
Private Sub WriteObject(o As Object, out As OutputStream)
Dim data() As Byte
If o = Null Then
out.WriteBytes(Array As Byte(T_NULL), 0, 1)
Else If o Is Short Then
out.WriteBytes(Array As Byte(T_SHORT), 0, 1)
data = bc.ShortsToBytes(Array As Short(o))
Else If o Is Int Then
out.WriteBytes(Array As Byte(T_INT), 0, 1)
data = bc.IntsToBytes(Array As Int(o))
Else If o Is Float Then
out.WriteBytes(Array As Byte(T_FLOAT), 0, 1)
data = bc.FloatsToBytes(Array As Float(o))
Else If o Is Double Then
out.WriteBytes(Array As Byte(T_DOUBLE), 0, 1)
data = bc.DoublesToBytes(Array As Double(o))
Else If o Is Long Then
out.WriteBytes(Array As Byte(T_LONG), 0, 1)
data = bc.LongsToBytes(Array As Long(o))
Else If o Is Boolean Then
out.WriteBytes(Array As Byte(T_BOOLEAN), 0, 1)
Dim b As Boolean = o
Dim data(1) As Byte
If b Then data(0) = 1 Else data(0) = 0
Else If GetType(o) = "[B" Then
data = o
out.WriteBytes(Array As Byte(T_BLOB), 0, 1)
WriteInt(data.Length, out)
Else 'If o Is String Then (treat all other values as string)
out.WriteBytes(Array As Byte(T_STRING), 0, 1)
data = bc.StringToBytes(o, "UTF8")
WriteInt(data.Length, out)
End If
If data.Length > 0 Then out.WriteBytes(data, 0, data.Length)
End Sub
Private Sub ReadObject(In As InputStream) As Object
Dim data(1) As Byte
In.ReadBytes(data, 0, 1)
Select data(0)
Case T_NULL
Return Null
Case T_SHORT
Dim data(2) As Byte
Return bc.ShortsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_INT
Dim data(4) As Byte
Return bc.IntsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_LONG
Dim data(8) As Byte
Return bc.LongsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_FLOAT
Dim data(4) As Byte
Return bc.FloatsFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_DOUBLE
Dim data(8) As Byte
Return bc.DoublesFromBytes(ReadBytesFully(In, data, data.Length))(0)
Case T_BOOLEAN
Dim b As Byte = ReadByte(In)
Return b = 1
Case T_BLOB
Dim len As Int = ReadInt(In)
Dim data(len) As Byte
Return ReadBytesFully(In, data, data.Length)
Case Else
Dim len As Int = ReadInt(In)
Dim data(len) As Byte
ReadBytesFully(In, data, data.Length)
Return BytesToString(data, 0, data.Length, "UTF8")
End Select
End Sub
Private Sub ReadBytesFully(In As InputStream, Data() As Byte, Len As Int) As Byte()
Dim count = 0, Read As Int
Do While count < Len And Read > -1
Read = In.ReadBytes(Data, count, Len - count)
count = count + Read
Loop
Return Data
End Sub
Private Sub WriteInt(i As Int, out As OutputStream)
Dim data() As Byte
data = bc.IntsToBytes(Array As Int(i))
out.WriteBytes(data, 0, data.Length)
End Sub
Private Sub ReadInt(In As InputStream) As Int
Dim data(4) As Byte
Return bc.IntsFromBytes(ReadBytesFully(In, data, data.Length))(0)
End Sub
Private Sub ReadByte(In As InputStream) As Byte
Dim data(1) As Byte
In.ReadBytes(data, 0, 1)
Return data(0)
End Sub
Private Sub ReadList(in As InputStream) As List
Dim len As Int = ReadInt(in)
Dim l1 As List
l1.Initialize
For i = 0 To len - 1
l1.Add(ReadObject(in))
Next
Return l1
End Sub
'#end If

153
README.md
View File

@@ -1,20 +1,24 @@
# **Servidor jRDC2-Multi Mod (B4J)** # **Servidor jRDC2-Multi Mod (B4J)**
## **1\. Introducción** ## **1. Introducción**
Este proyecto es una versión modificada del servidor [jRDC2 original](https://www.b4x.com/android/forum/threads/b4x-jrdc2-b4j-implementation-of-rdc-remote-database-connector.61801/#content), diseñada para actuar como un backend robusto y flexible. Su función principal es recibir peticiones HTTP, ejecutar comandos SQL predefinidos contra una base de datos y devolver los resultados en un formato estructurado. Este proyecto es una versión modificada del servidor [jRDC2 original](https://www.b4x.com/android/forum/threads/b4x-jrdc2-b4j-implementation-of-rdc-remote-database-connector.61801/#content), diseñada para actuar como un backend robusto y flexible. Su función principal es recibir peticiones HTTP, ejecutar comandos SQL predefinidos contra una base de datos y devolver los resultados en un formato estructurado.
Ha sido adaptado para servir tanto a clientes nativos (`B4A/B4i`) como a clientes web modernos (`JavaScript`, a través de frameworks como `NodeJS, React, Vue, Angular, etc`.). Ha sido adaptado para servir tanto a clientes nativos (`B4A/B4i`) como a clientes web modernos (`JavaScript`, a través de frameworks como `NodeJS, React, Vue, Angular, etc`.).
## **2\. Características Principales** -----
- **Soporte para Múltiples Bases de Datos**: Puede cargar y gestionar hasta 4 archivos de configuración (`config.properties`) simultáneamente. ## **2. Características Principales**
- **Comandos SQL Externalizados**: Las sentencias SQL se definen en los archivos de configuración, permitiendo modificarlas sin recompilar el servidor.
- **Doble Handler de Peticiones**: Incluye un handler clásico para clientes B4X y un handler JSON para clientes web.
- **Validaciones de Seguridad**: Verifica la existencia de comandos y la correspondencia en el número de parámetros.
- **Administración Remota**: Permite verificar el estado, recargar la configuración y reiniciar el servidor a través de URLs específicas.
## **3\. Configuración** * **Soporte para Múltiples Bases de Datos**: Puede cargar y gestionar hasta 4 archivos de configuración (`config.properties`) simultáneamente.
* **Comandos SQL Externalizados**: Las sentencias SQL se definen en los archivos de configuración, permitiendo modificarlas sin recompilar el servidor.
* **Doble Handler de Peticiones**: Incluye un handler clásico para clientes B4X y un handler JSON para clientes web.
* **Validaciones de Seguridad**: Verifica la existencia de comandos y la correspondencia en el número de parámetros antes de la ejecución.
* **Administración Remota**: Permite verificar el estado, recargar la configuración y reiniciar el servidor a través de URLs específicas, con un sistema de autenticación.
-----
## **3. Configuración**
### **3.1. Archivos de Configuración** ### **3.1. Archivos de Configuración**
@@ -22,15 +26,15 @@ El sistema está preparado para manejar hasta **cuatro configuraciones de bases
La nomenclatura de los archivos es fundamental: La nomenclatura de los archivos es fundamental:
- `config.properties` (para `DB1`) * `config.properties` (para `DB1`)
- `config.DB2.properties` * `config.DB2.properties`
- `config.DB3.properties` * `config.DB3.properties`
- `config.DB4.properties` * `config.DB4.properties`
**Notas importantes:** **Notas importantes:**
- El **puerto** del servidor se toma **únicamente** del archivo principal `config.properties`, sin importar lo que digan los demás. * El **puerto** del servidor se toma **únicamente** del archivo principal `config.properties`, sin importar lo que digan los demás.
- Los datos de conexión (`JdbcUrl`, `usuario`, `contraseña`) sí se toman del archivo correspondiente a cada base de datos. * Los datos de conexión (`JdbcUrl`, `usuario`, `contraseña`) sí se toman del archivo correspondiente a cada base de datos.
### **3.2. Añadir Drivers de Bases de Datos Adicionales** ### **3.2. Añadir Drivers de Bases de Datos Adicionales**
@@ -43,94 +47,115 @@ Si necesitas conectarte a otros tipos de bases de datos (ej. Oracle), debes agre
Al compilar, el driver se incluirá en el `.jar` final del servidor, por lo que no será necesario copiarlo por separado al directorio de producción. Al compilar, el driver se incluirá en el `.jar` final del servidor, por lo que no será necesario copiarlo por separado al directorio de producción.
## **4\. Uso del Handler Clásico (Para Clientes B4X)** -----
## **4. Validaciones de Seguridad**
El servidor realiza dos comprobaciones automáticas **en ambos handlers (B4X y JSON)** antes de ejecutar cualquier consulta:
1. **Verificación de Existencia del Comando**: El servidor comprueba que el nombre del comando SQL solicitado (ej. `"get_user"`) exista como una clave válida en el archivo `.properties` correspondiente. Si no lo encuentra, devolverá un error y no intentará ejecutar nada.
2. **Conteo de Parámetros**: Si el comando SQL en el archivo de configuración espera parámetros (contiene `?`), el servidor cuenta cuántos son y lo compara con el número de parámetros recibidos en la petición. Si las cantidades no coinciden, devolverá un error específico, evitando una ejecución fallida en la base de datos.
Estas validaciones aseguran que el desarrollador reciba feedback inmediato y claro si una petición está mal formada.
-----
## **5. Uso del Handler Clásico (Para Clientes B4X)**
Este handler mantiene la compatibilidad con `DBRequestManager`. La selección de la base de datos se realiza dinámicamente a través de la URL. Este handler mantiene la compatibilidad con `DBRequestManager`. La selección de la base de datos se realiza dinámicamente a través de la URL.
- Para `config.properties` \=\> `http://tu-dominio.com:8090` * Para `config.properties` =\> `http://tu-dominio.com:8090`
- Para `config.DB2.properties` \=\> `http://tu-dominio.com:8090/DB2` * Para `config.DB2.properties` =\> `http://tu-dominio.com:8090/DB2`
- Para `config.DB3.properties` \=\> `http://tu-dominio.com:8090/DB3` * Para `config.DB3.properties` =\> `http://tu-dominio.com:8090/DB3`
- Para `config.DB4.properties` \=\> `http://tu-dominio.com:8090/DB4` * Para `config.DB4.properties` =\> `http://tu-dominio.com:8090/DB4`
## **5\. Uso del DBHandlerJSON (Para Clientes Web)** -----
## **6. Uso del DBHandlerJSON (Para Clientes Web)**
Este handler está diseñado para clientes que se comunican vía `JSON`, como aplicaciones web JavaScript. Este handler está diseñado para clientes que se comunican vía `JSON`, como aplicaciones web JavaScript.
### **5.1. Endpoint y Métodos de Envío** ### **6.1. Endpoint y Métodos de Envío**
Las peticiones van dirigidas al endpoint `/DBJ`. El handler es flexible y acepta datos de dos maneras: Las peticiones van dirigidas al endpoint `/DBJ`. El handler es flexible y acepta datos de dos maneras:
**Método Recomendado: POST con Body JSON** **Método Recomendado: POST con Body JSON**
Esta es la forma más limpia y estándar para las APIs modernas. * **Método HTTP**: POST
* **URL**: `http://tu-dominio.com:8090/DBJ`
- **Método HTTP**: POST * **Header Requerido**: `Content-Type: application/json`
- **URL**: http://tu-dominio.com:8090/DBJ * **Body (Payload)**: El objeto JSON se envía directamente en el cuerpo de la petición.
- **Header Requerido**: Content-Type: application/json
- **Body (Payload)**: El objeto JSON se envía directamente en el cuerpo de la petición.
**Ejemplo de Body:** **Ejemplo de Body:**
``` ```json
{ {
"dbx": "DB2", "dbx": "DB2",
"query": "get\_user", "query": "get_user",
"exec": "executeQuery", "exec": "executeQuery",
"params": { "params": [
"par1": "CDAZA" "CDAZA"
} ]
} }
``` ```
**Método Legacy: GET con Parámetro `j`** **Método Legacy: GET con Parámetro `j`**
Este método se mantiene por retrocompatibilidad. * **Método HTTP**: GET
* **URL**: El JSON completo se envía como el valor del parámetro `j` en la URL.
- **Método HTTP**: GET (o POST con Content-Type: application/x-www-form-urlencoded) **Ejemplo con GET:**
- **URL**: El JSON completo se envía como el valor del parámetro `j` en la URL. `http://tu-dominio.com:8090/DBJ?j={"dbx":"DB2","query":"get_user","exec":"executeQuery","params":["CDAZA"]}`
Ejemplo con GET: ### **6.2. Formato del Payload JSON**
http://tu-dominio.com:8090/DBJ?j={"dbx":"DB2","query":"get\_user","exec":"executeQuery","params":{"par1":"CDAZA"}}
### **5.2. Formato del Payload JSON**
La estructura del objeto JSON es la misma para ambos métodos: La estructura del objeto JSON es la misma para ambos métodos:
``` ```json
{ {
"exec": "executeQuery", "exec": "executeQuery",
"query": "nombre\_del\_comando\_sql", "query": "nombre_del_comando_sql",
"dbx": "DB1", "dbx": "DB1",
"params": { "params": [
"par1": "valor1", "valor1",
"par2": 123 123
} ]
} }
``` ```
- `exec`: `"executeQuery"` (para SELECT) o `"executeCommand"` (para INSERT, UPDATE, DELETE). * `exec`: `"executeQuery"` (para `SELECT`) o `"executeCommand"` (para `INSERT`, `UPDATE`, `DELETE`).
- `query`: Nombre del comando SQL tal como está definido en el archivo de configuración (ej. `select\_user`). * `query`: Nombre del comando SQL tal como está definido en el archivo de configuración.
- `dbx` (opcional): La llave de la base de datos (`DB1`, `DB2`, etc.). Si se omite, se usará **DB1** por defecto. * `dbx` (opcional): La llave de la base de datos (`DB1`, `DB2`, etc.). Si se omite, se usará **DB1**.
- `params` (opcional): Un objeto que contiene los parámetros para la consulta SQL. * `params` (opcional): Un **array** que contiene los parámetros para la consulta SQL, en el orden exacto que se esperan.
### **5.3. ¡Importante\! Envío de Parámetros** ### **6.3. Respuestas JSON**
El servidor ordena las claves de los parámetros alfabéticamente antes de pasarlos a la consulta SQL. Para asegurar que los valores se asignen al `?` correcto, **debes nombrar las claves de los parámetros de forma secuencial**: `"par1"`, `"par2"`, `"par3"`, etc.
**Nota para más de 9 parámetros**: Si tienes 10 o más parámetros, usa un cero inicial para mantener el orden alfabético correcto (ej. `"par01"`, `"par02"`, ..., `"par10"`).
### **5.4. Respuestas JSON**
Las respuestas del servidor siempre son en formato JSON e incluyen un campo booleano `success`. Las respuestas del servidor siempre son en formato JSON e incluyen un campo booleano `success`.
- **Si success es true**, los datos se encontrarán en la llave `result`. * **Si `success` es `true`**, los datos se encontrarán en la llave `result`.
- **Si success es false**, el mensaje de error se encontrará en la llave `error`. * **Si `success` es `false`**, el mensaje de error se encontrará en la llave `error`.
## **6\. Administración del Servidor** -----
Se pueden ejecutar comandos de gestión directamente desde un navegador o una herramienta como cURL. ## **7. Administración del Servidor**
- **Verificar Estado**: `http://tu-dominio.com:8090/test` Se pueden ejecutar comandos de gestión directamente desde un navegador o una herramienta como `cURL`.
- **Recargar Configuración**: `http://tu-dominio.com:8090/manager?command=reload` (Vuelve a leer todos los archivos `config.\*.properties` sin reiniciar el servidor).
- **Reiniciar Servidor (Estándar)**: `http://tu-dominio.com:8090/manager?command=rsx` (Ejecuta los scripts `start.bat`, `start2.bat` y `stop.bat`). ### **7.1. Comandos de Administración**
- **Reiniciar Servidor (con PM2)**: `http://tu-dominio.com:8090/manager?command=rpm2` (Ejecuta `reiniciaProcesoPM2.bat` y asume que el nombre del proceso es "RDC-Multi". Modificar el `.bat` si el nombre es diferente).
#### **Comandos Públicos (sin autenticación)**
* **Verificar Conectividad**: `http://tu-dominio.com:8090/ping`
* Responde con un simple `PONG` y la `hora` para confirmar que el servidor está en línea.
* **Verificar Estado Detallado**: `http://tu-dominio.com:8090/test`
* Muestra información sobre las conexiones a la base de datos y el estado general.
#### **Comandos Protegidos (requieren autenticación)**
* **Recargar Configuración**: `http://tu-dominio.com:8090/manager?command=reload`
(Vuelve a leer todos los archivos `config.*.properties` sin reiniciar el servidor).
* **Reiniciar Servidor (Estándar)**: `http://tu-dominio.com:8090/manager?command=rsx`
(Ejecuta los scripts `start.bat`, `start2.bat` y `stop.bat`).
* **Reiniciar Servidor (con PM2)**: `http://tu-dominio.com:8090/manager?command=rpm2`
(Ejecuta `reiniciaProcesoPM2.bat` y asume que el nombre del proceso es "RDC-Multi". Modificar el `.bat` si el nombre es diferente).

View File

@@ -1,48 +0,0 @@
# jRDC-Multi (B4J)
Servidor de DBRequest que puede cargar hasta 4 archivos de config.properties al mismo tiempo.
Los archivos se deben de llamar:
- config.propierties
- config.DB2.properties
- config.DB3.properties
- config.DB4.properties
No es necesario que sean 4 archivos, solo toma en cuenta los archivos existentes en el directorio.
En la aplicacion movil, al URL del servidor se le agrega al final /DB2, /DB3 o /DB4. (Puerto de ejemplo: 1781)
- Para usar el config.properties => http://keymon.lat:1781
- Para usar el config.DB2.properties => http://keymon.lat:1781/DB2
- Para usar el config.DB3.properties => http://keymon.lat:1781/DB3
- Para usar el config.DB4.properties => http://keymon.lat:1781/DB4
El puerto es el mismo para todos los archivos, **sin importar** que diga en cada archivo, solo toma el puerto especificado en el **primer** config.properties.
El usuario, contraseña y JdbcUrl, **si** los toma del archivo correspondiente.
Se puede revisar el **estatus** del servidor en el URL:
- http://keymon.lat:1781/test
Se puede forzar al servidor (**sin reiniciarlo**) a que **recargue** los archivos config.properties en el URL:
- http://keymon.lat:1781/manager?command=reload
Se puede reiniciar el servidor con el URL:
- http://keymon.lat:1781/manager?command=rsx
- Este comando utiliza los archivos start.bat, start2.bat y stop.bat
Si se esta corriendo el servidor con PM2, se puede reinciar con el URL:
- http://keymon.lat:1781/manager?command=rpm2
- Este comando ejecuta el archivo reiniciaProcesoPM2.bat, y **asume** que el nombre del proceso es "RDC-Multi", si no es asi, hay que **modificar** el archivo .bat
## Agregar drivers de mas bases de datos
Si se necesitan agregar mas controladores para conectarse a otras bases de datos, hay que agregar una linea a "Main":
- #AdditionalJar: ojdbc11 <= este es el nombre del archivo .jar, en este caso "C:\Android\AdditionalLibs\B4J\ojdbc11.jar"
- Al compilar la aplicación, el archivo del controlador se incluye en el archivo .jar del servidor (jRDC-Multi.jar) y no es necesario copiarlo o agregarlo al directorio del servidor en producción.

View File

@@ -1,105 +0,0 @@
# Servidor jRDC2-Multi Modificado (B4J)
## 1. Introducción
Este proyecto es una versión modificada del servidor [jRDC2 original](https://www.b4x.com/android/forum/threads/b4x-jrdc2-b4j-implementation-of-rdc-remote-database-connector.61801/#content), diseñada para actuar como un backend robusto y flexible. Su función principal es recibir peticiones HTTP, ejecutar comandos SQL predefinidos contra una base de datos y devolver los resultados en un formato estructurado.
Ha sido adaptado para servir tanto a clientes nativos (B4A/B4i) como a clientes web modernos (JavaScript, a través de frameworks como React, Vue, Angular, etc.).
## 2. Características Principales
* **Soporte para Múltiples Bases de Datos**: Puede cargar y gestionar hasta 4 archivos de configuración (`config.properties`) simultáneamente.
* **Comandos SQL Externalizados**: Las sentencias SQL se definen en los archivos de configuración, permitiendo modificarlas sin recompilar el servidor.
* **Doble Handler de Peticiones**: Incluye un handler clásico para clientes B4X y un handler JSON para clientes web.
* **Validaciones de Seguridad**: Verifica la existencia de comandos y la correspondencia en el número de parámetros.
* **Administración Remota**: Permite verificar el estado, recargar la configuración y reiniciar el servidor a través de URLs específicas.
## 3. Configuración
### 3.1. Archivos de Configuración
El sistema está preparado para manejar hasta **cuatro configuraciones de bases de datos** (de `DB1` a `DB4`). No es necesario tener los cuatro archivos; el servidor cargará únicamente los que encuentre.
La nomenclatura de los archivos es fundamental:
* `config.properties` (para `DB1`)
* `config.DB2.properties`
* `config.DB3.properties`
* `config.DB4.properties`
**Notas importantes:**
* El **puerto** del servidor se toma **únicamente** del archivo principal `config.properties`, sin importar lo que digan los demás.
* Los datos de conexión (`JdbcUrl`, usuario, contraseña) sí se toman del archivo correspondiente a cada base de datos.
### 3.2. Añadir Drivers de Bases de Datos Adicionales
Si necesitas conectarte a otros tipos de bases de datos (ej. Oracle), debes agregar el archivo del controlador `.jar` al proyecto antes de compilar. En el módulo `Main`, añade una línea como la siguiente:
```b4x
' Este es el nombre del archivo .jar, en este caso "C:\Ruta\Adicional\ojdbc11.jar"
#AdditionalJar: ojdbc11
````
Al compilar, el driver se incluirá en el `.jar` final del servidor, por lo que no será necesario copiarlo por separado al directorio de producción.
## 4\. Uso del Handler Clásico (Para Clientes B4X)
Este handler mantiene la compatibilidad con `DBRequestManager`. La selección de la base de datos se realiza dinámicamente a través de la URL.
* Para `config.properties` =\> `http://tu-dominio.com:8090`
* Para `config.DB2.properties` =\> `http://tu-dominio.com:8090/DB2`
* Para `config.DB3.properties` =\> `http://tu-dominio.com:8090/DB3`
* Para `config.DB4.properties` =\> `http://tu-dominio.com:8090/DB4`
## 5\. Uso del `DB1JsonHandler` (Para Clientes Web)
Este handler es para clientes que se comunican vía JSON.
### 5.1. Endpoint y Métodos
Las peticiones van al endpoint `/DBJ` y deben incluir un parámetro `j` con el JSON. Soporta `GET` y `POST`.
**Ejemplo con `GET`:**
`http://tu-dominio.com:8090/db1json?j={"dbx":"DB2","query":"get_user","exec":"executeQuery","params":{"par1":"CDAZA"}}`
### 5.2. Formato del Parámetro `j`
```json
{
"exec": "executeQuery",
"query": "nombre_del_comando_sql",
"dbx": "DB1",
"params": {
"par1": "valor1",
"par2": 123
}
}
```
* `exec`: `"executeQuery"` (para `SELECT`) o `"executeCommand"` (para `INSERT`, `UPDATE`, etc.).
* `query`: Nombre del comando SQL en el archivo de configuración.
* `dbx` (opcional): La llave de la BD (`DB1`, `DB2`, etc.). Si se omite, usa `DB1`.
* `params` (opcional): Objeto con los parámetros.
### 5.3. ¡Importante\! Envío de Parámetros
El servidor ordena las claves de los parámetros alfabéticamente. Para asegurar el orden correcto, **nombra las claves secuencialmente**: `"par1"`, `"par2"`, etc.
> **Nota para más de 9 parámetros**: Usa un cero inicial para mantener el orden (`"par01"`, `"par02"`, ..., `"par10"`).
### 5.4. Respuestas JSON
Las respuestas siempre incluyen `"success": true` o `"success": false`, con los datos en `"result"` o el error en `"error"`.
## 6\. Administración del Servidor
Se pueden ejecutar comandos de gestión directamente desde un navegador.
* **Verificar Estado**: `http://tu-dominio.com:8090/test`
* **Recargar Configuración**: `http://tu-dominio.com:8090/manager?command=reload`
(Vuelve a leer todos los archivos `config.*.properties` sin reiniciar el servidor).
* **Reiniciar Servidor (Estándar)**: `http://tu-dominio.com:8090/manager?command=rsx`
(Ejecuta los scripts `start.bat`, `start2.bat` y `stop.bat`).
* **Reiniciar Servidor (con PM2)**: `http://tu-dominio.com:8090/manager?command=rpm2`
(Ejecuta `reiniciaProcesoPM2.bat` y asume que el nombre del proceso es "RDC-Multi". Modificar el `.bat` si el nombre es diferente).

187
SSE.bas Normal file
View File

@@ -0,0 +1,187 @@
B4J=true
Group=Default Group
ModulesStructureVersion=1
Type=StaticCode
Version=10.3
@EndOfDesignText@
' Módulo para gestionar conexiones y transmisiones de Server-Sent Events (SSE).
' Declaración de variables globales a nivel de proceso.
Sub Process_Globals
' 'Connections' es un mapa (diccionario) para almacenar las conexiones SSE activas.
' La clave será una combinación del 'path' y un GUID único, y el valor será el OutputStream de la respuesta.
' Se usará un 'ThreadSafeMap' para evitar problemas de concurrencia entre hilos.
Dim Connections As Map
' Timer #1 ("El Vigilante"): Se encarga de detectar y eliminar conexiones muertas.
Private RemoveTimer As Timer
' Timer #2 ("El Informante"): Se encarga de recolectar y enviar los datos de estadísticas.
Dim StatsTimer As Timer
Dim const UPDATE_INTERVAL_MS As Long = 2000 ' Intervalo de envío de estadísticas: 2 segundos.
End Sub
' Subrutina de inicialización del módulo. Se llama una vez cuando el objeto es creado.
public Sub Initialize()
' Crea el mapa 'Connections' como un mapa seguro para hilos (ThreadSafeMap).
' Esto es fundamental porque múltiples peticiones (hilos) pueden intentar agregar o remover conexiones simultáneamente.
Connections = Main.srvr.CreateThreadSafeMap
' Inicializa el temporizador 'RemoveTimer' para que dispare el evento "RemoveTimer" cada 5000 milisegundos (5 segundos).
RemoveTimer.Initialize("RemoveTimer", 5000)
' Habilita el temporizador para que comience a funcionar.
RemoveTimer.Enabled = True
Log("Stats SSE Handler Initialized (Singleton Mode)")
' Crea el mapa de conexiones, asegurando que sea seguro para el manejo de múltiples hilos.
Connections = Main.srvr.CreateThreadSafeMap
' Configura y activa el timer para la limpieza de conexiones cada 5 segundos.
' NOTA: El EventName "RemoveTimer" debe coincidir con el nombre de la subrutina del tick.
RemoveTimer.Initialize("RemoveTimer", 5000)
RemoveTimer.Enabled = True
' Configura y activa el timer para el envío de estadísticas.
' NOTA: El EventName "StatsTimer" debe coincidir con el nombre de la subrutina del tick.
StatsTimer.Initialize("StatsTimer", UPDATE_INTERVAL_MS)
StatsTimer.Enabled = True
End Sub
' Subrutina para agregar un nuevo cliente (target) al stream de eventos SSE.
' Se llama cuando un cliente se conecta al endpoint SSE.
' Registra formalmente a un nuevo cliente en el sistema.
Sub AddTarget(path As String, resp As ServletResponse)
' Genera una clave única para esta conexión específica.
Dim connectionKey As String = path & "|" & GetGUID
Log("--- [SSE] Cliente conectado: " & connectionKey & " ---")
' Configura las cabeceras HTTP necesarias para que el navegador mantenga la conexión abierta.
resp.ContentType = "text/event-stream"
resp.SetHeader("Cache-Control", "no-cache")
resp.SetHeader("Connection", "keep-alive")
resp.CharacterEncoding = "UTF-8"
resp.Status = 200
' Añade al cliente y su canal de comunicación al mapa central.
Connections.Put(connectionKey, resp.OutputStream)
' Envía un primer mensaje de bienvenida para confirmar la conexión.
SendMessage(resp.OutputStream, "open", "Connection established", 0, connectionKey)
End Sub
' Envía un mensaje a todos los clientes suscritos a un "path" específico.
Sub Broadcast(Path As String, EventName As String, Message As String, Retry As Long)
' Itera sobre la lista de clientes activos.
For Each key As String In Connections.Keys
' Log(key)
' Filtra para enviar solo a los clientes del path correcto (en este caso, "stats").
If key.StartsWith(Path & "|") Then
Try
' Llama a la función de bajo nivel para enviar el mensaje formateado.
SendMessage(Connections.Get(key), EventName, Message, Retry, DateTime.Now)
Catch
' Si el envío falla, asume que el cliente se desconectó y lo elimina.
Log("######################")
Log("## Removing (broadcast failed): " & key)
Log("######################")
Connections.Remove(key)
End Try
End If
Next
End Sub
' Formatea y envía un único mensaje SSE a un cliente específico.
Sub SendMessage(out As OutputStream, eventName As String, message As String, retry As Int, id As String)
' Construye el mensaje siguiendo el formato oficial del protocolo SSE.
Dim sb As StringBuilder
sb.Initialize
sb.Append("id: " & id).Append(CRLF)
sb.Append("event: " & eventName).Append(CRLF)
If message <> "" Then
sb.Append("data: " & message).Append(CRLF)
End If
If retry > 0 Then
sb.Append("retry: " & retry).Append(CRLF)
End If
sb.Append(CRLF) ' El doble salto de línea final es obligatorio.
' Convierte el texto a bytes y lo escribe en el canal de comunicación del cliente.
Dim Bytes() As Byte = sb.ToString.GetBytes("UTF-8")
out.WriteBytes(Bytes, 0, Bytes.Length)
out.Flush ' Fuerza el envío inmediato de los datos.
End Sub
' Genera un Identificador Único Global (GUID) para cada conexión.
Private Sub GetGUID() As String
Dim jo As JavaObject
Return jo.InitializeStatic("java.util.UUID").RunMethod("randomUUID", Null)
End Sub
' Evento que se dispara cada vez que el 'RemoveTimer' completa su intervalo (cada 5 segundos).
' Su propósito es proactivamente limpiar conexiones muertas.
Sub RemoveTimer_Tick
' Log("remove timer")
' Itera sobre todas las conexiones activas.
For Each key As String In Connections.Keys
' Intenta enviar un mensaje de prueba ("ping" o "heartbeat") a cada cliente.
Try
' Obtiene el OutputStream del cliente.
Dim out As OutputStream = Connections.Get(key)
' Envía un evento de tipo "Test" sin datos. Si la conexión está viva, esto no hará nada visible.
SendMessage(out, "Test", "", 0, "")
Catch
' Si el 'SendMessage' falla, significa que el socket está cerrado (el cliente se desconectó).
' Registra en el log que se está eliminando una conexión muerta.
Log("######################")
Log("## Removing (timer): " & key)
Log("######################")
' Elimina la conexión del mapa para liberar recursos.
Connections.Remove(key)
End Try
Next
End Sub
' Evento del Timer #2 ("El Informante"): se dispara cada 2 segundos.
public Sub StatsTimer_Tick
' Optimización: si no hay nadie conectado, no realiza el trabajo pesado.
' Log($"Conexiones: ${Connections.Size}"$)
If Connections.Size = 0 Then Return
Try
' Prepara un mapa para almacenar las estadísticas recolectadas.
Dim allPoolStats As Map
allPoolStats.Initialize
' Bloquea el acceso a los conectores para leer sus datos de forma segura.
Main.MainConnectorsLock.RunMethod("lock", Null)
For Each dbKey As String In Main.listaDeCP
Dim connector As RDCConnector
If Main.Connectors.ContainsKey(dbKey) Then
connector = Main.Connectors.Get(dbKey)
If connector.IsInitialized Then
allPoolStats.Put(dbKey, connector.GetPoolStats)
Else
allPoolStats.Put(dbKey, CreateMap("Error": "Conector no inicializado"))
End If
End If
Next
' Libera el bloqueo para que otras partes del programa puedan usar los conectores.
Main.MainConnectorsLock.RunMethod("unlock", Null)
' Convierte el mapa de estadísticas a un formato de texto JSON.
Dim j As JSONGenerator
j.Initialize(allPoolStats)
Dim jsonStats As String = j.ToString
' Llama al "locutor" para enviar el JSON a todos los clientes conectados.
Broadcast("stats", "stats_update", jsonStats, 0)
Catch
' Captura y registra cualquier error que ocurra durante la recolección de datos.
Log($"[SSE] Error CRÍTICO durante la adquisición de estadísticas: ${LastException.Message}"$)
End Try
End Sub

131
SSEHandler.bas Normal file
View File

@@ -0,0 +1,131 @@
B4J=true
Group=Default Group
ModulesStructureVersion=1
Type=Class
Version=10.3
@EndOfDesignText@
' Handler class: StatsSSEHandler.b4j
' Gestiona y transmite en tiempo real las estadísticas del pool de conexiones vía Server-Sent Events (SSE).
' Opera en modo Singleton: una única instancia maneja todas las conexiones.
Sub Class_Globals
' Almacena de forma centralizada a todos los clientes (navegadores) conectados.
' La clave es un ID único y el valor es el canal de comunicación (OutputStream).
Private Connections As Map
' Timer #1 ("El Vigilante"): Se encarga de detectar y eliminar conexiones muertas.
Private RemoveTimer As Timer
' Timer #2 ("El Informante"): Se encarga de recolectar y enviar los datos de estadísticas.
Dim StatsTimer As Timer
Dim const UPDATE_INTERVAL_MS As Long = 2000 ' Intervalo de envío de estadísticas: 2 segundos.
End Sub
' Se ejecuta UNA SOLA VEZ cuando el servidor arranca, gracias al modo Singleton.
Public Sub Initialize
Log("Stats SSE Handler Initialized (Singleton Mode)")
' Crea el mapa de conexiones, asegurando que sea seguro para el manejo de múltiples hilos.
Connections = Main.srvr.CreateThreadSafeMap
' Configura y activa el timer para la limpieza de conexiones cada 5 segundos.
' NOTA: El EventName "RemoveTimer" debe coincidir con el nombre de la subrutina del tick.
RemoveTimer.Initialize("RemoveTimer", 5000)
RemoveTimer.Enabled = True
' Configura y activa el timer para el envío de estadísticas.
' NOTA: El EventName "StatsTimer" debe coincidir con el nombre de la subrutina del tick.
StatsTimer.Initialize("StatsTimer", UPDATE_INTERVAL_MS)
StatsTimer.Enabled = True
End Sub
' Es el punto de entrada principal. Atiende todas las peticiones HTTP dirigidas a este handler.
Sub Handle(req As ServletRequest, resp As ServletResponse)
Log($"StatsTimerinicializado: ${StatsTimer.IsInitialized}, StatsTimer habilitado: ${StatsTimer.Enabled}"$)
StatsTimer.Initialize("StatsTimer", 2000)
StatsTimer.Enabled = True
' Filtro de seguridad: verifica si el usuario tiene una sesión autorizada.
If req.GetSession.GetAttribute2("user_is_authorized", False) = False Then
resp.SendRedirect("/login")
Return
End If
' Procesa únicamente las peticiones GET, que son las que usan los navegadores para iniciar una conexión SSE.
If req.Method = "GET" Then
' Mantiene la petición activa de forma asíncrona para poder enviar datos en el futuro.
Dim reqJO As JavaObject = req
reqJO.RunMethod("startAsync", Null)
' Registra al nuevo cliente para que empiece a recibir eventos.
SSE.AddTarget("stats", resp)
Else
' Rechaza cualquier otro método HTTP (POST, PUT, etc.) con un error.
resp.SendError(405, "Method Not Allowed")
End If
End Sub
' --- LÓGICA DE LOS TIMERS ---
' Evento del Timer #1 ("El Vigilante"): se dispara cada 5 segundos.
Sub RemoveTimer_Tick
' Log("REMOVETIMER TICK")
' Optimización: si no hay nadie conectado, no hace nada.
If Connections.Size = 0 Then Return
' Itera sobre todos los clientes para verificar si siguen activos.
For Each key As String In Connections.Keys
Try
' Envía un evento "ping" silencioso. Si la conexión está viva, no pasa nada.
SSE.SendMessage(Connections.Get(key), "ping", "", 0, "")
Catch
' Si el envío falla, la conexión está muerta. Se procede a la limpieza.
Log("######################")
Log("## Removing (timer cleanup): " & key)
Log("######################")
Connections.Remove(key)
End Try
Next
End Sub
' Evento del Timer #2 ("El Informante"): se dispara cada 2 segundos.
public Sub StatsTimer_Tick
' Optimización: si no hay nadie conectado, no realiza el trabajo pesado.
If Connections.Size = 0 Then Return
Try
' Prepara un mapa para almacenar las estadísticas recolectadas.
Dim allPoolStats As Map
allPoolStats.Initialize
' Bloquea el acceso a los conectores para leer sus datos de forma segura.
Main.MainConnectorsLock.RunMethod("lock", Null)
For Each dbKey As String In Main.listaDeCP
Dim connector As RDCConnector
If Main.Connectors.ContainsKey(dbKey) Then
connector = Main.Connectors.Get(dbKey)
If connector.IsInitialized Then
allPoolStats.Put(dbKey, connector.GetPoolStats)
Else
allPoolStats.Put(dbKey, CreateMap("Error": "Conector no inicializado"))
End If
End If
Next
' Libera el bloqueo para que otras partes del programa puedan usar los conectores.
Main.MainConnectorsLock.RunMethod("unlock", Null)
' Convierte el mapa de estadísticas a un formato de texto JSON.
Dim j As JSONGenerator
j.Initialize(allPoolStats)
Dim jsonStats As String = j.ToString
' Llama al "locutor" para enviar el JSON a todos los clientes conectados.
SSE.Broadcast("stats", "stats_update", jsonStats, 0)
Catch
' Captura y registra cualquier error que ocurra durante la recolección de datos.
Log($"[SSE] Error CRÍTICO durante la adquisición de estadísticas: ${LastException.Message}"$)
End Try
End Sub

View File

@@ -22,7 +22,7 @@ Sub Handle(req As ServletRequest, resp As ServletResponse)
' Dim con As SQL = Main.rdcConnectorDB1.GetConnection("") ' Dim con As SQL = Main.rdcConnectorDB1.GetConnection("")
Dim con As SQL = Main.Connectors.Get("DB1").As(RDCConnector).GetConnection("") Dim con As SQL = Main.Connectors.Get("DB1").As(RDCConnector).GetConnection("")
resp.Write("Connection successful.</br></br>") resp.Write("Connection successful.</br></br>")
Private estaDB As String = "" Dim estaDB As String = ""
Log(Main.listaDeCP) Log(Main.listaDeCP)
For i = 0 To Main.listaDeCP.Size - 1 For i = 0 To Main.listaDeCP.Size - 1
If Main.listaDeCP.get(i) <> "" Then estaDB = "." & Main.listaDeCP.get(i) If Main.listaDeCP.get(i) <> "" Then estaDB = "." & Main.listaDeCP.get(i)

39
faviconHandler.bas Normal file
View File

@@ -0,0 +1,39 @@
B4J=true
Group=Default Group
ModulesStructureVersion=1
Type=Class
Version=10.3
@EndOfDesignText@
'Class module: FaviconHandler
' Manejador para la petición de /favicon.ico
' Simplemente devuelve un estado HTTP 204 (No Content)
' para indicar al navegador que no hay un favicon.
Sub Class_Globals
' No se necesitan variables globales para este manejador simple.
End Sub
Public Sub Initialize
' No se necesita inicialización específica para este manejador.
End Sub
Public Sub Handle(req As ServletRequest, resp As ServletResponse)
' Registra la petición en el Log (opcional, para depuración)
' Log("Petición de Favicon recibida: " & req.RequestURI)
'
' Establece el código de estado HTTP a 204 (No Content).
' Esto le dice al navegador que la petición fue exitosa, pero no hay contenido que devolver.
resp.Status = 204
' Es buena práctica cerrar el OutputStream, aunque para 204 no haya contenido explícito.
' Algunos servidores web podrían requerir cerrar el stream de respuesta.
Try
resp.OutputStream.Close
Catch
Log("Error al cerrar el OutputStream en FaviconHandler: " & LastException)
End Try
' El Return es fundamental para que el manejador termine su ejecución
' y no intente procesar la petición con otros manejadores o caiga en el "catch-all".
Return
End Sub

View File

@@ -1,17 +1,15 @@
AppType=StandardJava AppType=StandardJava
Build1=Default,b4j.JRDCMulti Build1=Default,b4j.JRDCMulti
File1=config.DB2.properties File1=config.DB2.properties
File10=stop.bat
File2=config.DB3.properties File2=config.DB3.properties
File3=config.DB4.properties File3=config.DB4.properties
File4=config.properties File4=config.properties
File5=login.html File5=reiniciaProcesoBow.bat
File6=reiniciaProcesoBow.bat File6=reiniciaProcesoPM2.bat
File7=reiniciaProcesoPM2.bat File7=start.bat
File8=start.bat File8=start2.bat
File9=start2.bat File9=stop.bat
FileGroup1=Default Group FileGroup1=Default Group
FileGroup10=Default Group
FileGroup2=Default Group FileGroup2=Default Group
FileGroup3=Default Group FileGroup3=Default Group
FileGroup4=Default Group FileGroup4=Default Group
@@ -21,50 +19,54 @@ FileGroup7=Default Group
FileGroup8=Default Group FileGroup8=Default Group
FileGroup9=Default Group FileGroup9=Default Group
Group=Default Group Group=Default Group
Library1=byteconverter Library1=bcrypt
Library2=javaobject Library2=byteconverter
Library3=jcore Library3=javaobject
Library4=jrandomaccessfile Library4=jcore
Library5=jserver Library5=jrandomaccessfile
Library6=jshell Library6=jserver
Library7=json Library7=jshell
Library8=jsql Library8=json
Library9=bcrypt Library9=jsql
Module1=B4AHandler Module1=Cambios
Module10=LoginHandler Module10=Manager
Module11=LogoutHandler Module11=Manager0
Module12=Manager Module12=ParameterValidationUtils
Module13=ping Module13=ping
Module14=RDCConnector Module14=RDCConnector
Module15=TestHandler Module15=SSE
Module16=SSEHandler
Module17=TestHandler
Module2=ChangePassHandler Module2=ChangePassHandler
Module3=DB2Handler Module3=DBHandlerB4X
Module4=DB3Handler Module4=DBHandlerJSON
Module5=DB4Handler Module5=DoLoginHandler
Module6=DBHandlerJSON Module6=faviconHandler
Module7=DoLoginHandler Module7=GlobalParameters
Module8=GlobalParameters Module8=LoginHandler
Module9=HandlerB4X Module9=LogoutHandler
NumberOfFiles=10 NumberOfFiles=9
NumberOfLibraries=9 NumberOfLibraries=9
NumberOfModules=15 NumberOfModules=17
Version=10.3 Version=10.3
@EndOfDesignText@ @EndOfDesignText@
'Non-UI application (console / server application) 'Non-UI application (console / server application)
#Region Project Attributes
#CommandLineArgs: #Region Project Attributes
#MergeLibraries: True
' VERSION 5.08.30 #CommandLineArgs:
'########################################################################################################### #MergeLibraries: True
'###################### PULL ############################################################# ' VERSION 5.09.19
'Ctrl + click ide://run?file=%WINDIR%\System32\cmd.exe&Args=/c&Args=git&Args=pull '###########################################################################################################
'########################################################################################################### '###################### PULL #############################################################
'###################### PUSH ############################################################# 'Ctrl + click ide://run?file=%WINDIR%\System32\cmd.exe&Args=/c&Args=git&Args=pull
'Ctrl + click ide://run?file=%WINDIR%\System32\WindowsPowerShell\v1.0\powershell.exe&Args=github&Args=..\..\ '###########################################################################################################
'########################################################################################################### '###################### PUSH #############################################################
'###################### PUSH TORTOISE GIT ######################################################### 'Ctrl + click ide://run?file=%WINDIR%\System32\WindowsPowerShell\v1.0\powershell.exe&Args=github&Args=..\..\
'Ctrl + click ide://run?file=%WINDIR%\System32\WindowsPowerShell\v1.0\powershell.exe&Args=TortoiseGitProc&Args=/command:commit&Args=/path:"../"&Args=/closeonend:2 '###########################################################################################################
'########################################################################################################### '###################### PUSH TORTOISE GIT #########################################################
'Ctrl + click ide://run?file=%WINDIR%\System32\WindowsPowerShell\v1.0\powershell.exe&Args=TortoiseGitProc&Args=/command:commit&Args=/path:"../"&Args=/closeonend:2
'###########################################################################################################
#End Region #End Region
'change based on the jdbc jar file 'change based on the jdbc jar file
@@ -75,103 +77,703 @@ Version=10.3
#AdditionalJar: sqlite-jdbc-3.7.2 #AdditionalJar: sqlite-jdbc-3.7.2
Sub Process_Globals Sub Process_Globals
' --- Variables globales accesibles desde cualquier parte del proyecto ---
' Objeto principal del servidor HTTP de B4J.
Public srvr As Server Public srvr As Server
' La versión actual de este servidor jRDC modificado.
Public const VERSION As Float = 2.23 Public const VERSION As Float = 2.23
' Tipos personalizados (clases) para la serialización y deserialización de datos
Type DBCommand (Name As String, Parameters() As Object) Type DBCommand (Name As String, Parameters() As Object)
Type DBResult (Tag As Object, Columns As Map, Rows As List) Type DBResult (Tag As Object, Columns As Map, Rows As List)
Dim listaDeCP As List
Dim cpFiles As List ' Contiene una lista de los identificadores de bases de datos configuradas (ej. "DB1", "DB2").
Public listaDeCP As List
' Una lista temporal para almacenar los nombres de archivos de configuración encontrados.
Private cpFiles As List
' Mapas globales para gestionar los conectores de base de datos y los comandos SQL.
Public Connectors, commandsMap As Map Public Connectors, commandsMap As Map
Public SQL1 As SQL ' Objeto SQL para la base de datos de usuarios
' Objeto SQL para interactuar con la base de datos de usuarios y logs (SQLite).
Public SQL1 As SQL
' Objeto para realizar operaciones de hashing de contraseñas de forma segura.
Private bc As BCrypt Private bc As BCrypt
' Objeto de bloqueo (ReentrantLock) para proteger Main.Connectors durante Hot-Swap.
Public MainConnectorsLock As JavaObject
' Timer para ejecutar tareas periódicas, como la limpieza de logs.
Public timerLogs As Timer
' NUEVAS VARIABLES para control granular de logs
' Mapa para almacenar el estado de logging (True/False) por cada DBKey (DB1, DB2, etc.).
Public SQLiteLoggingStatusByDB As Map
' Bandera global que indica si AL MENOS una base de datos tiene los logs habilitados.
Public IsAnySQLiteLoggingEnabled As Boolean
' Tipo para encapsular el resultado de la validación de parámetros.
Type ParameterValidationResult ( _
Success As Boolean, _
ErrorMessage As String, _
ParamsToExecute As List _ ' La lista de parámetros final a usar en la ejecución SQL
)
Public QueryLogCache As List ' Cache para los logs de rendimiento (query_logs)
Public ErrorLogCache As List ' Cache para los logs de errores y advertencias
Public LOG_CACHE_THRESHOLD As Int = 350 ' Umbral de registros para forzar la escritura
Dim logger As Boolean
Public LatestPoolStats As Map ' Mapa Thread-Safe para almacenar las últimas métricas de cada pool.
End Sub End Sub
Sub AppStart (Args() As String) Sub AppStart (Args() As String)
' --- INICIO DE CAMBIOS ---
' Inicializamos la base de datos. Se creará si no existe. SSE.Initialize
#if DEBUG
logger = True
LOG_CACHE_THRESHOLD = 10
#else
logger = False
#End If
' --- Subrutina principal que se ejecuta al iniciar la aplicación ---
' La subcarpeta es "www"
CopiarRecursoSiNoExiste("manager.html", "www")
CopiarRecursoSiNoExiste("login.html", "www")
' --- Copiar los archivos .bat de la raíz ---
' La subcarpeta es "" (vacía) porque están en la raíz de "Files"
CopiarRecursoSiNoExiste("config.properties", "")
CopiarRecursoSiNoExiste("config.DB2.properties", "")
CopiarRecursoSiNoExiste("config.DB3.properties", "")
CopiarRecursoSiNoExiste("start.bat", "")
CopiarRecursoSiNoExiste("start2.bat", "")
CopiarRecursoSiNoExiste("stop.bat", "")
CopiarRecursoSiNoExiste("reiniciaProcesoBow.bat", "")
CopiarRecursoSiNoExiste("reiniciaProcesoPM2.bat", "")
'
' Log("Verificación de archivos completada.")
bc.Initialize("BC")
QueryLogCache.Initialize
ErrorLogCache.Initialize
' 1. Inicializa la base de datos local de usuarios (SQLite) y la tabla de logs.
InitializeSQLiteDatabase InitializeSQLiteDatabase
' --- FIN DE CAMBIOS ---
' 2. Inicializa los mapas globales definidos en GlobalParameters.bas.
GlobalParameters.mpLogs.Initialize
GlobalParameters.mpTotalRequests.Initialize
GlobalParameters.mpTotalConnections.Initialize
GlobalParameters.mpBlockConnection.Initialize
' Aseguramos que el mapa de conteo de peticiones activas sea thread-safe.
GlobalParameters.ActiveRequestsCountByDB = srvr.CreateThreadSafeMap
' 3. Inicializa las estructuras principales del servidor HTTP.
listaDeCP.Initialize listaDeCP.Initialize
srvr.Initialize("") srvr.Initialize("")
Dim con As RDCConnector
Connectors = srvr.CreateThreadSafeMap Connectors = srvr.CreateThreadSafeMap
commandsMap.Initialize commandsMap.Initialize
con.Initialize("DB1") 'Inicializamos el default de config.properties LatestPoolStats = srvr.CreateThreadSafeMap ' Inicializar el mapa de estadísticas como Thread-Safe
Connectors.Put("DB1", con)
srvr.Port = con.serverPort ' NUEVO: Inicializar el mapa de estado de logs granular
listaDeCP.Add("DB1") SQLiteLoggingStatusByDB.Initialize
' Creamos una instancia de ReentrantLock para proteger Main.Connectors.
MainConnectorsLock.InitializeNewInstance("java.util.concurrent.locks.ReentrantLock", Null)
' === 4. INICIALIZACIÓN DEL CONECTOR PARA LA BASE DE DATOS PRINCIPAL (DB1) ===
Try
Dim con1 As RDCConnector
con1.Initialize("DB1")
Connectors.Put("DB1", con1)
srvr.Port = con1.serverPort
listaDeCP.Add("DB1")
Log($"Main.AppStart: Conector 'DB1' inicializado exitosamente en puerto: ${srvr.Port}"$)
' Lógica de Logs para DB1 (Fuente principal de configuración)
Dim enableLogsSetting As Int = con1.config.GetDefault("enableSQLiteLogs", 0).As(Int)
Dim isEnabled As Boolean = (enableLogsSetting = 1)
SQLiteLoggingStatusByDB.Put("DB1", isEnabled) ' Guardar el estado
Catch
Dim ErrorMsg As String = $"Main.AppStart: ERROR CRÍTICO al inicializar conector 'DB1': ${LastException.Message}"$
Log(ErrorMsg)
LogServerError("ERROR", "Main.AppStart", ErrorMsg, "DB1", Null, Null)
ExitApplication
End Try
' === 5. DETECCIÓN E INICIALIZACIÓN DE BASES DE DATOS ADICIONALES (DB2, DB3, DB4) ===
cpFiles = File.ListFiles("./") cpFiles = File.ListFiles("./")
If cpFiles.Size > 0 Then If cpFiles.Size > 0 Then
Log(cpFiles)
For i = 0 To cpFiles.Size - 1 For i = 0 To cpFiles.Size - 1
If cpFiles.Get(i) = "config.DB2.properties" Then ' Si existe el archivo DB2, lo usamos.
Dim con As RDCConnector ' Procesa 'config.DB2.properties'
con.Initialize("DB2") If cpFiles.Get(i) = "config.DB2.properties" Then
Connectors.Put("DB2", con) Try
listaDeCP.Add("DB2") Dim con2 As RDCConnector
con2.Initialize("DB2")
Connectors.Put("DB2", con2)
listaDeCP.Add("DB2")
Log("Main.AppStart: Conector 'DB2' inicializado exitosamente.")
' Lógica de Logs para DB2
Dim enableLogsSetting As Int = con2.config.GetDefault("enableSQLiteLogs", 0).As(Int)
Dim isEnabled As Boolean = (enableLogsSetting = 1)
SQLiteLoggingStatusByDB.Put("DB2", isEnabled) ' Guardar el estado
Catch
Dim ErrorMsg As String = $"Main.AppStart: ERROR al inicializar conector 'DB2': ${LastException.Message}"$
Log(ErrorMsg)
LogServerError("ERROR", "Main.AppStart", ErrorMsg, "DB2", Null, Null)
End Try
End If End If
If cpFiles.Get(i) = "config.DB3.properties" Then ' Si existe el archivo DB3, lo usamos.
Dim con As RDCConnector ' Procesa 'config.DB3.properties'
con.Initialize("DB3") If cpFiles.Get(i) = "config.DB3.properties" Then
Connectors.Put("DB3", con) Try
listaDeCP.Add("DB3") Dim con3 As RDCConnector
con3.Initialize("DB3")
Connectors.Put("DB3", con3)
listaDeCP.Add("DB3")
Log("Main.AppStart: Conector 'DB3' inicializado exitosamente.")
' Lógica de Logs para DB3
Dim enableLogsSetting As Int = con3.config.GetDefault("enableSQLiteLogs", 0).As(Int)
Dim isEnabled As Boolean = (enableLogsSetting = 1)
SQLiteLoggingStatusByDB.Put("DB3", isEnabled) ' Guardar el estado
Catch
Dim ErrorMsg As String = $"Main.AppStart: ERROR al inicializar conector 'DB3': ${LastException.Message}"$
Log(ErrorMsg)
LogServerError("ERROR", "Main.AppStart", ErrorMsg, "DB3", Null, Null)
End Try
End If End If
If cpFiles.Get(i) = "config.DB4.properties" Then ' Si existe el archivo DB4, lo usamos.
con.Initialize("DB4") ' Procesa 'config.DB4.properties'
Connectors.Put("DB4", con) If cpFiles.Get(i) = "config.DB4.properties" Then
listaDeCP.Add("DB4") Try
Dim con4 As RDCConnector
con4.Initialize("DB4")
Connectors.Put("DB4", con4)
listaDeCP.Add("DB4")
Log("Main.AppStart: Conector 'DB4' inicializado exitosamente.")
' Lógica de Logs para DB4
Dim enableLogsSetting As Int = con4.config.GetDefault("enableSQLiteLogs", 0).As(Int)
Dim isEnabled As Boolean = (enableLogsSetting = 1)
SQLiteLoggingStatusByDB.Put("DB4", isEnabled) ' Guardar el estado
Catch
Dim ErrorMsg As String = $"Main.AppStart: ERROR al inicializar conector 'DB4': ${LastException.Message}"$
Log(ErrorMsg)
LogServerError("ERROR", "Main.AppStart", ErrorMsg, "DB4", Null, Null)
End Try
End If End If
Next Next
Else
Log("Main.AppStart: No se encontraron archivos de configuración adicionales (config.DBx.properties).")
End If End If
srvr.AddHandler("/ping", "ping", False) ' Agrega un manejador a la ruta "/test", asignando las solicitudes a la clase TestHandler, el último parámetro indica si el manejador debe ejecutar en un nuevo hilo (False en este caso)
srvr.AddHandler("/test", "TestHandler", False) ' Agrega un manejador a la ruta "/test", asignando las solicitudes a la clase TestHandler, el último parámetro indica si el manejador debe ejecutar en un nuevo hilo (False en este caso) ' Log final de las bases de datos que el servidor está gestionando.
Dim sbListaDeCP_Log As StringBuilder
' --- INICIO DE CAMBIOS --- sbListaDeCP_Log.Initialize
' 1. Rutas para el sistema de Login For Each item As String In listaDeCP
srvr.AddHandler("/login", "LoginHandler", False) ' Sirve la página de login sbListaDeCP_Log.Append(item).Append(", ")
srvr.AddHandler("/dologin", "DoLoginHandler", False) ' Procesa el intento de login Next
srvr.AddHandler("/logout", "LogoutHandler", False) ' Cierra la sesión If sbListaDeCP_Log.Length > 0 Then
sbListaDeCP_Log.Remove(sbListaDeCP_Log.Length - 2, sbListaDeCP_Log.Length)
End If
Log($"Main.AppStart: Bases de datos configuradas y listas: [${sbListaDeCP_Log.ToString}]"$)
' <<<< Bloque de inicialización del Timer para la limpieza de logs >>>>
' Inicialización INCONDICIONAL del Timer (Garantiza que el objeto exista y prevenga el IllegalStateException)
timerLogs.Initialize("TimerLogs", 600000) ' 10 minutos = 600 * 1000 = 600000 ms
' CONTROL CONDICIONAL BASADO EN EL ESTADO GRANULAR
IsAnySQLiteLoggingEnabled = False
For Each dbStatus As Boolean In SQLiteLoggingStatusByDB.Values
If dbStatus Then
IsAnySQLiteLoggingEnabled = True
Exit ' Si uno está activo, es suficiente para encender el Timer
End If
Next
If IsAnySQLiteLoggingEnabled Then
timerLogs.Enabled = True
If logger Then Log("Main.AppStart: Timer de limpieza de logs ACTIVADO (al menos una DB requiere logs).")
Else
timerLogs.Enabled = False
If logger Then Log("Main.AppStart: Timer de limpieza de logs DESHABILITADO (ninguna DB requiere logs).")
End If
' <<<< Fin del bloque del Timer >>>>
' === 6. REGISTRO DE HANDLERS HTTP PARA EL SERVIDOR ===
srvr.AddHandler("/ping", "ping", False)
srvr.AddHandler("/test", "TestHandler", False)
srvr.AddHandler("/login", "LoginHandler", False)
srvr.AddHandler("/dologin", "DoLoginHandler", False)
srvr.AddHandler("/logout", "LogoutHandler", False)
srvr.AddHandler("/changepass", "ChangePassHandler", False) srvr.AddHandler("/changepass", "ChangePassHandler", False)
' 2. El handler del manager se queda igual, pero ahora estará protegido
srvr.AddHandler("/manager", "Manager", False) srvr.AddHandler("/manager", "Manager", False)
' --- FIN DE CAMBIOS ---
srvr.AddHandler("/DBJ", "DBHandlerJSON", False) srvr.AddHandler("/DBJ", "DBHandlerJSON", False)
srvr.AddHandler("/dbrquery", "DBHandlerJSON", False) srvr.AddHandler("/dbrquery", "DBHandlerJSON", False)
' srvr.AddHandler("/*", "DB1Handler", False) ' Si no se especifica una base de datos, entonces asignamos la solicitud a la DB1. srvr.AddHandler("/favicon.ico", "faviconHandler", False)
srvr.AddHandler("/stats-stream", "SSEHandler", False)
srvr.AddHandler("/*", "HandlerB4X", False) srvr.AddHandler("/*", "DBHandlerB4X", False)
' 7. Inicia el servidor HTTP.
srvr.Start srvr.Start
Log("===========================================================") Log("===========================================================")
Log($"-=== jRDC is running on port: ${srvr.port} (version = $1.2{VERSION}) ===-"$) Log($"-=== jRDC está funcionando en el puerto: ${srvr.Port} (versión = $1.2{VERSION}) ===-"$)
Log("===========================================================") Log("===========================================================")
' 8. Inicia el bucle de mensajes de B4J.
StartMessageLoop StartMessageLoop
End Sub End Sub
' Nueva subrutina para crear y configurar la base de datos de usuarios ' --- Subrutina para inicializar la base de datos de usuarios local (SQLite) ---
Sub InitializeSQLiteDatabase Sub InitializeSQLiteDatabase
Dim dbFileName As String = "users.db" Dim dbFileName As String = "users.db"
' Si la base de datos no existe en la carpeta del .jar, la creamos
If File.Exists(File.DirApp, dbFileName) = False Then If File.Exists(File.DirApp, dbFileName) = False Then
Log("Creando nueva base de datos de usuarios: " & dbFileName) Log("Creando nueva base de datos de usuarios: " & dbFileName)
' Inicializamos la conexión
SQL1.InitializeSQLite(File.DirApp, dbFileName, True) SQL1.InitializeSQLite(File.DirApp, dbFileName, True)
' Creamos la tabla de usuarios ' Crear tabla 'users'
Dim createUserTable As String = "CREATE TABLE users (username TEXT PRIMARY KEY, password_hash TEXT NOT NULL)" Dim createUserTable As String = "CREATE TABLE users (username TEXT PRIMARY KEY, password_hash TEXT NOT NULL)"
SQL1.ExecNonQuery(createUserTable) SQL1.ExecNonQuery(createUserTable)
' Creamos un usuario por defecto para el primer inicio ' Crear tabla 'query_logs'
If logger Then Log("Creando tabla 'query_logs' con columnas de rendimiento.")
Dim createQueryLogsTable As String = "CREATE TABLE query_logs (id INTEGER PRIMARY KEY AUTOINCREMENT, query_name TEXT, duration_ms INTEGER, timestamp INTEGER, db_key TEXT, client_ip TEXT, busy_connections INTEGER, handler_active_requests INTEGER)"
SQL1.ExecNonQuery(createQueryLogsTable)
SQL1.ExecNonQuery("PRAGMA journal_mode=WAL;")
SQL1.ExecNonQuery("PRAGMA synchronous=NORMAL;")
' Insertar usuario por defecto
Dim defaultUser As String = "admin" Dim defaultUser As String = "admin"
Dim defaultPass As String = "12345" Dim defaultPass As String = "12345"
Dim hashedPass As String = bc.hashpw(defaultPass, bc.gensalt) ' bc.HashPassword(defaultPass) Dim hashedPass As String = bc.hashpw(defaultPass, bc.gensalt)
SQL1.ExecNonQuery2("INSERT INTO users (username, password_hash) VALUES (?, ?)", Array As Object(defaultUser, hashedPass)) SQL1.ExecNonQuery2("INSERT INTO users (username, password_hash) VALUES (?, ?)", Array As Object(defaultUser, hashedPass))
Log($"Usuario por defecto creado -> user: ${defaultUser}, pass: ${defaultPass}"$) Log($"Usuario por defecto creado -> user: ${defaultUser}, pass: ${defaultPass}"$)
' Crear tabla 'errores'
Log("Creando tabla 'errores' para registrar eventos.")
Dim createErrorsTable As String = "CREATE TABLE errores (id INTEGER PRIMARY KEY AUTOINCREMENT, timestamp INTEGER, type TEXT, source TEXT, message TEXT, db_key TEXT, command_name TEXT, client_ip TEXT)"
SQL1.ExecNonQuery(createErrorsTable)
If logger Then Log("Creando índices de rendimiento en tablas de logs.")
' Índice en timestamp para limpieza rápida (DELETE/ORDER BY) en query_logs
SQL1.ExecNonQuery("CREATE INDEX idx_query_timestamp ON query_logs(timestamp)")
' Índice en duration_ms para la consulta 'slowqueries' (ORDER BY)
SQL1.ExecNonQuery("CREATE INDEX idx_query_duration ON query_logs(duration_ms)")
' Índice en timestamp para limpieza rápida de la tabla de errores
SQL1.ExecNonQuery("CREATE INDEX idx_error_timestamp ON errores(timestamp)")
Else Else
' Si ya existe, solo la abrimos
SQL1.InitializeSQLite(File.DirApp, dbFileName, True) SQL1.InitializeSQLite(File.DirApp, dbFileName, True)
Log("Base de datos de usuarios cargada.") Log("Base de datos de usuarios cargada.")
SQL1.ExecNonQuery("PRAGMA journal_mode=WAL;")
SQL1.ExecNonQuery("PRAGMA synchronous=NORMAL;")
' >>> INICIO: Lógica de migración (ALTER TABLE) si la DB ya existía <<<
If logger Then Log("Verificando y migrando tabla 'query_logs' si es necesario.")
If SQL1.ExecQuerySingleResult("SELECT name FROM sqlite_master WHERE type='table' AND name='query_logs'") = Null Then
If logger Then Log("Tabla 'query_logs' no encontrada, creándola con columnas de rendimiento.")
Dim createQueryLogsTable As String = "CREATE TABLE query_logs (id INTEGER PRIMARY KEY AUTOINCREMENT, query_name TEXT, duration_ms INTEGER, timestamp INTEGER, db_key TEXT, client_ip TEXT, busy_connections INTEGER, handler_active_requests INTEGER)"
SQL1.ExecNonQuery(createQueryLogsTable)
Else
' Si la tabla query_logs ya existe, entonces verificamos y añadimos las columnas faltantes (busy_connections, handler_active_requests).
Dim columnExists As Boolean
Dim rs As ResultSet
' --- VERIFICAR Y AÑADIR busy_connections ---
columnExists = False
rs = SQL1.ExecQuery("PRAGMA table_info(query_logs)")
Do While rs.NextRow
If rs.GetString("name").EqualsIgnoreCase("busy_connections") Then
columnExists = True
Exit ' La columna ya existe, salimos del bucle.
End If
Loop
rs.Close
If columnExists = False Then
If logger Then Log("Añadiendo columna 'busy_connections' a query_logs.")
SQL1.ExecNonQuery("ALTER TABLE query_logs ADD COLUMN busy_connections INTEGER DEFAULT 0")
End If
' --- VERIFICAR Y AÑADIR handler_active_requests ---
columnExists = False
rs = SQL1.ExecQuery("PRAGMA table_info(query_logs)")
Do While rs.NextRow
If rs.GetString("name").EqualsIgnoreCase("handler_active_requests") Then
columnExists = True
Exit ' La columna ya existe, salimos del bucle.
End If
Loop
rs.Close
If columnExists = False Then
If logger Then Log("Añadiendo columna 'handler_active_requests' a query_logs.")
SQL1.ExecNonQuery("ALTER TABLE query_logs ADD COLUMN handler_active_requests INTEGER DEFAULT 0")
End If
columnExists = False
rs = SQL1.ExecQuery("PRAGMA table_info(query_logs)")
Do While rs.NextRow
If rs.GetString("name").EqualsIgnoreCase("timestamp_text_local") Then
columnExists = True
Exit ' La columna ya existe, salimos del bucle.
End If
Loop
rs.Close
If columnExists = False Then
If logger Then Log("Añadiendo columna 'timestamp_text_local' a query_logs.")
' Usamos 'TEXT' para almacenar la cadena de fecha/hora formateada.
SQL1.ExecNonQuery("ALTER TABLE query_logs ADD COLUMN timestamp_text_local TEXT")
End If
' >>> INICIO: Lógica de migración para 'errores' si la DB ya existía <<<
If logger Then Log("Verificando y migrando tabla 'errores' si es necesario.")
If SQL1.ExecQuerySingleResult("SELECT name FROM sqlite_master WHERE type='table' AND name='errores'") = Null Then
If logger Then Log("Tabla 'errores' no encontrada, creándola.")
Dim createErrorsTable As String = "CREATE TABLE errores (id INTEGER PRIMARY KEY AUTOINCREMENT, timestamp INTEGER, type TEXT, source TEXT, message TEXT, db_key TEXT, command_name TEXT, client_ip TEXT)"
SQL1.ExecNonQuery(createErrorsTable)
Else
If logger Then Log("Tabla 'errores' ya existe.")
End If
' >>> FIN: Lógica de migración para 'errores' <<<
End If
' >>> FIN: Lógica de migración (ALTER TABLE) <<<
End If End If
End Sub End Sub
' --- FIN DE CAMBIOS ---
Public Sub LogQueryPerformance(QueryName As String, DurationMs As Long, DbKey As String, ClientIp As String, HandlerActiveRequests As Int, PoolBusyConnections As Int)
Dim isEnabled As Boolean = SQLiteLoggingStatusByDB.GetDefault(DbKey, False)
If isEnabled Then
' Formato de tiempo necesario para la columna timestamp_text_local
DateTime.DateFormat = "yyyy-MM-dd HH:mm:ss.SSS"
Dim formattedTimestamp As String = DateTime.Date(DateTime.Now)
' 1. Crear el mapa de datos (log entry)
Dim logEntry As Map = CreateMap("query_name": QueryName, "duration_ms": DurationMs, "timestamp": DateTime.Now, _
"db_key": DbKey, "client_ip": ClientIp, "busy_connections": PoolBusyConnections, _
"handler_active_requests": HandlerActiveRequests, "timestamp_text_local": formattedTimestamp)
' 2. Zona Crítica: Añadir a la caché y verificar el umbral
Dim shouldWriteBatch As Boolean = False
' Usamos el lock global para garantizar que la adición y la verificación del tamaño sean atómicas.
MainConnectorsLock.RunMethod("lock", Null)
QueryLogCache.Add(logEntry)
If QueryLogCache.Size >= LOG_CACHE_THRESHOLD Then
shouldWriteBatch = True
End If
MainConnectorsLock.RunMethod("unlock", Null)
' 3. Si se alcanzó el umbral, disparamos la escritura.
' NO DEBE HACERSE CON EL LOCK PUESTO.
If shouldWriteBatch Then
CallSub(Me, "WriteQueryLogsBatch")
End If
End If
End Sub
' --- Subrutina para registrar errores y advertencias en la tabla 'errores'. ---
Public Sub LogServerError(Type0 As String, Source As String, Message As String, DBKey As String, CommandName As String, ClientIp As String)
Dim isEnabled As Boolean = SQLiteLoggingStatusByDB.GetDefault(DBKey, False)
If isEnabled Then
' Log($"[DEBUG CACHE] Se recibió log de error/advertencia para: ${CommandName}"$) '<--- Nuevo Log 1
Dim logEntry As Map = CreateMap("timestamp": DateTime.Now, "type": Type0, "source": Source, "message": Message, _
"db_key": DBKey, "command_name": CommandName, "client_ip": ClientIp)
Dim shouldWriteBatch As Boolean = False
' 1. Zona Crítica: Añadir a la caché y verificar el umbral
' Usamos el lock para Thread Safety
MainConnectorsLock.RunMethod("lock", Null)
' Log($"[DEBUG CACHE] Lock adquirido. Tamaño actual de ErrorLogCache: ${ErrorLogCache.Size}"$) '<--- Nuevo Log 2
ErrorLogCache.Add(logEntry)
' Log($"[DEBUG CACHE] Log añadido. Nuevo tamaño: ${ErrorLogCache.Size}. Umbral: ${LOG_CACHE_THRESHOLD}"$) '<--- Nuevo Log 3
If ErrorLogCache.Size >= LOG_CACHE_THRESHOLD Then
shouldWriteBatch = True
' Log(">>> [DEBUG CACHE] UMBRAL ALCANZADO. DISPARANDO ESCRITURA BATCH. <<<") '<--- Nuevo Log 4
End If
MainConnectorsLock.RunMethod("unlock", Null)
' Log($"[DEBUG CACHE] Lock liberado."$) '<--- Nuevo Log 5
' 2. Si se alcanzó el umbral (o si el timer lo llama), disparamos la escritura.
If shouldWriteBatch Then
CallSub(Me, "WriteErrorLogsBatch")
End If
Else
' Log($"[DEBUG CACHE] Logging deshabilitado para DBKey: ${DBKey}. Log de error omitido."$)
End If
End Sub
Public Sub WriteQueryLogsBatch
Dim logsToWrite As List
logsToWrite.Initialize ' 1. Inicializar la lista local (CRÍTICO)
' === PASO 1: Intercambio Atómico de Caché (Protegido por ReentrantLock) ===
MainConnectorsLock.RunMethod("lock", Null)
If QueryLogCache.Size = 0 Then
MainConnectorsLock.RunMethod("unlock", Null)
' Log("[DEBUG BATCH-Q] Saliendo: Caché de rendimiento vacía.")
Return
End If
' *** CORRECCIÓN CRÍTICA: Copia de contenido (AddAll) en lugar de referencia. ***
logsToWrite.AddAll(QueryLogCache)
Dim batchSize As Int = logsToWrite.Size
' Vaciamos la caché global. logsToWrite ahora contiene la copia de los elementos.
QueryLogCache.Initialize
MainConnectorsLock.RunMethod("unlock", Null)
' If logger Then Log($"[LOG BATCH] Iniciando escritura transaccional de ${batchSize} logs de rendimiento. Logs copiados: ${logsToWrite.Size}"$)
' === PASO 2: Escritura Transaccional a SQLite ===
Try
' 1. Iniciar la transacción: Todo lo que siga es una única operación de disco.
SQL1.BeginTransaction
For Each logEntry As Map In logsToWrite
SQL1.ExecNonQuery2("INSERT INTO query_logs (query_name, duration_ms, timestamp, db_key, client_ip, busy_connections, handler_active_requests, timestamp_text_local) VALUES (?, ?, ?, ?, ?, ?, ?, ?)", _
Array As Object(logEntry.Get("query_name"), logEntry.Get("duration_ms"), logEntry.Get("timestamp"), logEntry.Get("db_key"), _
logEntry.Get("client_ip"), logEntry.Get("busy_connections"), logEntry.Get("handler_active_requests"), _
logEntry.Get("timestamp_text_local")))
Next
' 2. Finalizar la transacción: Escritura eficiente a disco.
SQL1.TransactionSuccessful
If logger Then Log($"[LOG BATCH] Lote de ${batchSize} logs de rendimiento escrito exitosamente."$)
Catch
' Si falla, deshacemos todos los logs del lote y registramos el fallo.
SQL1.Rollback
Dim ErrorMsg As String = "ERROR CRÍTICO: Fallo al escribir lote de logs de rendimiento en SQLite: " & LastException.Message
Log(ErrorMsg)
' Usamos LogServerError para que el fallo quede registrado en la tabla 'errores' si el logging está habilitado.
LogServerError("ERROR", "Main.WriteQueryLogsBatch", ErrorMsg, Null, "log_batch_write_performance", Null)
End Try
End Sub
' --- Subrutina de evento para el Timer 'timerLogs'. ---
' El estado 'Enabled' del Timer ya está controlado por IsAnySQLiteLoggingEnabled en AppStart y Manager.
Sub TimerLogs_Tick
Try
' 1. Vaciado de logs de rendimiento (asumiendo que WriteQueryLogsBatch también fue implementado)
WriteQueryLogsBatch
' 2. Vaciado de logs de errores
WriteErrorLogsBatch
' 3. Limpieza y VACUUM (esto ya verifica IsAnySQLiteLoggingEnabled [8])
borraArribaDe15000Logs
Catch
Dim ErrorMsg As String = "ERROR en TimerLogs_Tick al intentar borrar logs: " & LastException.Message
Log(ErrorMsg)
LogServerError("ERROR", "Main.TimerLogs_Tick", ErrorMsg, Null, "log_cleanup", Null)
End Try
End Sub
Public Sub WriteErrorLogsBatch
Dim logsToWrite As List
logsToWrite.Initialize ' *** Aseguramos que logsToWrite sea una LISTA NUEVA y no dependa de la referencia.
' === PASO 1: Intercambio Atómico de Caché (Protegido por ReentrantLock) ===
MainConnectorsLock.RunMethod("lock", Null) ' Adquirimos el bloqueo.
' Log($"[DEBUG BATCH] Lock adquirido en WriteErrorLogsBatch. Caché Size: ${ErrorLogCache.Size}"$)
If ErrorLogCache.Size = 0 Then
MainConnectorsLock.RunMethod("unlock", Null)
' Log("[DEBUG BATCH] Saliendo: Caché vacía.")
Return
End If
' *** CORRECCIÓN CRÍTICA: Copiamos el CONTENIDO de forma atómica. ***
logsToWrite.AddAll(ErrorLogCache) ' <--- ESTO PASA LOS 10 REGISTROS A LA NUEVA LISTA
' Vaciamos la caché global. logsToWrite AHORA ES INDEPENDIENTE.
ErrorLogCache.Initialize
MainConnectorsLock.RunMethod("unlock", Null) ' Liberamos el bloqueo.
' Usamos el tamaño de la lista *copiada*.
Dim batchSize As Int = logsToWrite.Size
If logger Then Log($"[LOG BATCH] Iniciando escritura transaccional de ${batchSize} logs de ERRORES a SQLite. Logs copiados: ${logsToWrite.Size}"$)
' === PASO 2: Escritura Transaccional a SQLite (Usa logsToWrite) ===
If batchSize = 0 Then
Log("ADVERTENCIA: Fallo en la copia de la lista. logsToWrite está vacía. Abortando escritura.")
Return
End If
Try
' 1. Iniciar la transacción.
SQL1.BeginTransaction
For Each logEntry As Map In logsToWrite
' ... (Tu lógica de SQL1.ExecNonQuery2 aquí) ...
SQL1.ExecNonQuery2("INSERT INTO errores (timestamp, type, source, message, db_key, command_name, client_ip) VALUES (?, ?, ?, ?, ?, ?, ?)", _
Array As Object(logEntry.Get("timestamp"), logEntry.Get("type"), logEntry.Get("source"), logEntry.Get("message"), _
logEntry.Get("db_key"), logEntry.Get("command_name"), logEntry.Get("client_ip")))
Next
' 2. Confirmar la transacción.
SQL1.TransactionSuccessful
If logger Then Log($"[LOG BATCH] Lote de ${logsToWrite.Size} logs de ERRORES escrito exitosamente."$)
Catch
' 3. Rollback si falla.
SQL1.Rollback
Dim ErrorMsg As String = "ERROR CRÍTICO: Fallo al escribir lote de logs de ERRORES en SQLite: " & LastException.Message
Log(ErrorMsg)
End Try
End Sub
' --- Borra los registros más antiguos de la tabla 'query_logs' y hace VACUUM. ---
Sub borraArribaDe15000Logs 'ignore
If IsAnySQLiteLoggingEnabled Then ' Solo ejecutar si al menos una DB requiere logs.
If logger Then Log("Recortando la tabla de 'query_logs', límite de 15,000 registros.")
' 1. Limpieza de Logs de Rendimiento (query_logs)
If logger Then Log("Recortando la tabla de 'query_logs', límite de 15,000 registros.")
SQL1.ExecNonQuery("DELETE FROM query_logs WHERE timestamp NOT in (SELECT timestamp FROM query_logs ORDER BY timestamp desc LIMIT 15000 )")
' 2. Limpieza de Logs de Errores (errores)
If logger Then Log("Recortando la tabla de 'errores', límite de 15,000 registros.")
SQL1.ExecNonQuery("DELETE FROM errores WHERE timestamp NOT in (SELECT timestamp FROM errores ORDER BY timestamp desc LIMIT 15000 )")
' 3. Optimización de disco
SQL1.ExecNonQuery("vacuum;")
Else
' Si IsAnySQLiteLoggingEnabled es False, el Timer no debería estar activo.
If logger Then Log("AVISO: Tarea de limpieza de logs omitida. El logging global de SQLite está deshabilitado.")
End If
End Sub
'Copiamos recursos del jar al directorio de la app
Sub CopiarRecursoSiNoExiste(NombreArchivo As String, SubCarpeta As String)
Dim DirDestino As String = File.Combine(File.DirApp, SubCarpeta)
If SubCarpeta <> "" And File.Exists(DirDestino, "") = False Then
File.MakeDir(DirDestino, "")
End If
Dim ArchivoDestino As String = File.Combine(DirDestino, NombreArchivo)
If File.Exists(DirDestino, NombreArchivo) = False Then
Dim RutaRecurso As String
If SubCarpeta <> "" Then
RutaRecurso = "Files/" & SubCarpeta & "/" & NombreArchivo
Else
RutaRecurso = "Files/" & NombreArchivo
End If
Dim classLoader As JavaObject = GetThreadContextClassLoader
Dim InStream As InputStream = classLoader.RunMethod("getResourceAsStream", Array(RutaRecurso))
If InStream.IsInitialized Then
Log($"Copiando recurso: '${RutaRecurso}'..."$)
' Llamamos a nuestra propia función de copiado manual
Dim OutStream As OutputStream = File.OpenOutput(DirDestino, NombreArchivo, False)
CopiarStreamManualmente(InStream, OutStream)
Log($"'${ArchivoDestino}' copiado correctamente."$)
Else
Log($"ERROR: No se pudo encontrar el recurso con la ruta interna: '${RutaRecurso}'"$)
End If
End If
End Sub
' No depende de ninguna librería extraña.
Sub CopiarStreamManualmente (InStream As InputStream, OutStream As OutputStream)
Try
Dim buffer(1024) As Byte
Dim len As Int
len = InStream.ReadBytes(buffer, 0, buffer.Length)
Do While len > 0
OutStream.WriteBytes(buffer, 0, len)
len = InStream.ReadBytes(buffer, 0, buffer.Length)
Loop
Catch
LogError(LastException)
End Try
InStream.Close
OutStream.Close
End Sub
' Función ayudante para obtener el Class Loader correcto.
Sub GetThreadContextClassLoader As JavaObject
Dim thread As JavaObject
thread = thread.InitializeStatic("java.lang.Thread").RunMethod("currentThread", Null)
Return thread.RunMethod("getContextClassLoader", Null)
End Sub

View File

@@ -6,6 +6,8 @@ ModuleBookmarks12=
ModuleBookmarks13= ModuleBookmarks13=
ModuleBookmarks14= ModuleBookmarks14=
ModuleBookmarks15= ModuleBookmarks15=
ModuleBookmarks16=
ModuleBookmarks17=
ModuleBookmarks2= ModuleBookmarks2=
ModuleBookmarks3= ModuleBookmarks3=
ModuleBookmarks4= ModuleBookmarks4=
@@ -22,6 +24,8 @@ ModuleBreakpoints12=
ModuleBreakpoints13= ModuleBreakpoints13=
ModuleBreakpoints14= ModuleBreakpoints14=
ModuleBreakpoints15= ModuleBreakpoints15=
ModuleBreakpoints16=
ModuleBreakpoints17=
ModuleBreakpoints2= ModuleBreakpoints2=
ModuleBreakpoints3= ModuleBreakpoints3=
ModuleBreakpoints4= ModuleBreakpoints4=
@@ -38,14 +42,16 @@ ModuleClosedNodes12=
ModuleClosedNodes13= ModuleClosedNodes13=
ModuleClosedNodes14= ModuleClosedNodes14=
ModuleClosedNodes15= ModuleClosedNodes15=
ModuleClosedNodes16=2,3
ModuleClosedNodes17=
ModuleClosedNodes2= ModuleClosedNodes2=
ModuleClosedNodes3=4,5,6 ModuleClosedNodes3=
ModuleClosedNodes4= ModuleClosedNodes4=
ModuleClosedNodes5= ModuleClosedNodes5=
ModuleClosedNodes6= ModuleClosedNodes6=
ModuleClosedNodes7= ModuleClosedNodes7=
ModuleClosedNodes8= ModuleClosedNodes8=
ModuleClosedNodes9= ModuleClosedNodes9=
NavigationStack=DoLoginHandler,Class_Globals,2,0,DoLoginHandler,Initialize,7,0,Manager,Initialize,98,0,ChangePassHandler,Handle,27,0,DoLoginHandler,Handle,9,0,Manager,Handle0,202,6,Main,Process_Globals,24,0,Main,AppStart,97,0,TestHandler,Handle,11,0,Manager,Handle,46,6,LoginHandler,Handle,16,1 NavigationStack=Main,WriteQueryLogsBatch,522,0,RDCConnector,Initialize,93,0,DBHandlerB4X,Handle,171,0,Main,LogServerError,458,0,Main,WriteErrorLogsBatch,584,0,Main,TimerLogs_Tick,573,0,Main,ArchiveQueryLogsToDailyFile,777,0,Manager,Handle,522,0,Main,ArchiveErrorLogsToDailyFile,840,1,Cambios,Process_Globals,33,6
SelectedBuild=0 SelectedBuild=0
VisibleModules=9,6,14,12,15 VisibleModules=3,4,14,1,10,15,16,17,13,12

View File

@@ -4,6 +4,6 @@
set "params=%*" set "params=%*"
cd /d "%~dp0" && ( if exist "%temp%\getadmin.vbs" del "%temp%\getadmin.vbs" ) && fsutil dirty query %systemdrive% 1>nul 2>nul || ( echo Set UAC = CreateObject^("Shell.Application"^) : UAC.ShellExecute "cmd.exe", "/k cd ""%~sdp0"" && ""%~s0"" %params%", "", "runas", 1 >> "%temp%\getadmin.vbs" && "%temp%\getadmin.vbs" && exit /B ) cd /d "%~dp0" && ( if exist "%temp%\getadmin.vbs" del "%temp%\getadmin.vbs" ) && fsutil dirty query %systemdrive% 1>nul 2>nul || ( echo Set UAC = CreateObject^("Shell.Application"^) : UAC.ShellExecute "cmd.exe", "/k cd ""%~sdp0"" && ""%~s0"" %params%", "", "runas", 1 >> "%temp%\getadmin.vbs" && "%temp%\getadmin.vbs" && exit /B )
pm2 start RDC-Multi pm2 restart jRDC-Multi
exit exit