🚀 go-pugleaf

En VB6.0
Option Explicit

'Constant Declaration
Private Const ODBC_ADD_DSN = 1        ' Add data source
Private Const ODBC_CONFIG_DSN = 2     ' Configure (edit) data source
Private Const ODBC_REMOVE_DSN = 3     ' Remove data source

Private Const ODBC_ADD_SYS_DSN = 4
Private Const ODBC_CONFIG_SYS_DSN = 5
Private Const ODBC_REMOVE_SYS_DSN = 6
Private Const ODBC_REMOVE_DEFAULT_DSN = 7
Private Const vbAPINull As Long = 0&  ' NULL Pointer


'Function Declare
#If Win32 Then
     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
#Else
     Private Declare Function SQLConfigDataSource Lib "ODBCINST.DLL" _
     (ByVal hwndParent As Integer, ByVal fRequest As Integer, ByVal _
     lpszDriver As String, ByVal lpszAttributes As String) As Integer
#End If

Public Function CrearDSN(ByVal strDriver As String, _
             ByVal strAttributes As String, Optional tipo As Boolean = 
False) As Boolean

#If Win32 Then
     Dim intRet As Long
#Else
     Dim intRet As Integer
#End If
If tipo = False Then
      intRet = SQLConfigDataSource(vbAPINull, ODBC_ADD_DSN, _
         strDriver, strAttributes)
Else
     intRet = SQLConfigDataSource(vbAPINull, ODBC_ADD_SYS_DSN, _
         strDriver, strAttributes)
End If
If intRet Then
     CrearDSN = True
Else
     CrearDSN = False
End If
End Function

Public Function BorrarDSN(strDriver As String, _
             strAttributes As String, Optional tipo As Boolean = False) 
As Boolean
#If Win32 Then
     Dim intRet As Long
#Else
     Dim intRet As Integer
#End If
Dim cadena As String
cadena = "DSN=" & strAttributes & Chr$(0)
If tipo = False Then
     intRet = SQLConfigDataSource(vbAPINull, ODBC_REMOVE_DSN, _
         strDriver, strAttributes)
Else
     intRet = SQLConfigDataSource(vbAPINull, ODBC_REMOVE_SYS_DSN, _
         strDriver, strAttributes)
End If

If intRet Then
     BorrarDSN = True
Else
     BorrarDSN = False
End If
End Function

Public Function AtributosCon(controlador As String, _
         dsn As String, _
         Servidor As String, _
         basededatos As String, _
         descripcion As String, _
         Optional usuario As String = "", _
         Optional clave As String = "") As String
Dim cadena As String
Dim cadena2 As String
Dim posicion As Integer
Dim posicion2 As Integer
Dim tamano As Integer

