send
Grupo de Telegram
play_arrow
Este sitio utiliza cookies propias y de terceros. Si continúa navegando consideramos que acepta el uso de cookies. OK Más Información.

.bas para control de ODBC de bases de datos

  • 0 Respuestas
  • 1225 Vistas

0 Usuarios y 1 Visitante están viendo este tema.

Conectado ANTRAX

  • *
  • Administrator
  • Mensajes: 5283
  • Actividad:
    35%
  • Reputación 28
  • ANTRAX
    • Ver Perfil
    • Underc0de
    • Email
  • Skype: underc0de.org
  • Twitter: @Underc0de
« en: Julio 26, 2010, 12:41:20 pm »
Este .bas en el que se detallan funciones para gestionar todo esto.
Copiar todo el siguiente código y meterlo en un .bas en vuestro proyecto, y simplemente solo os queda llamar a las funciones.

Siento haber tardado en poner esta FAQ, pero más vale tarde uqe nunca, verdad????

Código: Visual Basic
  1. Option Explicit
  2.  
  3. ' Constantes
  4. Private Const ODBC_ADD_DSN = 1 ' Nuevo DSN
  5. Private Const ODBC_CONFIG_DSN = 2 ' Modificar DSN
  6. Private Const ODBC_REMOVE_DSN = 3 ' Eliminar DSN
  7. Private Const ODBC_ADD_SYS_DSN = 4 ' Nuevo DSN de sistema
  8. Private Const ODBC_CONFIG_SYS_DSN = 5 ' Modificar DSN de sistema
  9. Private Const ODBC_REMOVE_SYS_DSN = 6 ' Eliminar DSN de sistema
  10. Private Const vbAPINull As Long = 0 ' Null Pointer
  11. Private Const SQL_SUCCESS As Long = 0
  12. Private Const SQL_FETCH_NEXT As Long = 1
  13.  
  14. ' Declaración de funciones de API
  15. Private Declare Function SQLConfigDataSource Lib "ODBCCP32.DLL" (ByVal hwndParent As Long, ByVal fRequest As Long, ByVal lpszDriver As String, ByVal lpszAttributes As String) As Long
  16. Private Declare Function SQLDataSources Lib "ODBC32.DLL" (ByVal henv As Long, ByVal fDirection As Integer, ByVal szDSN As String, ByVal cbDSNMax As Integer, pcbDSN As Integer, ByVal szDescription As String, ByVal cbDescriptionMax As Integer, pcbDescription As Integer) As Integer
  17. Private Declare Function SQLAllocEnv Lib "ODBC32.DLL" (Env As Long) As Integer
  18.  
  19. Function FoxCrearDSN(sDSN As String, Optional sDatabase) As Boolean
  20.  
  21. Dim sDriver As String
  22. Dim sAtributos As String
  23.  
  24. sDriver = "Microsoft Visual FoxPro Driver"
  25. sAtributos = "DSN=" & sDSN & Chr(0)
  26. sAtributos = sAtributos & "SourceType=DBF" & Chr(0)
  27. 'sAtributos = sAtributos & "Collate=Machine" & Chr(0)
  28. 'sAtributos = sAtributos & "Exclusive=No" & Chr(0)
  29. 'sAtributos = sAtributos & "Deleted=Yes" & Chr(0)
  30. 'sAtributos = sAtributos & "Null=Yes" & Chr(0)
  31. If Not IsMissing(sDatabase) Then
  32. sAtributos = sAtributos & "SourceDB=" & sDatabase & Chr(0)
  33. End If
  34. ' Si queremos quitar la base de datos, debemos borrarlo antes
  35. If ExisteDSN(sDSN) Then
  36. Call BorrarDSN(sDSN, sDriver)
  37. End If
  38. FoxCrearDSN = CrearDSN(sDSN, sDriver, sAtributos)
  39.  
  40. End Function
  41.  
  42. Function FoxModificarDSN(sDSN As String, Optional sDatabase) As Boolean
  43.  
  44. Dim sDriver As String
  45. Dim sAtributos As String
  46.  
  47. sDriver = "Microsoft Visual FoxPro Driver"
  48. sAtributos = "DSN=" & sDSN & Chr(0)
  49. sAtributos = sAtributos & "SourceType=DBF" & Chr(0)
  50. 'sAtributos = sAtributos & "Collate=Machine" & Chr(0)
  51. 'sAtributos = sAtributos & "Exclusive=No" & Chr(0)
  52. 'sAtributos = sAtributos & "Deleted=Yes" & Chr(0)
  53. 'sAtributos = sAtributos & "Null=Yes" & Chr(0)
  54. If Not IsMissing(sDatabase) Then
  55. sAtributos = sAtributos & "SourceDB=" & sDatabase & Chr(0)
  56. End If
  57. ' Debido a que si no especificamos un atributo existente, el atributo
  58. ' original se conserva, a veces es mejor borrar el DSN y volverlo a
  59. ' crear
  60. FoxModificarDSN = ModificarDSN(sDSN, sDriver, sAtributos)
  61.  
  62. End Function
  63. Function FoxBorrarDSN(sDSN As String) As Boolean
  64.  
  65. Dim sDriver As String
  66.  
  67. sDriver = "Microsoft Visual FoxPro Driver"
  68. FoxBorrarDSN = BorrarDSN(sDSN, sDriver)
  69.  
  70. End Function
  71.  
  72. Function SQLCrearDSN(sDSN As String, sServidor As String, Optional sDatabase) As Boolean
  73.  
  74. Dim sDriver As String
  75. Dim sAtributos As String
  76.  
  77. sDriver = "SQL Server"
  78. sAtributos = "DSN=" & sDSN & Chr(0)
  79. sAtributos = sAtributos & "SERVER=" & sServidor & Chr(0)
  80. If Not IsMissing(sDatabase) Then
  81. sAtributos = sAtributos & "DATABASE=" & sDatabase & Chr(0)
  82. End If
  83. ' Si queremos quitar la base de datos, debemos borrarlo antes
  84. If ExisteDSN(sDSN) Then
  85. Call BorrarDSN(sDSN, sDriver)
  86. End If
  87. SQLCrearDSN = CrearDSN(sDSN, sDriver, sAtributos)
  88.  
  89. End Function
  90.  
  91. Function SQLModificarDSN(sDSN As String, sServidor As String, Optional sDatabase) As Boolean
  92.  
  93. Dim sDriver As String
  94. Dim sAtributos As String
  95.  
  96. sDriver = "SQL Server"
  97. sAtributos = "DSN=" & sDSN & Chr(0)
  98. sAtributos = sAtributos & "SERVER=" & sServidor & Chr(0)
  99. If Not IsMissing(sDatabase) Then
  100. sAtributos = sAtributos & "DATABASE=" & sDatabase & Chr(0)
  101. End If
  102. ' Debido a que si no especificamos un atributo existente, el atributo
  103. ' original se conserva, a veces es mejor borrar el DSN y volverlo a
  104. ' crear
  105. SQLModificarDSN = ModificarDSN(sDSN, sDriver, sAtributos)
  106.  
  107. End Function
  108. Function SQLBorrarDSN(sDSN As String) As Boolean
  109.  
  110. Dim sDriver As String
  111.  
  112. sDriver = "SQL Server"
  113. SQLBorrarDSN = BorrarDSN(sDSN, sDriver)
  114.  
  115. End Function
  116.  
  117. Function CrearDSN(sDSN As String, sDriver As String, sAtributos As String) As Boolean
  118.  
  119. ' Atributos
  120. '
  121. ' DSN=SQL & Chr(0)
  122. ' SERVER=SQLSERVER & Chr(0)
  123. ' DESCRIPTION=Conexión SQL Server & Chr(0) ' Opcional
  124. ' DATABASE=ACERIA & Chr(0) ' Opcional
  125.  
  126. ' Creamos el DSN (En vez de vbAPINull, empleamos el hwnd del formulario)
  127. CrearDSN = CBool(SQLConfigDataSource(vbAPINull, ODBC_ADD_SYS_DSN, sDriver, sAtributos))
  128.  
  129. End Function
  130.  
  131. Function ModificarDSN(sDSN As String, sDriver As String, sAtributos As String) As Boolean
  132.  
  133. ' Atributos
  134. '
  135. ' DSN=SQL & Chr(0)
  136. ' SERVER=SQLSERVER & Chr(0)
  137. ' DESCRIPTION=Conexión SQL Server & Chr(0) ' Opcional
  138. ' DATABASE=ACERIA & Chr(0) ' Opcional
  139.  
  140. ' Modificamos el DSN (En vez de vbAPINull, empleamos el hwnd del formulario)
  141. If ExisteDSN(sDSN) Then
  142. ModificarDSN = CBool(SQLConfigDataSource(vbAPINull, ODBC_CONFIG_SYS_DSN, sDriver, sAtributos))
  143. Else
  144. MsgBox "No existe el DSN"
  145. ModificarDSN = False
  146. End If
  147.  
  148. End Function
  149.  
  150. Function BorrarDSN(sDSN As String, sDriver As String) As Boolean
  151.  
  152. Dim sAtributos As String
  153.  
  154. ' Borramos el DSN (En vez de vbAPINull, empleamos el hwnd del formulario)
  155. If ExisteDSN(sDSN) Then
  156. sAtributos = "DSN=" & sDSN & Chr(0)
  157. BorrarDSN = CBool(SQLConfigDataSource(vbAPINull, ODBC_REMOVE_SYS_DSN, sDriver, sAtributos))
  158. Else
  159. MsgBox "No existe el DSN"
  160. BorrarDSN = False
  161. End If
  162.  
  163. End Function
  164.  
  165. Function ExisteDSN(sDSN As String) As Boolean
  166.  
  167. Dim I As Integer, j As Integer
  168. Dim sDSNItem As String * 1024
  169. Dim sDRVItem As String * 1024
  170. Dim sDSNActual As String
  171. Dim sDRV As String
  172. Dim iDSNLen As Integer
  173. Dim iDRVLen As Integer
  174. Dim lHenv As Long 'controlador del entorno
  175. Dim DSNLISTA(100)
  176.  
  177. ExisteDSN = False
  178.  
  179. For j = 1 To 52
  180. DSNLISTA(j) = ""
  181. Next j
  182. j = 1
  183. If SQLAllocEnv(lHenv) <> -1 Then
  184. Do Until I <> SQL_SUCCESS
  185. sDSNItem = Space(1024)
  186. sDRVItem = Space(1024)
  187. I = SQLDataSources(lHenv, SQL_FETCH_NEXT, sDSNItem, 1024, iDSNLen, sDRVItem, 1024, iDRVLen)
  188. sDSNActual = VBA.Left(sDSNItem, iDSNLen)
  189. sDRV = VBA.Left(sDRVItem, iDRVLen)
  190.  
  191. If sDSN <> Space(iDSNLen) Then
  192. DSNLISTA(j) = sDSN
  193. If UCase(sDSN) = UCase(sDSNActual) Then
  194. ExisteDSN = True
  195. Exit Do
  196. End If
  197. End If
  198. Loop
  199. End If
  200. End Function
« Última modificación: Mayo 12, 2014, 03:16:11 pm por Expermicid »


 

¿Te gustó el post? COMPARTILO!



mPatchFunction - Parchea funciones para saltar a una nueva direccion

Iniciado por Karcrack

Respuestas: 0
Vistas: 1491
Último mensaje Junio 16, 2013, 06:30:21 pm
por Karcrack
Otra Forma Para Ingresar Solo Numeros

Iniciado por ANTRAX

Respuestas: 0
Vistas: 1266
Último mensaje Julio 26, 2010, 11:16:54 am
por ANTRAX
Funcion para crear letras en 3D con colores vivos.

Iniciado por 79137913

Respuestas: 1
Vistas: 3372
Último mensaje Febrero 02, 2013, 03:23:30 pm
por alexander1712
Como hacer un boton en Flash para VB6

Iniciado por ANTRAX

Respuestas: 0
Vistas: 1252
Último mensaje Julio 26, 2010, 12:32:48 pm
por ANTRAX
Actualizador para tus programa [modulo]

Iniciado por alexander1712

Respuestas: 3
Vistas: 2720
Último mensaje Julio 14, 2016, 10:16:11 pm
por noxonsoftwares