Sucede que, intentando que mi aplicación fuera portable entre Acces y SQL Server

Nececitaba que en alguna parte del sistema pudiera seleccionar que tipo de base de datos tenia y que se almacenara tal información para no tener que estar seleccionando a cada rato

La apariencia de esta miniaplicacion es la siguiente:

  

Nota: Debes agregar una referencia Microsoft SQLDMO Object Library

Veamos el Codigo:

''PROGRAMADOR: JUAN GABRIEL CASTILLO TURRUBIATES
'' MAIL: musikin@gmail.com
'' mail2: jgcastillo@uat.edu.mx
Imports System.Data.OleDb
Public Class frmConfig
    Inherits System.Windows.Forms.Form
    Dim SQLServer As SQLDMO.Application
    Dim lstSQL As SQLDMO.NameList   '' listar servidores SQL
    Dim mySQLServer As Object '' para listar los servidores SQL Server
    Dim lstDB As Object '' para listar las bases de datos

    Private Sub frmConfig_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        cbTipoDB.SelectedIndex = 0
    End Sub
    Private Sub ListaServer()
        '' este es el  procedimiento para cargar la lista de servidores
        If cbOrigenDB.Items.Count = 0 Then
            Dim I As Integer
            Dim SQLServer As New SQLDMO.Application()
            lstSQL = SQLServer.ListAvailableSQLServers
            mySQLServer = CreateObject("SQLDMO.SQLServer")
            cbOrigenDB.Items.Clear()
            For I = 1 To lstSQL.Count
                cbOrigenDB.Items.Add(lstSQL.Item(I))
            Next
        End If
    End Sub

    Private Sub btnBuscar_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
        ListaServer()
    End Sub

    Private Sub cbOrigenDB_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles cbOrigenDB.Click
        Try
            If cbTipoDB.Text = "SQL Server" Then
                ListaServer()
            Else
                cbOrigenDB.Items.Clear() ''limpiamos el combo de las bases de datos

            End If
        Catch ex As Exception
            MessageBox.Show(ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
        End Try
    End Sub


    Private Sub btnBuscar_Click_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnBuscar.Click
        Dim dlgBuscaDB As New OpenFileDialog()
        dlgBuscaDB.InitialDirectory = "c:\"
        dlgBuscaDB.Filter = "Bases de datos de acces (mdb)|*.mdb"
        dlgBuscaDB.FilterIndex = 2
        dlgBuscaDB.RestoreDirectory = True
        If dlgBuscaDB.ShowDialog() = DialogResult.OK Then
            cbOrigenDB.Text = dlgBuscaDB.FileName
        End If

    End Sub

    Private Sub cbTipoDB_SelectedIndexChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles cbTipoDB.SelectedIndexChanged
        ''Segun este seleccionado, Access o SQL Server 
        If cbTipoDB.Text = "Access" Then
            btnBuscar.Visible = True
            cbOrigenDB.Items.Clear()
            cbOrigenDB.Text = ""
            Me.Width = 272
        Else
            btnBuscar.Visible = False
            Me.Width = 248
        End If
    End Sub

    Private Sub btnCancelar_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnCancelar.Click
        End
    End Sub

    Private Sub ListaDB()
        If Not cbOrigenDB.Text = "" And Not txtUserName.Text = "" Then
            If Not fnCnnServer(cbOrigenDB.Text, txtUserName.Text, txtPass.Text) = False Then
                ''LISTAMOS LAS BASES DE DATOS DISPONIBLES
                cbDB.Items.Clear()
                For Each lstDB In mySQLServer.Databases
                    ' en esta parte nos aseguramos que todo este correcto,
                    '' y cargamos las bases de datos
                    If lstDB.Status <> 992 Or lstDB.Status <> 32768 Or lstDB.Status <> 32 Or lstDB.Status <> 512 _
                    Or lstDB.Status <> 192 Or lstDB.Status <> 256 Then
                        cbDB.Items.Add(lstDB.Name)
                    Else
                        MsgBox("Database: """ + lstDB.Name _
                          + " "" is can not be accessed at this time.", _
                          vbCritical, "Database Error")
                    End If
                Next
            Else
                ''BORRAMOS LA LISTA DE BASES DE DATOS DISPONIBLES
                cbDB.Items.Clear()
            End If
        End If
    End Sub
    Private Function fnCnnServer(ByVal prmServer As String, ByVal prmUserName As String, ByVal prmPass As String) As Boolean
        Try
            ''primero Conectamos
            mySQLServer.Disconnect()
            mySQLServer.Connect(ServerName:=prmServer, Login:=prmUserName, Password:=prmPass)
            Return True
        Catch
	    'Si ocurre un error, regresamos false
            Return False
        End Try
    End Function


    Private Sub cbDB_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles cbDB.Click
        ListaDB()
    End Sub

    Private Sub btnAceptar_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnAceptar.Click
        If fnTestCnn(cbTipoDB.Text) = True Then
            End
        End If
    End Sub
    Private Function fnTestCnn(ByVal prmTipoDB As String) As Boolean
        Try
            Dim cnnStr As String
            If prmTipoDB = "Access" Then
                ''probamos la conexion Acess
                cnnStr = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                        "Data Source='" & cbOrigenDB.Text & "';" & _
                        "Persist Security Info=False"
                Dim cnn As New OleDbConnection(cnnStr)
                cnn.Open()
                If cnn.State = 1 Then
                    '' aqui grabamos ini
                    EscribeIni("c:\FileIni.ini", "Config", "Proveedor", "Microsoft.Jet.OLEDB.4.0")
                    EscribeIni("c:\FileIni.ini", "Config", "Origen", cbOrigenDB.Text)
                End If
                Return True
                cnn.Close()
                cnn.Dispose()
                Exit Function
            Else
                ''probamos la conexion SQL SERVER
                cnnStr = "Provider=SQLOLEDB.1;" & _
                        "Data Source='" & cbOrigenDB.Text & "';" & _
                        "Initial Catalog='" & cbDB.Text & "';" & _
                        "User ID='" & txtUserName.Text & "';" & _
                        "Password='" & txtPass.Text & "';" & _
                        "Persist Security Info=True"
                Dim cnn As New OleDbConnection(cnnStr)
                cnn.Open()
                If cnn.State = 1 Then
                    '' aqui grabamos ini
                    EscribeIni("c:\FileIni.ini", "Config", "Proveedor", "SQLOLEDB.1")
                    EscribeIni("c:\FileIni.ini", "Config", "Origen", cbOrigenDB.Text)
                    EscribeIni("c:\FileIni.ini", "Config", "Usuario", txtUserName.Text)
                    ''aqui puedes usar algun metodo para encriptar el pass
                    EscribeIni("c:\FileIni.ini", "Config", "Pass", txtPass.Text)
                End If
                Return True
                cnn.Close()
                cnn.Dispose()
                Exit Function
            End If

        Catch
            Return False
        End Try
    End Function
End Class

Esto va en un modulo:

''obtenido de: http://www.elguille.info/NET/dotnet/inisNET.htm


Module modINI
    ''para leer ini
    Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
    ''para escibir ini
    Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lpFileName As String) As Integer

    Public Function LeeIni(ByVal sFileName As String, ByVal sSection As String, ByVal sKeyName As String, Optional ByVal sDefault As String = "") As String
        '--------------------------------------------------------------------------
        ' Devuelve el valor de una clave de un fichero INI
        ' Los parámetros son:
        '   sFileName   El fichero INI
        '   sSection    La sección de la que se quiere leer
        '   sKeyName    Clave
        '   sDefault    Valor opcional que devolverá si no se encuentra la clave
        '--------------------------------------------------------------------------
        Dim ret As Integer
        Dim sRetVal As String
        '
        sRetVal = New String(Chr(0), 255)
        '
        ret = GetPrivateProfileString(sSection, sKeyName, sDefault, sRetVal, Len(sRetVal), sFileName)
        If ret = 0 Then
            Return sDefault
        Else
            Return Left(sRetVal, ret)
        End If
    End Function
    Public Sub EscribeIni(ByVal sFileName As String, ByVal sSection As String, ByVal sKeyName As String, ByVal sValue As String)
        '--------------------------------------------------------------------------
        ' Guarda los datos de configuración
        ' Los parámetros son los mismos que en LeerIni
        ' Siendo sValue el valor a guardar
        Call WritePrivateProfileString(sSection, sKeyName, sValue, sFileName)
    End Sub

End Module

Fichero con el código de ejemplo: TheKin_proConfigDB.zip - 12 KB