Création clé registre - Mise à jour d'un traitement

**Manhexter** · 26/08/2013, 17h13

Bonjour à tous.

Je viens vers vous car je me retrouve à devoir mettre à jour un traitement et pour l'instant, je dois bien dire que je fais choux blanc

.
Pour commencer, voici le contexte. Le traitement que je dois modifier réalise la création de lien ODBC système par le biais de création de clé registres. Le traitement tourne actuellement sur des configurations Windows XP / Office 2003.
On m'a demandé de tester / adapter les traitements aux nouvelles configurations à venir qui sont sur Windows 7 / Office 2010.

Je vous donne le code actuel :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
Option Compare Database
 
Option Explicit
 
'*=============================================================
' Constantes pour création et utilisation registre
'*=============================================================
 
    Private Const REG_SZ = 1    'Constant for a string variable type.
 
    Private Const HKEY_LOCAL_MACHINE = &H80000002
    '*****************************************************************************************
    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
 
'*=============================================================
' Constantes pour suppression dsn
'*=============================================================
Const ODBC_ADD_SYS_DSN = 4       'Add data source
Const ODBC_CONFIG_SYS_DSN = 5    'Configure (edit) data source
Const ODBC_REMOVE_SYS_DSN = 6    'Remove data source
Private Const vbAPINull As Long = 0
 
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
 
 
 
 
Public Sub DSN_SQLServer(Nomdsn As String, NomDatabase As String, DescriptionODBC As String, Login As String, NomServeur As String, PathNameDriver As String, TypeDriver As String, Optional PassWord As String)
 
 
    Dim lResult As Long
    Dim hKeyHandle As Long
 
 
    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
 
 
   'Specify the DSN parameters.
 
   DataSourceName = Nomdsn
   DatabaseName = NomDatabase
   Description = DescriptionODBC
   DriverPath = PathNameDriver
   LastUser = Login
   Server = NomServeur
   DriverName = TypeDriver
 
   '********* Pour la clé SOFTWARE\ODBC\ODBC.INI\
 
   lResult = RegCreateKey(HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBC.INI\" & _
        DataSourceName, hKeyHandle)
 
   'On file sur les donnees du DSN
 
   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 LastUser, Len(LastUser))
   lResult = RegSetValueEx(hKeyHandle, "Server", 0&, REG_SZ, _
      ByVal Server, Len(Server))
 
   'fermeture clé.
 
   lResult = RegCloseKey(hKeyHandle)
 
  '********* Pour la clé SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources
  'Si tu mets pas tu vois pas dans le panel control
 
 
  lResult = RegCreateKey(HKEY_LOCAL_MACHINE, _
      "SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources", hKeyHandle)
   lResult = RegSetValueEx(hKeyHandle, DataSourceName, 0&, REG_SZ, _
      ByVal DriverName, Len(DriverName))
 
   lResult = RegCloseKey(hKeyHandle)
 
End Sub

Après recherche, j'ai cru comprendre que la fonction RegCreateKey ne serait pas compatible avec windows 7. Le chemin sous lequel doivent être créées les clés sont également à modifier.
Voici le nouveau code après mise à jour du chemin dans le registre et utilisation de la fonction RegCreateKeyEx.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
Option Compare Database
 
Option Explicit
 
