Créer une dsn odbc (vba/vb6)

3/5 (10 avis)

Snippet vu 28 520 fois - Téléchargée 31 fois

Commenter

Contenu du snippet

Plutôt que de passer par le gestionnaire des sources de données (ODBC Data Sources Administrator) pour créer une nouvelle DSN, voilà une fonction qui permet de le faire par le biais d'un code.

Cette fonction est écrite pour être utilisée en VBA/VB6 (utilisation de déclarations API) . J'ai posté une autre source pour VBScript.

Exemple:
--------
Function SetDSN()
Call Set_ODBC_DSN(True, "NomDeLaDsn", "NomDeLaBaseDeDonnées", "", "SQLSRV32.dll", "SQL Server", "NomDuServeur")
End Function

UserDSN prend la valeur TRUE pour créer une DSN utilisateur, et FALSE pour une DSN système.

Source / Exemple : 


Private Const REG_SZ = 1
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_CURRENT_USER = &H80000001
Private Const REG_ODBCINI       As String = "SOFTWARE\ODBC\ODBC.INI\"
Private Const REG_ODBCINI_DS    As String = "SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources"
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 RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (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 Set_ODBC_DSN(UserDSN As Boolean, _
                 DataSourceName As String, DatabaseName As String, _
                 Description As String, DriverPath As String, _
                 DriverName As String, Server As String)
    Dim lResult    As Long
    Dim hKeyHandle As Long
    Dim HKEY_XX    As Long
    HKEY_XX = IIf(UserDSN, HKEY_CURRENT_USER, HKEY_LOCAL_MACHINE)
    'Création d'une nuvelle clé dans la base de registre.
    lResult = RegCreateKey(HKEY_XX, REG_ODBCINI & DataSourceName, hKeyHandle)
    'Valeurs de la clé.
    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, "Driver", 0&, REG_SZ, ByVal DriverPath, Len(DriverPath))
    lResult = RegSetValueEx(hKeyHandle, "LastUser", 0&, REG_SZ, ByVal "user", Len("user"))
    lResult = RegSetValueEx(hKeyHandle, "Server", 0&, REG_SZ, ByVal Server, Len(Server))
    'On ferme la clé.
    lResult = RegCloseKey(hKeyHandle)
    'On ouvre la clé "ODBC Data Sources" qui gères les entrées affichées dans le gestionnaire ODBC.
    'On ajoute une valeur.
    'On ferme la clé.
    lResult = RegCreateKey(HKEY_XX, REG_ODBCINI_DS, hKeyHandle)
    lResult = RegSetValueEx(hKeyHandle, DataSourceName, 0&, REG_SZ, ByVal DriverName, Len(DriverName))
    lResult = RegCloseKey(hKeyHandle)
End Sub

Conclusion :


Attention: ce code écrit dans votre base de registre.

A voir également

Ajouter un commentaire Commentaires
exterminatix Messages postés 10 Date d'inscription jeudi 15 janvier 2004 Statut Membre Dernière intervention 4 novembre 2010
20 janv. 2006 à 14:29
C'est bien et un peu lourd. On peut faire comme le code suivant. Mais le probleme c'est comment fait-on pour saisir le mot de passe ?

Sub Set_ODBC_DSN(UserDSN , DataSourceName , DatabaseName , Description, DriverPath ,DriverName ,Server )

Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
localisation = "HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBC.INI"
if (UserDSN) then localisation = "HKEY_CURRENT_USER\SOFTWARE\ODBC\ODBC.INI"
'restauration odbc
WshShell.RegWrite localisation & "ODBC Data Sources" & DataSourceName,DriverName
WshShell.RegWrite localisation & DataSourceName & "\Driver",DriverPath
WshShell.RegWrite localisation & DataSourceName & "\Server",Server
WshShell.RegWrite localisation & DataSourceName & "\Description",Description
WshShell.RegWrite localisation & DataSourceName & "\Database",DatabaseName
WshShell.RegWrite localisation & DataSourceName & "\LastUser","user"
end sub
philheiz Messages postés 117 Date d'inscription mercredi 3 décembre 2003 Statut Membre Dernière intervention 11 octobre 2007 1
21 janv. 2006 à 17:00
pour autant que je saches, tu ne peux pas enregistrer le mot de passe dans la définition.

pour ce qui est de la 'lourdeur', tu ne peux pas comparer la méthode utilisant l'API (qui à mon sens est plus propre) à celle qui se sert de l'objet Script.

ce que tu proposes est bien pour un scripte vbs, mais pas dans une appli compilée: une fois sur deux Norton ou d'autres anti-virus réajissent à la commande RegWrite et la bloquent.
exterminatix Messages postés 10 Date d'inscription jeudi 15 janvier 2004 Statut Membre Dernière intervention 4 novembre 2010
3 févr. 2006 à 12:27
Bonjour je tiens à m'excuser au sujet de ma remarque pour deux raisons :

1) Mon code me parait plus léger, mais c'est vrai que certain anti-virus le bloque.(Merci pour le renseignement), par contre il peut fonctionner dans un vb compilé (à condition de se mettre en explicit off)

2) C'est vrai que l'on n'enregistre pas le mot de passe dans le dsn. (On peut le renter en saisie manuel juste pour le test) Je n'aurais jamais du faire cette erreur car j'utilise depuis de nombreuses années des odbc et je sais très bien que l'on passe toujours le mot de passe en paramètres lorsqu'on l'appelle.

Cordialement votre.
FENETRES Messages postés 196 Date d'inscription jeudi 15 juillet 2004 Statut Membre Dernière intervention 14 avril 2009
10 avril 2006 à 17:31
Code tout à fait correct mais fonctionnellemnt incomplet.

Au minimum, il faudrait vérifier l'existence du pilote SQL et éventuellement sa version sur le poste client.

Exemple pour SQL Server :

'Pilote SQL Server
If RegOpenKeyEx(HKEY_LOCAL_MACHINE, "Software\ODBC\ODBCINST.INI\SQL server", 0, KEY_ALL_ACCESS, hKey) = 0 Then
regValue = String$(1024, 0)
If RegQueryValueEx(hKey, "Driver", 0, valueType, regValue, Len(regValue)) = 0 Then
If valueType = REG_SZ Then
'Récupère l'emplacement de la dll
RegVal(0) = Left$(regValue, InStr(regValue, vbNullChar) - 1)
'Récupère le n° de version du pilote SQL Server
RegVal(0) = GetFileVersion(RegVal(0))
End If
End If
RegCloseKey hKey
End If
FENETRES Messages postés 196 Date d'inscription jeudi 15 juillet 2004 Statut Membre Dernière intervention 14 avril 2009
11 avril 2006 à 11:45
Aide et support Microsoft, voir "Comment créer et supprimer un DSN en Visual Basic" à l'adresse ci-dessous :
http://support.microsoft.com/kb/171146/EN-US/
S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (philheiz)