B4J=true Group=Default Group ModulesStructureVersion=1 Type=Class Version=10.3 @EndOfDesignText@ 'Handler class for JSON requests from Web Clients (JavaScript/axios) 'VERSION 14 (Validación de Parámetros): Chequea que el número de '?' coincida con los parámetros recibidos. Sub Class_Globals Private Connector As RDCConnector End Sub Public Sub Initialize End Sub Sub Handle(req As ServletRequest, resp As ServletResponse) ' --- Headers CORS --- resp.SetHeader("Access-Control-Allow-Origin", "*") resp.SetHeader("Access-Control-Allow-Methods", "GET, POST, OPTIONS") resp.SetHeader("Access-Control-Allow-Headers", "Content-Type") If req.Method = "OPTIONS" Then Return Dim DB As String = "DB1" Connector = Main.Connectors.Get(DB) Dim con As SQL Try Dim jsonString As String = req.GetParameter("j") If jsonString = Null Or jsonString = "" Then SendErrorResponse(resp, 400, "Missing 'j' parameter") Return End If Dim parser As JSONParser parser.Initialize(jsonString) Dim RootMap As Map = parser.NextObject Dim execType As String = RootMap.GetDefault("exec", "") Dim queryName As String = RootMap.Get("query") Dim paramsMap As Map = RootMap.Get("params") If RootMap.Get("dbx") <> Null Then DB = RootMap.Get("dbx") ' Si se especifica, usamos la BD indicada, si no, usamos "DB1". ' Log("RootMap: " & RootMap) ' Log("LA BD: " & DB) ' Log(Main.listaDeCP.size) ' Log("Contiene: " & Main.listaDeCP.IndexOf(DB)) If Main.listaDeCP.IndexOf(DB) = -1 Then SendErrorResponse(resp, 400, "Invalid 'DB' name. The '" & DB & "' name is not valid.") End If Dim paramKeys As List paramKeys.Initialize If paramsMap <> Null And paramsMap.IsInitialized Then For Each key As String In paramsMap.Keys paramKeys.Add(key) Next End If paramKeys.Sort(True) Dim orderedParams As List orderedParams.Initialize For Each key As String In paramKeys orderedParams.Add(paramsMap.Get(key)) Next con = Connector.GetConnection(DB) Dim sqlCommand As String = Connector.GetCommand(DB, queryName) If execType.ToLowerCase = "executequery" Then Dim rs As ResultSet If sqlCommand.Contains("?") Then ' ================================================================= ' === VALIDACIÓN DE CONTEO DE PARÁMETROS ========================== ' ================================================================= Dim expectedParams As Int = sqlCommand.Length - sqlCommand.Replace("?", "").Length Dim receivedParams As Int = orderedParams.Size If expectedParams <> receivedParams Then SendErrorResponse(resp, 400, $"Parameter count mismatch. The command '${queryName}' expects ${expectedParams} parameter(s), but received ${receivedParams}."$) Return ' Detenemos la ejecución antes de tocar la BD End If ' ================================================================= rs = con.ExecQuery2(sqlCommand, orderedParams) Else rs = con.ExecQuery(sqlCommand) End If ' --- Procesamiento de resultados (sin cambios) --- Dim ResultList As List ResultList.Initialize Dim jrs As JavaObject = rs Dim rsmd As JavaObject = jrs.RunMethod("getMetaData", Null) Dim cols As Int = rsmd.RunMethod("getColumnCount", Null) Do While rs.NextRow Dim RowMap As Map RowMap.Initialize For i = 1 To cols Dim ColumnName As String = rsmd.RunMethod("getColumnName", Array(i)) Dim value As Object = jrs.RunMethod("getObject", Array(i)) RowMap.Put(ColumnName, value) Next ResultList.Add(RowMap) Loop rs.Close SendSuccessResponse(resp, CreateMap("result": ResultList)) Else If execType.ToLowerCase = "executecommand" Then 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, $"Parameter count mismatch. The command '${queryName}' expects ${expectedParams} parameter(s), but received ${receivedParams}."$) Return ' Detenemos la ejecución End If ' ================================================================= End If con.ExecNonQuery2(sqlCommand, orderedParams) SendSuccessResponse(resp, CreateMap("message": "Command executed successfully")) Else SendErrorResponse(resp, 400, "Invalid 'exec' value. Use '" & execType & "' is not valid.") End If Catch Log(LastException) SendErrorResponse(resp, 500, LastException.Message) End Try If con <> Null And con.IsInitialized Then con.Close End If End Sub ' --- Subrutinas de ayuda para respuestas JSON (sin cambios) --- Private Sub SendSuccessResponse(resp As ServletResponse, dataMap As Map) dataMap.Put("success", True) Dim jsonGenerator As JSONGenerator jsonGenerator.Initialize(dataMap) resp.ContentType = "application/json" resp.Write(jsonGenerator.ToString) End Sub Private Sub SendErrorResponse(resp As ServletResponse, statusCode As Int, errorMessage As String) Dim resMap As Map = CreateMap("success": False, "error": errorMessage) Dim jsonGenerator As JSONGenerator jsonGenerator.Initialize(resMap) resp.Status = statusCode resp.ContentType = "application/json" resp.Write(jsonGenerator.ToString) End Sub