'*=============================================================
' Constantes pour création et utilisation registre
'*=============================================================
 
    Private Const REG_SZ = 1    'Constant for a string variable type.
 
    Const STANDARD_RIGHTS_ALL = &H1F0000
    Const SYNCHRONIZE = &H100000
    Const READ_CONTROL = &H20000
    Const STANDARD_RIGHTS_READ = (READ_CONTROL)
    Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
    Const KEY_CREATE_LINK = &H20
    Const KEY_CREATE_SUB_KEY = &H4
    Const KEY_ENUMERATE_SUB_KEYS = &H8
    Const KEY_NOTIFY = &H10
    Const KEY_QUERY_VALUE = &H1
    Const KEY_SET_VALUE = &H2
    Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or _
    KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
    Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or _
    KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
    Const KEY_EXECUTE = (KEY_READ)
    Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or _
    KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or _
    KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
 
    '~~> Other Constants for RegCreateKeyEx
    Const REG_OPTION_BACKUP_RESTORE = 4   '<~~ open for backup or restore
    Const REG_OPTION_VOLATILE = 1         '<~~ Key isn't preserved if system is rebooted
    Const REG_OPTION_NON_VOLATILE = 0     '<~~ Key is preserved if system is rebooted
 
    Private Const HKEY_LOCAL_MACHINE = &H80000002
    Private Const HKEY_CURRENT_USER = &H80000001
    '*****************************************************************************************
    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
 
  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, ByVal lpSecurityAttributes _
   As Long, phkResult As Long, lpdwDisposition As Long) As Long
 
    Private Declare Function RegCloseKey Lib "advapi32.dll" _
       (ByVal hKey As Long) As Long
 
'*=============================================================
' Constantes pour suppression dsn
'*=============================================================
Const ODBC_ADD_SYS_DSN = 4       'Add data source
Const ODBC_CONFIG_SYS_DSN = 5    'Configure (edit) data source
Const ODBC_REMOVE_SYS_DSN = 6    'Remove data source
Private Const vbAPINull As Long = 0
 
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
 
 
 
 
Public Sub DSN_SQLServer(Nomdsn As String, NomDatabase As String, DescriptionODBC As String, Login As String, NomServeur As String, PathNameDriver As String, TypeDriver As String, Optional PassWord As String)
 
 
    Dim lResult As Long
    Dim hKeyHandle As Long
    Dim ret As Long
 
 
    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
 
 
   'Specify the DSN parameters.
 
   DataSourceName = Nomdsn
   DatabaseName = NomDatabase
   Description = DescriptionODBC
   DriverPath = PathNameDriver
   LastUser = Login
   Server = NomServeur
   DriverName = TypeDriver
 
   '********* Pour la clé SOFTWARE\ODBC\ODBC.INI\
 
   'lResult = RegCreateKey(HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBC.INI\" & _
   '     DataSourceName, hKeyHandle)
 
    lResult = RegCreateKeyEx(HKEY_LOCAL_MACHINE, "SOFTWARE\Wow6432Node\ODBC\ODBC.INI\" & DataSourceName, 0, REG_SZ, _
            REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, ByVal 0&, lResult, hKeyHandle)
 
   'On file sur les donnees du DSN
 
   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 LastUser, Len(LastUser))
   lResult = RegSetValueEx(hKeyHandle, "Server", 0&, REG_SZ, _
      ByVal Server, Len(Server))
 
   'fermeture clé.
 
   lResult = RegCloseKey(hKeyHandle)
 
  '********* Pour la clé SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources
  'Si tu mets pas tu vois pas dans le panel control
 
 
  lResult = RegCreateKey(HKEY_CURRENT_USER, _
      "SOFTWARE\Wow6432Node\ODBC\ODBC.INI\ODBC Data Sources", hKeyHandle)
   lResult = RegSetValueEx(hKeyHandle, DataSourceName, 0&, REG_SZ, _
      ByVal DriverName, Len(DriverName))
 
   lResult = RegCloseKey(hKeyHandle)
 
End Sub

Vous l'aurez compris, le code ne fonctionne pas (sinon je viendrais pas vous embêtez hein

). J'ai un code erreur 5 lors de la tentative de création de la clé. J'ai tenté de mettre tous les droits dans le registre à l'emplacement désiré mais le résultat reste le même.
Pour complément d'info, je suis avec un compte Windows appartenant au groupe Administrateur (mais ce n'est pas le compte Admin du poste). L'application devant être utilisé par tout mon service, le DSI est totalement opposé au fait de passer par le compte Administrateur.

Si quelqu'un a une solution à mon problème je suis grandement preneur.

Par avance merci.

Manhexter

**Manhexter** · 27/08/2013, 11h38

Bonjour à tous,

