Option Compare Database
Option Explicit

'================================================
' Módulo SQL
' 2009-IV-11 <fco@proinf.net>
'================================================

'------------------------------------------------
' Tipos de datos
'------------------------------------------------
Public Function sqlTipo(ByVal valor As Variant) As String
'Obtiene el tipo de datos SQL
'Ej: sqlTipo(123) --> "NUMBER"
'2009-I-30
    If Nz(valor, "") = "" Then
        sqlTipo = "NULL"
    ElseIf IsNumeric(valor) Then
        sqlTipo = "NUMBER"
    ElseIf IsDate(valor) Then
        sqlTipo = "DATE"
    Else
        sqlTipo = "STRING"
    End If
End Function
Public Function sqlLiteral( _
    ByVal valor As Variant, _
    Optional ByVal tipo As String = "AUTO" _
) As String
'Convierte un variant en un literal SQL
'Ej: sqlLiteral("Pepe's") --> 'Pepe''s'
'2009-I-25, 2009-I-30 <fco@proinf.net>

    Const COMA = ","
    Const PUNTO = "."
    Const COMILLA = "'"
    
    If Nz(valor, "") = "" Then
        tipo = "NULL"
    ElseIf tipo = "AUTO" Then
        tipo = sqlTipo(valor)
    End If
    
    Select Case tipo
        Case "NULL":
            sqlLiteral = ""
        
        Case "NUMBER": 'Cambiar la coma por punto para que coincida con el sistema estadounidense
            sqlLiteral = Replace(Nz(valor, 0), COMA, PUNTO)
                
        Case "DATE": 'Poner el formato de fecha al estilo estadounidense
            sqlLiteral = Format(CDate(valor), "\#mm/dd/yyyy\#")
        
        Case "STRING": 'Duplicar las COMILLA simples
            sqlLiteral = COMILLA & Replace(valor, COMILLA, COMILLA & COMILLA) & COMILLA
            
    End Select
    
End Function

'------------------------------------------------
' Parámetros SQL
'------------------------------------------------
Public Function sqlParametrizar(ByVal sql As String, ParamArray parametros()) As String
'Parametriza el SQL sin tener en cuenta si se trata o no de literales SQL
'Ej: sqlParametrizar("select id, <campo> from <tabla> order by <campo>", "usuario", "usuarios")
'      --> "select id, usuario from usuarios order by usuario"
'2009-I-26
    
    Dim elemento As Variant
    Dim parametro As String
    For Each elemento In parametros
        parametro = ObtenerPrimerParametro(sql)
        If parametro = "" Then
            Exit For
        Else
            sql = Replace(sql, parametro, elemento)
        End If
    Next
    sqlParametrizar = sql

End Function
Public Function sqlParametrizarLiterales(ByVal sql As String, ParamArray parametros()) As String
'Parametriza los literales SQL: si es un texto lo entrecomilla, si es una fecha le pone #, etc.
'Ej: ParametrizarLiteralesSQL("insert into tabla(campo1, campo2, campo3) select «valor1», «valor2», «valor3»", date, "pepe", 1001)
'      --> "insert into tabla(campo1, campo2, campo3) select #2009/4/11#, 'pepe', 1001)
'2009-I-25

    Dim elemento As Variant
    Dim parametro As String
    For Each elemento In parametros
        parametro = ObtenerPrimerParametro(sql)
        If parametro = "" Then
            Exit For
        Else
            sql = Replace(sql, parametro, sqlLiteral(elemento))
        End If
    Next
    sqlParametrizarLiterales = sql

End Function
Private Function ObtenerPrimerParametro(ByVal sql As String) As String
    Dim pos1 As Integer: pos1 = InStr(sql, "«")
    Dim pos2 As Integer: pos2 = InStr(sql, "»")
    If pos1 > 0 Or pos2 > 0 Then ObtenerPrimerParametro = Mid(sql, pos1, pos2 - pos1 + 1)
End Function

'------------------------------------------------
' Ejecución
'------------------------------------------------
Public Function sqlEjecutar(ByVal sql As String) As Boolean
'2009-IV-10 <fco@proinf.net>
On Error GoTo Errores
    CurrentDb.Execute sql, dbFailOnError
    sqlEjecutar = True
Salida:
    Exit Function
Errores:
    MsgBox Err.Description, vbCritical, "Error"
    Resume Salida
End Function

'------------------------------------------------
' Gestión de datos interactivo
'------------------------------------------------
Public Function sqlEditarInteractivo(ByVal sql As String, ByVal id As Long, ByVal valor_actual As String) As Boolean
'2009-IV-10 <fco@proinf.net>
    Dim valor As String
    
    valor = entrarValor(valor_actual)
    If valor = "" Then Exit Function
    
    sql = sqlParametrizar(sql, sqlLiteral(valor, "STRING"), id)
    
    sqlEditarInteractivo = sqlEjecutar(sql)
End Function
Public Function sqlBorrarInteractivo(ByVal sql As String, ByVal id As Long, ByVal valor_actual As String) As Boolean
'2009-IV-10 <fco@proinf.net>
    If confirmarBorrado(valor_actual) Then
        sqlBorrarInteractivo = sqlBorrar(sql, id)
    End If
End Function
Public Function sqlBorrar(ByVal sql As String, ByVal id As Long) As Boolean
'2009-IV-10 <fco@proinf.net>
    sql = sqlParametrizar(sql, id)
    sqlBorrar = sqlEjecutar(sql)
End Function
Public Function sqlAgregarInteractivo(ByVal sql As String, ParamArray extra()) As Boolean
'2009-IV-10 <fco@proinf.net>
    Dim valor As String
    Dim aux As Variant
        
    valor = entrarValor()
    If valor = "" Then Exit Function
    
    sql = sqlParametrizar(sql, sqlLiteral(valor, "STRING"))
    
    For Each aux In extra
        sql = sqlParametrizarLiterales(sql, aux)
    Next
    
    sqlAgregarInteractivo = sqlEjecutar(sql)
End Function

'------------------------------------------------
' Funciones auxiliares
'------------------------------------------------
Public Function entrarValor(Optional ByVal omision As String = "") As String
    entrarValor = Replace(Trim(Nz(InputBox("Introduce el valor:", Default:=omision), "")), "'", "''")
End Function
Public Function esId(ByVal id As Variant) As Boolean
    If IsNumeric(id) Then
        esId = id <> 0
    End If
End Function
Public Function confirmarBorrado(ByVal valor As String) As Boolean
    confirmarBorrado = vbYes = MsgBox("¿Borrar «" & valor & "» ?", vbQuestion + vbYesNo + vbDefaultButton2)
End Function