CRÉER UN DSN(OPEN DATABASE CONNECTIVITY) POUR MYSQL PAR LE CODE

---

Commentaire sur cette source (6)
Ajouter un commentaire et/ou une note

Cet exemple est dérivé de l'article paru ici :
http://support.microsoft.com/default.aspx?scid=KB;EN-US;q184608&,
Qui explique comment créer un DSN pour sql Server.

En utilisant les drivers MyODBC : http://www.mysql.com/downloads/api-myodbc-2.50.html,
on peut faire la même chose avec un serveur sous mySQL...

amusez vous bien !! A+

Option Explicit

    Private Const REG_SZ = 1    'Constant for a string variable type.
                                'elle est bonne !!!
                                
    Private Const HKEY_LOCAL_MACHINE = &H80000002
    
    
    Private Declare Function GetSystemDirectoryA _
    Lib "kernel32" _
        (ByVal lpBuffer As String, _
        ByVal nSize As Long) As Long
    '----
    Private Declare Function RegCreateKey _
    Lib "advapi32.dll" Alias "RegCreateKeyA" _
        (ByVal hKey As Long, _
        ByVal lpSubKey As String, _
        phkResult 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
    '----
    Private Declare Function RegCloseKey _
    Lib "advapi32.dll" _
       (ByVal hKey As Long) As Long
    '----
Private Sub cmdCreate_Click()

   Dim sDataSourceName As String, sDatabaseName As String
   Dim sDescription As String, sDriverPath As String, sDriverName As String
   Dim sLastUser As String, sRegional As String, sServer As String

   Dim lResult As Long
   Dim hKeyHandle As Long

   'Permet de spécifier les paramêtres du DSN.
   
   sDataSourceName = txtData(0).Text
   sDatabaseName = txtData(1).Text
   sDescription = txtData(2).Text
   sDriverPath = GetSystemDirectory
   sLastUser = txtData(3).Text
   sServer = txtData(4).Text
   sDriverName = "MySQL"

   'Create the new DSN key.

   lResult = RegCreateKey(HKEY_LOCAL_MACHINE, _
                "SOFTWARE\ODBC\ODBC.INI\" & _
                sDataSourceName, hKeyHandle)

   'défini les valeurs de la nouvelle clé DSN.

   lResult = RegSetValueEx(hKeyHandle, _
            "Database", 0&, REG_SZ, _
      ByVal sDatabaseName, Len(sDatabaseName))
   
   lResult = RegSetValueEx(hKeyHandle, _
            "Description", 0&, REG_SZ, _
      ByVal sDescription, Len(sDescription))
   
   lResult = RegSetValueEx(hKeyHandle, _
                "Driver", 0&, REG_SZ, _
      ByVal sDriverPath, Len(sDriverPath))
   
   lResult = RegSetValueEx(hKeyHandle, _
            "LastUser", 0&, REG_SZ, _
      ByVal sLastUser, Len(sLastUser))
   
   lResult = RegSetValueEx(hKeyHandle, _
            "sServer", 0&, REG_SZ, _
            ByVal sServer, Len(sServer))

   'Ferme la nouvelle clé du DSN.

   lResult = RegCloseKey(hKeyHandle)

   'ouvre la clé de donné source ODBC
   'Pour le mettre dans la liste du DSN manager.
   'spécifie la nouvelle valeur.
   'ferme la clé.

   lResult = RegCreateKey(HKEY_LOCAL_MACHINE, _
      "SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources", _
      hKeyHandle)
   
   lResult = RegSetValueEx(hKeyHandle, _
   sDataSourceName, 0&, REG_SZ, _
      ByVal sDriverName, Len(sDriverName))
   
   lResult = RegCloseKey(hKeyHandle)
End Sub

Private Function GetSystemDirectory() As String
    Dim s As String, i As Integer
    i = GetSystemDirectoryA("", 0)
    s = Space(i)
    GetSystemDirectoryA s, i
    s = Left$(s, i - 1)
    
    ' si pas de backslash...
    If Len(s) > 0 Then
        If Right$(s, 1) <> "\" Then
        GetSystemDirectory = s + "\"
        Else
            GetSystemDirectory = s
        End If
    Else
        GetSystemDirectory = "\"
    End If
End Function

 

Je suis près à développer le sujet si ça interesse qq :)

Pour les "Membres Club", vous pouvez télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip

• UN DATASET SOUS VB6
• MASQUE DE SAISIE DATE QUI AFFICHE LE MASQUE.
• MACROS EXCEL POUR LES FICHIERS CSV
• TEMPS PENDANT LEQUEL L'ORDINATEUR EST ALLUMÉ.
• FONCTION REPLACE POUR ACCESS 97 AUSSI PERFORMANTE QUE REPLACE DE VB

• OUVERTURE D'UNE TABLE VOLUMINEUSE EN DOTNET
• LISTER LES NOMS DES INSTANCES SQL SERVER.
• AGENDA MEDICAL
• OPEN ACCESS MDB
• REPERTOIRE TEL