J'ai finalement trouvé une solution à mon problème. Je la partage avec vous au cas où cela puisse servir à quelqu'un.
Il y avait plusieurs points à reprendre. Dans un premier temps, il semble qu'il ne soit pas autorisé de créer des clés dans le HKLM avec une application sans être avec le compte Administrateur. Je me suis donc rabattu sur le HKCU (HK_CURRENT_USER) ce qui revient au même dans l'utilisation que j'en fait puisque les clés sont créées en début de traitement et supprimées à la fin de l'exécution.
Dans le HKCU, aucun problème pour créer la clé mais j'ai bloqué pour créer les valeurs. La fonction RegSetValueEx me renvoyant chaque fois des codes erreur. Pour créer les valeurs j'ai été obligé d'ajouter la fonction RegOpenKeyEx avant la création. D'après les documentations il semblait pourtant que RegCreateKeyEx procédait également à l'ouverture de la clé surtout si celle-ci était déjà existante.

Je vous mets à disposition le code avec les déclarations des constantes et des fonctions ainsi que la procédure avec laquelle j'ai fait mes différents tests.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
Option Compare Database
 
    'Définition des constantes pour les racines du registrre
    Const HKEY_CLASSES_ROOT = &H80000000
    Const HKEY_CURRENT_USER = &H80000001
    Const HKEY_LOCAL_MACHINE = &H80000002
    Const HKEY_USERS = &H80000003
 
    '~~> Other Constants for RegCreateKeyEx
    Const REG_OPTION_BACKUP_RESTORE = 4   '<~~ open for backup or restore
    Const REG_OPTION_VOLATILE = 1         '<~~ Key isn't preserved if system is rebooted
    Const REG_OPTION_NON_VOLATILE = 0     '<~~ Key is preserved if system is rebooted
 
    Public Const REG_SZ As Long = 1    'Constant for a string variable type.
    Public Const REG_DWORD As Long = 4 'Constant for a long variable type
 
    'Liste des constantes pour les codes retour des fonctions
    Public Const ERROR_NONE = 0
    Public Const ERROR_BADDB = 1
    Public Const ERROR_BADKEY = 2
    Public Const ERROR_CANTOPEN = 3
    Public Const ERROR_CANTREAD = 4
    Public Const ERROR_CANTWRITE = 5
    Public Const ERROR_OUTOFMEMORY = 6
    Public Const ERROR_ARENA_TRASHED = 7
    Public Const ERROR_ACCESS_DENIED = 8
    Public Const ERROR_INVALID_PARAMETERS = 87
    Public Const ERROR_NO_MORE_ITEMS = 259
 
    'Définition des constantes pour les droits d'accès lors de la création ou l'ouverture d'une clé
    Const STANDARD_RIGHTS_ALL = &H1F0000
    Const SYNCHRONIZE = &H100000
    Const READ_CONTROL = &H20000
    Const STANDARD_RIGHTS_READ = (READ_CONTROL)
    Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
    Const KEY_CREATE_LINK = &H20
    Const KEY_CREATE_SUB_KEY = &H4
    Const KEY_ENUMERATE_SUB_KEYS = &H8
    Const KEY_NOTIFY = &H10
    Const KEY_QUERY_VALUE = &H1
    Const KEY_SET_VALUE = &H2
    Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or _
    KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
    Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or _
    KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
    Const KEY_EXECUTE = (KEY_READ)
    Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or _
    KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or _
    KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
 
    '~~> The RegCloseKey function releases the handle of the specified key.
    'Liste des paramètres :
    '           -> hKey : Identifie la clé concernée par la fonction
    Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
 
    '~~> The RegDeleteKey function deletes the specified key
    'Liste des paramètres :
    '           -> hKey : Identifie la clé à supprimer
    '           -> lpSubKey : Identifie la sous-clé à supprimer
    Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" _
    (ByVal hKey As Long, ByVal lpSubKey As String) As Long
 
    '~~> The RegCreateKeyEx function creates the specified key. If the key already exists
    'in the registry, the function opens it.
    'Liste des paramètres :
    '           -> hKey : Identifie la racine du registre à laquelle appartient la clé à créer
    '           -> lpSubKey : Nom complet (hors racine) de la clé à créer
    '           -> Reserved : paramètre réservé à mettre à 0
    '           -> lpClass : défini le type de clé (le plus souvent = REG_SZ ou REG_DWORD
    '           -> dwOptions : défini si la clé est volatile ou non
    '           -> samDesired : défini les droits d'accès à la clé
    '           -> lpSecurityAttributes : à renseigner par ByVal 0&
    '           -> phkResult : Variable dans laquelle renvoyé le code résultat de la fonction
    '           -> lpdwDisposition : Variable vers laquelle est renvoyée l'identification de la clé créée
    Private 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 Any, phkResult As Long, lpdwDisposition As Long) As Long
 
    '~~> The RegOpenKeyEx function opens the specified key.
    'Liste des paramètres :
    '           -> hKey : Identifie la racine du registre à laquelle appartient la clé à créer
    '           -> lpSubKey : Nom complet (hors racine) de la clé à créer
    '           -> Reserved : paramètre réservé à mettre à 0
    '           -> samDesired : défini les droits d'accès à la clé
    '           -> phkResult : Variable dans laquelle renvoyé le code résultat de la fonction
    Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _
    (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal _
    samDesired As Long, phkResult As Long) As Long
 
    'La fonction RegSetValueEx permet de définir les valeurs pour une clé
    'Liste des paramètres :
    '           -> hKey : Identifie la racine du registre à laquelle appartient la clé à créer
    '           -> lpValueName : Nom de la valeur à créer
    '           -> Reserved : paramètre réservé à mettre à 0
    '           -> dwType : Type de la valeur à créer (le plus souvent REG_SZ ou REG_DWORD)
    '           -> lpData : Valeur à créer
    '           -> cbData : Nombre de caractère de la valeur
     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 Sub test()
 
    Dim Result As Long
    Dim hKeyHandle As Long
 
    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
 
 
    'Specify the DSN parameters.
 
    DataSourceName = "DBTEST"
    DatabaseName = "DBTEST"
    Description = "Test Registre"
    DriverPath = "Driver"
    LastUser = "Login"
    Server = "Server"
    DriverName = "Driver"
 
 
     'Création de la clé
     Result = RegCreateKeyEx(HKEY_CURRENT_USER, "Software\ODBC\ODBC.INI\DBTEST", 0, REG_SZ, _
     REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, ByVal 0&, Result, hKeyHandle)
 
    ' Ouverture de la clé
    ' Sans le RegOpenKeyEx, la fonction RegSetValueEx renvoie un code erreur :
    '   -> 6 dans la cas où la clé existait déjà lors de l'exécution du RegCreateKeyEx
    '   -> 1775 dans le cas où la clé vient d'être créée par l'exécution du RegCreateKeyEx
    Result = RegOpenKeyEx(HKEY_CURRENT_USER, "Software\ODBC\ODBC.INI\DBTEST", 0, KEY_ALL_ACCESS, hKeyHandle)
 
    'Créations des valeurs associées à la clé
    Result = RegSetValueEx(hKeyHandle, "Database", 0&, REG_SZ, _
       ByVal DatabaseName, Len(DatabaseName))
    Result = RegSetValueEx(hKeyHandle, "Description", 0&, REG_SZ, _
        ByVal Description, Len(Description))
    Result = RegSetValueEx(hKeyHandle, "Driver", 0&, REG_SZ, _
        ByVal DriverPath, Len(DriverPath))
    Result = RegSetValueEx(hKeyHandle, "LastUser", 0&, REG_SZ, _
        ByVal LastUser, Len(LastUser))
    Result = RegSetValueEx(hKeyHandle, "Server", 0&, REG_SZ, _
        ByVal Server, Len(Server))
 
 
    'Suppression de la clé
    RegDeleteKey hKeyHandle, ""
 
    'Fermeture de la clé
    RegCloseKey hKeyHandle
 
End Sub

Merci encore à ceux qui se sont penchés sur mon problème.

Cordialement,

Manhexter

Création clé registre - Mise à jour d'un traitement [AC-2010]

VBA Access

Discussions similaires

Partager

Partager