Select Case controlador
     ' cadena de conexion para el servidor  de sqlserver
     Case "SQL Server"
         cadena = "DSN=" & dsn & Chr$(0)
         posicion = InStr(Servidor, ";")
         If posicion = 0 Then
             cadena = cadena & "SERVER=" & Servidor & Chr$(0)
         Else
             posicion2 = InStr(Servidor, ":")
             cadena2 = Left(Servidor, posicion2 - 1)
             cadena = cadena & "SERVER=" & cadena2 & Chr$(0)
             cadena2 = Left(Servidor, posicion - 1)
             cadena = cadena & "Address=" & Servidor & Chr$(0)
             cadena = cadena & "Network=DBMSSOCN" & Chr$(0)
         End If
        cadena = cadena & "DESCRIPTION=" & descripcion & Chr$(0)
        cadena = cadena & "DATABASE=" & basededatos & Chr$(0)
        cadena = cadena & "LANGUAGE=Spanish" & Chr$(0)
        If usuario <> "" Then
             cadena = cadena & "Trusted_Connection= No" & Chr$(0)
             cadena = cadena & "UID=" & usuario & Chr$(0)
             cadena = cadena & "PWD=" & clave & Chr$(0)
        Else
             cadena = cadena & "Trusted_Connection= Yes" & Chr$(0)
        End If

     'cadena de conexion para microsoft accesss
     Case "Microsoft Access Driver (*.mdb)"
         cadena = "DSN=" & dsn & Chr$(0)
         If InStr(Servidor, "mdw") = 0 Then
             cadena = cadena & "DBQ=" & basededatos & Chr$(0)
         Else
             cadena = cadena & "DBQ=" & basededatos & Chr$(0)
             cadena = cadena & "SYSTEMDB=" & Servidor & Chr$(0)
         End If

         If usuario <> "" Then
             cadena = cadena & "UID=" & usuario & Chr$(0)
             cadena = cadena & "PWD=" & clave & Chr$(0)
         End If

     'cadena de conexion para archivos de textos
     Case "Microsoft Text Driver (*.txt; *.csv)"
         cadena = "DSN=" & dsn & Chr$(0)
         cadena = cadena & "DBQ=" & basededatos & Chr$(0)
         cadena = cadena & "Extensions=asc,csv,tab,txt" & Chr$(0)
         If usuario <> "" Then
             cadena = cadena & "UID=" & usuario & Chr$(0)
             cadena = cadena & "PWD=" & clave & Chr$(0)
         End If
     'cadena de conexion odbc para archivos excel
     Case "Microsoft Excel Driver (*.xls)"
         cadena = "DSN=" & dsn & Chr$(0)
         cadena = "DriverId=790" & Chr$(0)
         cadena = cadena & "DBQ=" & basededatos & Chr$(0)
         cadena2 = Left(cadena, InStrRev(basededatos, "\") - 1)
         cadena = cadena & "DefaultDir=" & cadena2 & Chr$(0)
         If usuario <> "" Then
             cadena = cadena & "UID=" & usuario & Chr$(0)
             cadena = cadena & "PWD=" & clave & Chr$(0)
         End If

     'cadena de conexion odbc para  bases de datos dbase
     Case "Microsoft dBase Driver (*.dbf)"
         cadena = "DSN=" & dsn & Chr$(0)
         cadena = "DriverID=277" & Chr$(0)
         cadena = cadena & "DBQ=" & basededatos & Chr$(0)
         If usuario <> "" Then
             cadena = cadena & "UID=" & usuario & Chr$(0)
             cadena = cadena & "PWD=" & clave & Chr$(0)
         End If

     'cadena de conexion odbc para bases de datos paradox
     Case "Microsoft Paradox Driver (*.db )"
         cadena = "DSN=" & dsn & Chr$(0)
         cadena = "DriverID=538" & Chr$(0)
         cadena = cadena & "Fil=Paradox 5.X" & Chr$(0)
         cadena = cadena & "DefaultDir=" & basededatos & Chr$(0)
         cadena = cadena & "DBQ=" & basededatos & Chr$(0)
         cadena = cadena & "CollatingSequence=ASCII" & Chr$(0)
         If usuario <> "" Then
             cadena = cadena & "UID=" & usuario & Chr$(0)
             cadena = cadena & "PWD=" & clave & Chr$(0)
         End If

     'cadena de conexion odbc para visual foxpro y foxpro
     Case "Microsoft Visual FoxPro Driver", _
          "Microsoft FoxPro Driver (*.dbf)"
         cadena = "DSN=" & dsn & Chr$(0)
         If InStr(basededatos, "dbf") = 0 Then

            cadena = "SourceType=DBF" & Chr$(0)
            cadena = cadena & "SourceDB=" & basededatos & Chr$(0)
            cadena = cadena & "Exclusive=No" & Chr$(0)

         Else
             cadena = "SourceType=DBC" & Chr$(0)
             cadena = cadena & "SourceDB=" & basededatos & Chr$(0)
             cadena = cadena & "Exclusive=No" & Chr$(0)
         End If
         If usuario <> "" Then
             cadena = cadena & "UID=" & usuario & Chr$(0)
             cadena = cadena & "PWD=" & clave & Chr$(0)
         End If

     'cadena de conexion odbc para bases de datos oracle via microsoft u 
oracle
     Case "Microsoft ODBC for Oracle", _
          "Oracle ODBC Driver"
         cadena = "DSN=" & dsn & Chr$(0)
         If InStr(controlador, "Microsoft") Then
             cadena = "Server=" & Servidor & Chr$(0)
         End If
         If usuario <> "" Then
             cadena = cadena & "UID=" & usuario & Chr$(0)
             cadena = cadena & "PWD=" & clave & Chr$(0)
         End If

     'cadena de conexion odbc para mysql con controlador odbc 3.51
     Case "MySQL ODBC 3.51 Driver"
         cadena = "DSN=" & dsn & Chr$(0)
         posicion = InStr(Servidor, ";")
         If posicion = 0 Then
             cadena = cadena & "SERVER=" & Servidor & Chr$(0)
         Else
             cadena2 = Left(Servidor, posicion - 1)
             cadena = cadena & "SERVER=" & cadena2 & Chr$(0)
             posicion2 = Len(Servidor) - posicion
             cadena2 = Right(Servidor, posicion2)
             cadena = cadena & "PORT=" & cadena2 & Chr$(0)
         End If

         cadena = cadena & "DATABASE=" & basededatos & Chr$(0)
         If usuario <> "" Then
             cadena = cadena & "UID=" & usuario & Chr$(0)
             cadena = cadena & "PWD=" & clave & Chr$(0)
         End If
         cadena = cadena & "OPTION=3" & Chr$(0)

     'cadena de conexion odbc para bases en sistemas IBM AS/400
     Case "Client Access ODBC Driver (32-bit)"
         cadena = "DSN=" & dsn & Chr$(0)
         cadena = cadena & "System=" & Servidor & Chr$(0)
         If usuario <> "" Then
             cadena = cadena & "UID=" & usuario & Chr$(0)
             cadena = cadena & "PWD=" & clave & Chr$(0)
         End If

     'cadena de conexion odbc para sistemas Informix version 2.5
     Case "Informix-CLI 2.5 (32 Bit)"
         cadena = "DSN=" & dsn & Chr$(0)
         cadena = cadena & "SERVER=" & Servidor & Chr$(0)
         cadena = cadena & "DATABASE=" & basededatos & Chr$(0)
         If usuario <> "" Then
             cadena = cadena & "UID=" & usuario & Chr$(0)
             cadena = cadena & "PWD=" & clave & Chr$(0)
         End If

     'cadena de conexion odbc para sistemas Informix version 3.30
     Case "INFORMIX 3.30 32 BIT"
         cadena = "DSN=" & dsn & Chr$(0)
         tamano = Len(Servidor)
         posicion = InStr(Servidor, ";")
         cadena2 = Left(Servidor, posicion - 1)
         cadena2 = cadena2 & "HOST=" & cadena2 & Chr$(0)
         posicion = posicion + 1
         posicion2 = InStr(posicion, Servidor, ";")
         cadena2 = Mid(Servidor, posicion, _
                     posicion2 - posicion)
         cadena = cadena & "SERVER=" & cadena2 & Chr$(0)
         posicion = posicion2 + 1
         posicion2 = InStr(posicion, Servidor, ";")
         cadena2 = Mid(Servidor, posicion, _
                     posicion2 - posicion)
         cadena = cadena & "SERVICE=" & cadena2 & Chr$(0)
         posicion = posicion2
         cadena2 = Right(Servidor, tamano - posicion)
         cadena = cadena & "PROTOCOL=" & cadena2 & Chr$(0)
         cadena = cadena & "DATABASE=" & basededatos & Chr$(0)
         If usuario <> "" Then
             cadena = cadena & "UID=" & usuario & Chr$(0)
             cadena = cadena & "PWD=" & clave & Chr$(0)
         End If

     'cadena de conexion odbc para sistemas interbase de easysoft
     Case "Easysoft IB6 ODBC"
         cadena = "DSN=" & dsn & Chr$(0)
         cadena = cadena & "SERVER=" & Servidor & Chr$(0)
         cadena = cadena & "DATABASE=" & basededatos & Chr$(0)
         If usuario <> "" Then
             cadena = cadena & "UID=" & usuario & Chr$(0)
             cadena = cadena & "PWD=" & clave & Chr$(0)
         End If

     'cadenas de conexion odbc para  sistemas interbase de intersolv
     Case "INTERSOLV InterBase ODBC Driver (*.gdb)"
         cadena = "DSN=" & dsn & Chr$(0)
         cadena = cadena & "SERVER=" & Servidor & Chr$(0)
         cadena = cadena & "DATABASE=" & basededatos & Chr$(0)
         If usuario <> "" Then
             cadena = cadena & "UID=" & usuario & Chr$(0)
             cadena = cadena & "PWD=" & clave & Chr$(0)
         End If

     'cadena de conexion odbc para sistemas Lotus Notes version 3.01
     Case "Lotus NotesSQL 3.01 (32-bit) ODBC DRIVER (*.nsf)"
         cadena = "DSN=" & dsn & Chr$(0)
         cadena = cadena & "SERVER=" & Servidor & Chr$(0)
         cadena = cadena & "DATABASE=" & basededatos & Chr$(0)
         If usuario <> "" Then
             cadena = cadena & "UID=" & usuario & Chr$(0)
             cadena = cadena & "PWD=" & clave & Chr$(0)
         End If

     'Uso del controlador  Sybase System 12 (or 12.5) Enterprise Open 
Client ODBC Driver
     'Uso del controlador  Sybase System 11 ODBC Driver
     'Uso del controlador  Intersolv 3.10 Sybase ODBC Driver
     Case "SYBASE ASE ODBC Driver", _
         "SYBASE SYSTEM 11", _
         "INTERSOLV 3.10 32-BIT Sybase"
         cadena = "DSN=" & dsn & Chr$(0)
         cadena = cadena & "SRVR=" & Servidor & Chr$(0)
         If usuario <> "" Then
             cadena = cadena & "UID=" & usuario & Chr$(0)
             cadena = cadena & "PWD=" & clave & Chr$(0)
         End If

     'cadena para el controlador ODBC Driver for Sybase SQL Anywhere
     Case "Sybase SQL Anywhere 5.0"
         cadena = "DSN=" & dsn & Chr$(0)
         cadena = cadena & "DEFAULTDIR=" & Servidor & Chr$(0)
         cadena = cadena & "DBF=" & basededatos & Chr$(0)
         If usuario <> "" Then
             cadena = cadena & "UID=" & usuario & Chr$(0)
             cadena = cadena & "PWD=" & clave & Chr$(0)
         End If

     Case Else
         cadena = "DSN=" & dsn & Chr$(0)
         cadena = cadena & "SERVER=" & Servidor & Chr$(0)
         cadena = cadena & "DATABASE=" & basededatos & Chr$(0)
         If usuario <> "" Then
             cadena = cadena & "UID=" & usuario & Chr$(0)
             cadena = cadena & "PWD=" & clave & Chr$(0)
         End If
End Select
     AtributosCon = cadena
End Function


Pintamono escribi�:
> Que tal,
> 
> Tengo que crear dos DSN para una aplicacion externa, el problema es que no 
> he logrado hacerlo... he estado toda la ma�ana leyendo y revisando pero no 
> logro nada...
> 
> Lo hago de la siguiente manera:
> 
> En una clase defino estas constantes
> 
> private const string ODBC_INI_DSN_KEY_NAME = "DSN=";
> private const string ODBC_INI_FILE_PREFIX_NAME = "\0File Prefix=";
> private const string ODBC_INI_UID_NAME = "\0Uid=";
> private const string ODBC_INI_PWD_NAME = "\0pwd=";
> private const string ODBC_INI_DBQ_NAME = "\0DBQ=";
> private const string ODBC_INI_ACUODBC_DRIVER = "AcuODBC Driver"; //The 
> Default Driver
> private const string ODBC_INI_READONLY = "\0Read Only=";
> private const string ODBC_INI_SERVER = "\0SERVER=";
> private const string ODBC_INI_DNS_DESC ="\0DESCRIPTION=";
> 
> luego en un metodo le paso los parametros a utilizar
> 
> return SQLConfigDataSource((IntPtr)0, 4, OdbcDriverName,
> 		ODBC_INI_DSN_KEY_NAME + DSName +
> 		ODBC_INI_DNS_DESC + DSNDesc +
> 		ODBC_INI_SERVER + DSNServ +
> 		ODBC_INI_UID_NAME + DBUser +
> 		ODBC_INI_PWD_NAME + DBPass +
> 		ODBC_INI_DBQ_NAME + DBName +
> 		ODBC_INI_READONLY + "FALSE" + "\0");
> 
> esto siempre me devuelve false...
> 
> al importar del API lo hago asi
> 
> [DllImport("ODBCCP32.dll")]
> private static extern bool SQLConfigDataSource(IntPtr parent, int request, 
> string driver, string attributes);
> 
> Es indispensable que le pase un servidor, el nombre de usuario y 
> contrase�a ya que estos DSN apuntaran a distintos servidores...
> 
> Alguna idea de como hacer que funcione?
> 
> O alguna idea de como hacer traza de esto para saber en que falla?
> 
> Les agradecere cualquier ayuda que me permita terminar esto.
> 
> Saludos!
> 
> PD: tiene que ser DSN ya que la aplicacion externa esta desarrollada en 4D 
> y solo se puede conectar a SQL por DSN.
> 
> 
>