Hola listeros:
Yo uso este codigo en windows...
---------------------------------------------------------------------------------------------------------------------------
Private Const REG_SZ = 1
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_CURRENT_USER = &H80000001
Private Const REG_CREATED_NEW_KEY = &H1
Private Const REG_OPENED_EXISTING_KEY = &H2
Private Const REG_OPENED_EXISTING_KEY = &H2
Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Dim lpSecurity_Attributes As SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Dim lpSecurity_Attributes As SECURITY_ATTRIBUTES
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias _
"RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, _
phkResult As Long) As Long
"RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, _
phkResult As Long) As Long
Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" _
(ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, _
ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, _
lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, _
lpdwDisposition As Long) As Long
(ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, _
ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, _
lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, _
lpdwDisposition As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias _
"RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal _
cbData As Long) As Long
"RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal _
cbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long
Public Sub Crea_OdbcSQL()
(ByVal hKey As Long) As Long
Public Sub Crea_OdbcSQL()
Dim en As rdoEnvironment
Dim cnTest As rdoConnection
Dim strAttribs As String
Dim DataSourceName As String
Dim DatabaseName As String
Dim Description As String
Dim DriverPath As String
Dim DriverName As String
Dim LastUser As String
Dim Regional As String
Dim Server As String
Dim lResult As Long
Dim hKeyHandle As Long
Dim PassWord As String
Dim cnTest As rdoConnection
Dim strAttribs As String
Dim DataSourceName As String
Dim DatabaseName As String
Dim Description As String
Dim DriverPath As String
Dim DriverName As String
Dim LastUser As String
Dim Regional As String
Dim Server As String
Dim lResult As Long
Dim hKeyHandle As Long
Dim PassWord As String
On Error GoTo nError
'---Especificaciones de los parametros DSN.
DataSourceName = "NOMBRE DE SISTEMA" 'tu eliges el nombre
DatabaseName = "NOMBRE BASE DE DATOS"
Description = "PON LA DESCRIPCION ADECUADA PARA TU CONEXION" 'O cualquier cadena
LastUser = "USUARIO" ' "sa" ó "dbo" o una personalizada
Server = "NOMBRE SERVIDOR"
DriverName = "CONTROLADOR DE DATOS" 'Microsoft Jet, SQL server, Oracle u otro
PassWord = "Tu PASSWORD"
'--- Registra DSN inicial
rdoEngine.rdoRegisterDataSource Trim(DataSourceName), Trim(DriverName), True, ""
'---Crea la nueva llave DSN.
lResult = RegCreateKeyEx(HKEY_CURRENT_USER, "SOFTWARE\ODBC\ODBC.INI\" & Trim(DataSourceName), 0, "", 0, KEY_ALL_ACCESS, lpSecurity_Attributes, hKeyHandle, REG_CREATED_NEW_KEY)
'---Entrega los valores a la nueva llave.
lResult = RegSetValueEx(hKeyHandle, "Database", 0&, REG_SZ, ByVal DatabaseName, Len(DatabaseName))
lResult = RegSetValueEx(hKeyHandle, "Description", 0&, REG_SZ, ByVal Description, Len(Description))
lResult = RegSetValueEx(hKeyHandle, "LastUser", 0&, REG_SZ, ByVal LastUser, Len(LastUser))
lResult = RegSetValueEx(hKeyHandle, "Server", 0&, REG_SZ, ByVal Server, Len(Server))
'---Se cierra la llave.
lResult = RegCloseKey(hKeyHandle)
'otra vez, pero directo al nuevo DSN
lResult = RegCreateKeyEx(HKEY_CURRENT_USER, "SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources", 0, "", 0, KEY_ALL_ACCESS, lpSecurity_Attributes, hKeyHandle, REG_CREATED_NEW_KEY)
lResult = RegSetValueEx(hKeyHandle, DataSourceName, 0&, REG_SZ, ByVal DriverName, Len(DriverName))
lResult = RegCloseKey(hKeyHandle)
'--- Revisa conexión con DSN creado
Set en = rdoEngine.rdoEnvironments(0)
Set cnTest = en.OpenConnection( _
dsName:=Trim(DataSourceName), _
prompt:=rdDriverNoPrompt, _
Connect:="UID=" & Trim(LastUser) & ";PWD=" & Trim(PassWord) & ";")
'--- Cierra conexión
cnTest.Close
On Error GoTo 0
Exit Sub
nError:
MsgBox "No se ha creado correctamente DSN en su equipo. " & vbCr & "(Error #" & Err.Number & ". " & Trim(Err.Description) & ")", vbExclamation + vbOKOnly, "¡Atención!"
End
End Sub
MsgBox "No se ha creado correctamente DSN en su equipo. " & vbCr & "(Error #" & Err.Number & ". " & Trim(Err.Description) & ")", vbExclamation + vbOKOnly, "¡Atención!"
End
End Sub
---------------------------------------------------------------------------------------------------------------------------
espero que sirva.
Saludos.
Rodrigo Pairo Ojeda
Informática