bdSQL.bas

  1. Attribute VB_Name = "bdSQL"
  2. Option Compare Database
  3. Option Explicit
  4.  
  5. '================================================
  6. ' Módulo SQL
  7. ' 2009-IV-11 <fco@proinf.net>
  8. '================================================
  9.  
  10. '------------------------------------------------
  11. ' Tipos de datos
  12. '------------------------------------------------
  13.  
  14. Public Function sqlTipo(ByVal valor As Variant) As String
  15. 'Obtiene el tipo de datos SQL
  16. 'Ej: sqlTipo(123) --> "NUMBER"
  17. '2009-I-30
  18. If Nz(valor, "") = "" Then
  19. sqlTipo = "NULL"
  20. ElseIf IsNumeric(valor) Then
  21. sqlTipo = "NUMBER"
  22. ElseIf IsDate(valor) Then
  23. sqlTipo = "DATE"
  24. Else
  25. sqlTipo = "STRING"
  26. End If
  27. End Function
  28.  
  29. Public Function sqlLiteral( _
  30. ByVal valor As Variant, _
  31. Optional ByVal tipo As String = "AUTO" _
  32. ) As String
  33. 'Convierte un variant en un literal SQL
  34. 'Ej: sqlLiteral("Pepe's") --> 'Pepe''s'
  35. '2009-I-25, 2009-I-30 <fco@proinf.net>
  36.  
  37. Const COMA = ","
  38. Const PUNTO = "."
  39. Const COMILLA = "'"
  40.  
  41. If Nz(valor, "") = "" Then
  42. tipo = "NULL"
  43. ElseIf tipo = "AUTO" Then
  44. tipo = sqlTipo(valor)
  45. End If
  46.  
  47. Select Case tipo
  48. Case "NULL":
  49. sqlLiteral = ""
  50.  
  51. Case "NUMBER": 'Cambiar la coma por punto para que coincida con el sistema estadounidense
  52. sqlLiteral = Replace(Nz(valor, 0), COMA, PUNTO)
  53.  
  54. Case "DATE": 'Poner el formato de fecha al estilo estadounidense
  55. sqlLiteral = Format(CDate(valor), "\#mm/dd/yyyy\#")
  56.  
  57. Case "STRING": 'Duplicar las COMILLA simples
  58. sqlLiteral = COMILLA & Replace(valor, COMILLA, COMILLA & COMILLA) & COMILLA
  59.  
  60. End Select
  61.  
  62. End Function
  63.  
  64. '------------------------------------------------
  65. ' Parámetros SQL
  66. '------------------------------------------------
  67.  
  68. Public Function sqlParametrizar(ByVal sql As String, ParamArray parametros()) As String
  69. 'Parametriza el SQL sin tener en cuenta si se trata o no de literales SQL
  70. 'Ej: sqlParametrizar("select id, <campo> from <tabla> order by <campo>", "usuario", "usuarios")
  71. ' --> "select id, usuario from usuarios order by usuario"
  72. '2009-I-26
  73.  
  74. Dim elemento As Variant
  75. Dim parametro As String
  76. For Each elemento In parametros
  77. parametro = ObtenerPrimerParametro(sql)
  78. If parametro = "" Then
  79. Exit For
  80. Else
  81. sql = Replace(sql, parametro, elemento)
  82. End If
  83. Next
  84. sqlParametrizar = sql
  85.  
  86. End Function
  87. Public Function sqlParametrizarLiterales(ByVal sql As String, ParamArray parametros()) As String
  88. 'Parametriza los literales SQL: si es un texto lo entrecomilla, si es una fecha le pone #, etc.
  89. 'Ej: ParametrizarLiteralesSQL("insert into tabla(campo1, campo2, campo3) select «valor1», «valor2», «valor3»", date, "pepe", 1001)
  90. ' --> "insert into tabla(campo1, campo2, campo3) select #2009/4/11#, 'pepe', 1001)
  91. '2009-I-25
  92.  
  93. Dim elemento As Variant
  94. Dim parametro As String
  95. For Each elemento In parametros
  96. parametro = ObtenerPrimerParametro(sql)
  97. If parametro = "" Then
  98. Exit For
  99. Else
  100. sql = Replace(sql, parametro, sqlLiteral(elemento))
  101. End If
  102. Next
  103. sqlParametrizarLiterales = sql
  104.  
  105. End Function
  106.  
  107. Private Function ObtenerPrimerParametro(ByVal sql As String) As String
  108. Dim pos1 As Integer: pos1 = InStr(sql, "«")
  109. Dim pos2 As Integer: pos2 = InStr(sql, "»")
  110. If pos1 > 0 Or pos2 > 0 Then ObtenerPrimerParametro = Mid(sql, pos1, pos2 - pos1 + 1)
  111. End Function
  112.  
  113. '------------------------------------------------
  114. ' Ejecución
  115. '------------------------------------------------
  116.  
  117. Public Function sqlEjecutar(ByVal sql As String) As Boolean
  118. '2009-IV-10 <fco@proinf.net>
  119. On Error GoTo Errores
  120. CurrentDb.Execute sql, dbFailOnError
  121. sqlEjecutar = True
  122. Salida:
  123. Exit Function
  124. Errores:
  125. MsgBox Err.Description, vbCritical, "Error"
  126. Resume Salida
  127. End Function
  128.  
  129. '------------------------------------------------
  130. ' Gestión de datos interactivo
  131. '------------------------------------------------
  132.  
  133. Public Function sqlEditarInteractivo(ByVal sql As String, ByVal id As Long, ByVal valor_actual As String) As Boolean
  134. '2009-IV-10 <fco@proinf.net>
  135. Dim valor As String
  136.  
  137. valor = entrarValor(valor_actual)
  138. If valor = "" Then Exit Function
  139.  
  140. sql = sqlParametrizar(sql, sqlLiteral(valor, "STRING"), id)
  141.  
  142. sqlEditarInteractivo = sqlEjecutar(sql)
  143. End Function
  144.  
  145. Public Function sqlBorrarInteractivo(ByVal sql As String, ByVal id As Long, ByVal valor_actual As String) As Boolean
  146. '2009-IV-10 <fco@proinf.net>
  147. If confirmarBorrado(valor_actual) Then
  148. sqlBorrarInteractivo = sqlBorrar(sql, id)
  149. End If
  150. End Function
  151.  
  152. Public Function sqlBorrar(ByVal sql As String, ByVal id As Long) As Boolean
  153. '2009-IV-10 <fco@proinf.net>
  154. sql = sqlParametrizar(sql, id)
  155. sqlBorrar = sqlEjecutar(sql)
  156. End Function
  157.  
  158. Public Function sqlAgregarInteractivo(ByVal sql As String, ParamArray extra()) As Boolean
  159. '2009-IV-10 <fco@proinf.net>
  160. Dim valor As String
  161. Dim aux As Variant
  162.  
  163. valor = entrarValor()
  164. If valor = "" Then Exit Function
  165.  
  166. sql = sqlParametrizar(sql, sqlLiteral(valor, "STRING"))
  167.  
  168. For Each aux In extra
  169. sql = sqlParametrizarLiterales(sql, aux)
  170. Next
  171.  
  172. sqlAgregarInteractivo = sqlEjecutar(sql)
  173. End Function
  174.  
  175. '------------------------------------------------
  176. ' Funciones auxiliares
  177. '------------------------------------------------
  178.  
  179. Public Function entrarValor(Optional ByVal omision As String = "") As String
  180. entrarValor = Replace(Trim(Nz(InputBox("Introduce el valor:", Default:=omision), "")), "'", "''")
  181. End Function
  182.  
  183. Public Function esId(ByVal id As Variant) As Boolean
  184. If IsNumeric(id) Then
  185. esId = id <> 0
  186. End If
  187. End Function
  188.  
  189. Public Function confirmarBorrado(ByVal valor As String) As Boolean
  190. confirmarBorrado = vbYes = MsgBox("¿Borrar «" & valor & "» ?", vbQuestion + vbYesNo + vbDefaultButton2)
  191. End Function
  192.  

Proinf.net