[AC-2007] Recuperer la version du pilote ODBC MySQL [Résolu]

[jj4822]

Bonjour.

J'aimerai detecter la version du pilote MYSQL installee sur l'ordinateur sur lequel est execute le fichier Access.

Je sais que dans la base de registre se trouvent les differentes informations sur les pilotes ODBC. Plus precisement sous Hkey_local_machine/software/ODBC/ODBCINST.INI/.

Le probleme, c'est qu'il y a tres peu de detail. Pour Mysql, il est indique les differents chemins comme "C:\Program Files\MySQL\Connector ODBC 5.1\myodbc5.dll".
Comme ce sont des fichiers dll je ne sais pas comment verifier si je peux y recuperer l'info desiree. De plus je ne sais pas si l'info y est contenue.

J'aimerai detecter si la version du pilote ODBC pour Mysql est la 5.1.8 (ou superieure) et non une precedente.

Comment peut on faire ?

J'ai cherche sur internet et n'ai trouve que les differentes manieres de se connecter par ODBC, de creer une liaision ODBC. Mais pas comment retrouver la version du pilote.

Sur internet, sur http://allapi.mentalis.org, j'ai trouve quelque chose comme ce qui est ci-dessous :

Code :

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
 
 
Const REG_SZ = 1 ' Unicode nul terminated string
Const REG_BINARY = 3 ' Free form binary
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000001
 
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey 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 RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) 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 RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData 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
 
 
Function RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String) As String
    Dim lResult As Long, lValueType As Long, strBuf As String, lDataBufSize As Long
    'retrieve information about the key
    lResult = RegQueryValueEx(hKey, strValueName, 0, lValueType, ByVal 0, lDataBufSize)
    If lResult = 0 Then
        If lValueType = REG_SZ Then
            'Create a buffer
            strBuf = String(lDataBufSize, Chr$(0))
            'retrieve the key's content
            lResult = RegQueryValueEx(hKey, strValueName, 0, 0, ByVal strBuf, lDataBufSize)
            If lResult = 0 Then
                'Remove the unnecessary chr$(0)'s
                RegQueryStringValue = Left$(strBuf, InStr(1, strBuf, Chr$(0)) - 1)
            End If
        ElseIf lValueType = REG_BINARY Then
            Dim strData As Integer
            'retrieve the key's value
            lResult = RegQueryValueEx(hKey, strValueName, 0, 0, strData, lDataBufSize)
            If lResult = 0 Then
                RegQueryStringValue = strData
            End If
        End If
    End If
End Function
 
Function GetString(hKey As Long, strPath As String, strValue As String)
    Dim Ret
    'Open the key
    RegOpenKey hKey, strPath, Ret
    'Get the key's content
    GetString = RegQueryStringValue(Ret, strValue)
    'Close the key
    RegCloseKey Ret
End Function
 
Sub Lancement()
'Ce que j'ai copie et modifie
Dim Ret As String
 
    Ret = GetString(HKEY_LOCAL_MACHINE, "/SOFTWARE/ODBC/ODBCINST.INI/MYSQL ODBC 5.1 Driver/", "DWORD")
    'If Ret = "" Then MsgBox "No value found !", vbExclamation + vbOKOnly, App.Title: Exit Sub
    MsgBox "The value is " & Ret
 
exit sub
 
'ce que j'ai trouve sur internet ci dessous
 
'Get a string from the registry
 
    Ret = GetString(HKEY_CURRENT_USER, "KPD-Team", "BinaryValue")
    If Ret = "" Then MsgBox "No value found !", vbExclamation + vbOKOnly, App.Title: Exit Sub
    MsgBox "The value is " + Ret
 
 
end sub

Probleme : lorsque je lance le module Lancement, un message m'affiche "The value is " et rien d'autre. Il n'a donc rien trouve.

Ceci-dit, ce programme a pour but de recuperer la liste des pilotes ODBC mais je ne suis pas sur que je puisse recuperer l'info sur la version d'un pilote precis.

Y a t il un autre moyen ou ce moyen permettrait il de recuperer la version du pilote ODBC MySQL installe sur l'ordinateur ?

Merci.
Cdlt.

[LedZeppII]

Bonsoir,

Je crois avoir trouvé un autre moyen.

• Récupérer le nom du pilote tel qu'il est enregistré dans la base de registre
• A partir du nom, lire l'emplacement du fichier dll du pilote
• Lire directement le numéro de version dans le fichier dll

Voici le code à copier et à coller dans un nouveau module de code :

Code :

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
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
Option Compare Database
Option Explicit
 
' =========================================================
' Définition types
' =========================================================
Private Type VS_FIXEDFILEINFO
    dwSignature As Long
    dwStrucVersion As Long
    dwFileVersionMS As Long
    dwFileVersionLS As Long
    dwProductVersionMS As Long
    dwProductVersionLS As Long
    dwFileFlagsMask As Long
    dwFileFlags  As Long
    dwFileOS As Long
    dwFileType  As Long
    dwFileSubtype  As Long
    dwFileDateMS As Long
    dwFileDateLS As Long
End Type
 
' =========================================================
' Début Déclarations API
' =========================================================
 
' Copie mémoire -------------------------------------------
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
        Destination As Any, _
        Source As Any, _
        ByVal size As Long)
 
' Messages d'erreur Windows -------------------------------
Private Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000
Private Declare Function FormatMessage Lib "kernel32.dll" Alias "FormatMessageA" ( _
         ByVal dwFlags As Long, ByVal lpSource As Long, _
         ByVal dwMessageId As Long, ByVal dwLanguageId As Long, _
         ByVal lpBuffer As String, ByVal nSize As Long, _
         ByVal Arguments As Long) As Long
 
' Version Bibliothèques (.dll) ----------------------------
Private Declare Function GetFileVersionInfoSize Lib "version.dll" Alias "GetFileVersionInfoSizeA" ( _
        ByVal sFile As String, _
        ByVal hHandle As Long) As Long ' Taille en octets
 
Private Declare Function GetFileVersionInfo Lib "version.dll" Alias "GetFileVersionInfoA" ( _
        ByVal sFile As String, _
        ByVal hHandle As Long, _
        ByVal dwLen As Long, _
        ByRef lpData As Any) As Long ' BOOL (0 | 1)
 
Private Declare Function VerQueryValue Lib "version.dll" Alias "VerQueryValueA" ( _
        ByRef lpData As Any, _
        ByVal ValuePath As String, _
        ByRef lpPointer As Long, _
        ByRef lpDataSize As Any) As Long ' BOOL (0 | 1)
 
' ODBC ----------------------------------------------------
Private Declare Function SQLGetInstalledDrivers Lib "odbccp32.dll" ( _
        ByVal lpszBuf As String, _
        ByVal cbBufMax As Integer, _
        ByRef pcbBufOut As Integer) As Long
 
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Fin Déclarations API
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
' ---------------------------------------------------------
' Type énuméré pour fonction GetDllVersion
' ---------------------------------------------------------
Public Enum dllVerType
     Product
     File
End Enum
 
' ---------------------------------------------------------
' Fonction GetDrvVersion
' ---------------------------------------------------------
' Entrée
'       sDrv : Nom du pilote
'              Par ex. "SQL Server"
'                      "SQL Server Native*"
' Sortie
'       Chaîne de caractère xxxx.xxxx.xxxx.xxxx représentant
'       un numéro de version 64-bit (4 x 16)
' ---------------------------------------------------------
Function GetDrvVersion(sDrv As String) As String
Dim MaxBuffSize As Integer, BuffSize As Integer, strBuff As String
Dim RetVal As Long
Dim arrDrvs() As String, i As Integer
Dim oSh As Object, sRegK As String
Dim sDrvName As String, sDll As String, sDllVersion As String
 
' Obtenir liste des pilotes
' -> chaîne délimitée par des caractères nuls.
Do
    MaxBuffSize = MaxBuffSize + 256: strBuff = String(MaxBuffSize, vbNull)
    RetVal = SQLGetInstalledDrivers(strBuff, MaxBuffSize, BuffSize)
Loop Until BuffSize < MaxBuffSize
strBuff = Left(strBuff, BuffSize - 2)    ' -2 car deux caractères nul à la fin
' Convertir chaîne délimitée en tableau
arrDrvs = Split(strBuff, vbNullChar)
' Parcourir le tableau à la recherche du pilote
For i = LBound(arrDrvs) To UBound(arrDrvs)
    If arrDrvs(i) Like sDrv Then
       ' Si pilote trouvé, lire la base de registre pour touver
       ' le fichier dll du pilote
       sDrvName = arrDrvs(i)
       Set oSh = CreateObject("WScript.Shell")
       sRegK = "HKLM\SOFTWARE\ODBC\ODBCINST.INI\" & sDrvName & "\Driver"
       sDll = oSh.RegRead(sRegK)
       Set oSh = Nothing
       If Len(sDll) > 0 Then
          ' Obtenir la version du fichier dll du pilote
          sDllVersion = GetDllVersion(sDll)
       End If
       Exit For
    End If
Next
 
' Valeur de retour
If Len(sDllVersion) = 0 Then
   sDllVersion = "0.0.0.0"
ElseIf sDllVersion Like "E:" Then
   Debug.Print Mid(sDllVersion, 3)
   sDllVersion = "0.0.0.0"
End If
 
GetDrvVersion = sDllVersion
End Function
 
' ---------------------------------------------------------
' Fonction GetDllVersion
' ---------------------------------------------------------
' Entrée
'       sFile : Chemin complet vers fichier dll
'               Par ex. "c:\windows\system32\comctl32.dll"
'     VerType : Type de numéro de version
'                  Product (Produit) par défaut
'               ou File    (Fichier)
' Sortie
'       Chaîne de caractère xxxx.xxxx.xxxx.xxxx représentant
'       un numéro de version 64-bit (4 x 16).
'       En cas d'echec la chaine sera vide ("") ou sera de la
'       forme "E:message d'erreur windows"
' ---------------------------------------------------------
Function GetDllVersion(sFile As String, _
            Optional VerType As dllVerType = dllVerType.Product) As String
Dim lgRetVal As Long, lgHandle As Long, lgLastErr As Long
Dim lgDataLen As Long, arrDataBytes() As Byte
Dim lgQVdataAddr As Long, lgQVdataSize As Long
Dim FixedInfo As VS_FIXEDFILEINFO
Dim sVersion As String
 
' Taille de la ressource VERSIONINFO
lgDataLen = GetFileVersionInfoSize(sFile, lgHandle)
If lgDataLen = 0 Then
   lgLastErr = Err.LastDllError
   sVersion = "E:" & GetWinErrorMsg(lgLastErr)
   GoTo Sortie
End If
 
' Redimentionner tableau
ReDim arrDataBytes(0 To lgDataLen - 1)
' Charger ressource
lgRetVal = GetFileVersionInfo(sFile, lgHandle, lgDataLen, arrDataBytes(0))
If lgRetVal = 0 Then
   lgLastErr = Err.LastDllError
   sVersion = "E:" & GetWinErrorMsg(lgLastErr)
   GoTo Sortie
End If
 
lgRetVal = VerQueryValue(arrDataBytes(0), "\", lgQVdataAddr, lgQVdataSize)
If lgRetVal = 0 Then
   lgLastErr = Err.LastDllError
   sVersion = "E:" & GetWinErrorMsg(lgLastErr)
   GoTo Sortie
End If
 
' Recopier données dans variable type VS_FIXEDFILEINFO
CopyMemory FixedInfo, ByVal lgQVdataAddr, lgQVdataSize
' Version
Select Case VerType
    Case dllVerType.Product
    ' Version du produit
    sVersion = CStr((FixedInfo.dwProductVersionMS And &HFFFF0000) / 65536) & _
         "." & CStr(FixedInfo.dwProductVersionMS And &HFFFF&) & _
         "." & CStr((FixedInfo.dwProductVersionLS And &HFFFF0000) / 65536) & _
         "." & CStr(FixedInfo.dwProductVersionLS And &HFFFF&)
 
    Case dllVerType.File
    ' Version du ficher dll
    sVersion = CStr((FixedInfo.dwFileVersionMS And &HFFFF0000) / 65536) & _
         "." & CStr(FixedInfo.dwFileVersionMS And &HFFFF&) & _
         "." & CStr((FixedInfo.dwFileVersionLS And &HFFFF0000) / 65536) & _
         "." & CStr(FixedInfo.dwFileVersionLS And &HFFFF&)
End Select
 
Sortie:
GetDllVersion = sVersion
End Function
 
' ---------------------------------------------------------
' Récupération message d'erreur windows associé à un
' numéro d'erreur.
' ---------------------------------------------------------
Private Function GetWinErrorMsg(lngErr As Long)
Dim strMsg As String, hModule As Long
 
hModule = 0
strMsg = String(1024, vbNullChar)
FormatMessage FORMAT_MESSAGE_FROM_SYSTEM, hModule, lngErr, 0, strMsg, 1023, 0
strMsg = Left(strMsg, InStr(1, strMsg, vbNullChar) - 1)
GetWinErrorMsg = strMsg
End Function
 
' ---------------------------------------------------------
' Fonction CompareDllVersions
' ---------------------------------------------------------
' Entrée
' Numéros de version sous la form de chaînes de caractère
' "xxxx.xxxx.xxxx.xxxx"
'       sVersion       : Version que l'on veut comparer
'       sCompToVersion : Version de référence
'
' Sortie
'      -1 sVersion < sCompToVersion
'       0 sVersion = sCompToVersion
'       1 sVersion > sCompToVersion
' ---------------------------------------------------------
Function CompareDllVersions(sVersion, sCompToVersion) As Long
Dim arrV1() As String, arrV2() As String
Dim i As Long
Dim lComp As Long
 
arrV1 = Split(sVersion, ".")
If UBound(arrV1) < 3 Then
   ReDim Preserve arrV1(0 To 3)
   For i = 0 To 3
       If Len(arrV1(i)) = 0 Then arrV1(i) = "0"
   Next
End If
 
arrV2 = Split(sCompToVersion, ".")
If UBound(arrV2) < 3 Then
   ReDim Preserve arrV2(0 To 3)
   For i = 0 To 3
       If Len(arrV2(i)) = 0 Then arrV2(i) = "0"
   Next
End If
 
For i = 0 To 3
    lComp = CLng(arrV1(i)) - CLng(arrV2(i))
    If lComp <> 0 Then Exit For
Next
CompareDllVersions = Sgn(lComp)
End Function

Exemple d'utilisation :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub ExempleVerifVersionPilote()
Dim sVerPiloteMySQL As String
Const sVerReference = "3.51.23.0"
 
sVerPiloteMySQL = GetDrvVersion("MySQL ODBC 3.51 Driver")
' ou
'sVerPiloteMySQL = GetDrvVersion("MySQL ODBC 3.51*")
If sVerPiloteMySQL = "0.0.0.0" Then
   MsgBox "Aucun pilote n'a été trouvé.", , _
          "Pilote ODBC MySQL"
ElseIf CompareDllVersions(sVerPiloteMySQL, sVerReference) < 0 Then
   MsgBox "Il vous faut au minimum la version " & sVerReference, , _
          "Pilote ODBC MySQL " & sVerPiloteMySQL
End If
 
End Sub

A+

[jj4822]

Bonjour.

Merci pour cette reponse qui resoudra mon besoin.

Etant donne que j'ai le pilote Mysql 5.1 sur mon ordi, j'ai modifie le module de lancement de telle maniere :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 
 
Sub ExempleVerifVersionPilote()
Dim sVerPiloteMySQL As String
'Const sVerReference = "3.51.23.0"
Const sVerReference = "5.01.08.00"
 
 
'sVerPiloteMySQL = GetDrvVersion("MySQL ODBC 3.51 Driver")
sVerPiloteMySQL = GetDrvVersion("MySQL ODBC 5.1 Driver")
 
' ou
'sVerPiloteMySQL = GetDrvVersion("MySQL ODBC 3.51*")
If sVerPiloteMySQL = "0.0.0.0" Then
   MsgBox "Aucun pilote n'a été trouvé.", , _
          "Pilote ODBC MySQL"
ElseIf CompareDllVersions(sVerPiloteMySQL, sVerReference) < 0 Then
   MsgBox "Il vous faut au minimum la version " & sVerReference, , _
          "Pilote ODBC MySQL " & sVerPiloteMySQL
End If
 
End Sub

Sur l'ordinateur ou est installee la version 5.01.08.00, aucun message ne s'affiche ce qui veut dire que c'est OK.
Sur l'ordinateur ou est installee la version 5.01.05.00, j'ai le message "Aucun pilote n'a été trouvé".

J'ai essaye de voir dans la fonction :

Code :

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
 
 
Function GetDrvVersion(sDrv As String) As String
Dim MaxBuffSize As Integer, BuffSize As Integer, strBuff As String
Dim RetVal As Long
Dim arrDrvs() As String, i As Integer
Dim oSh As Object, sRegK As String
Dim sDrvName As String, sDll As String, sDllVersion As String
 
' Obtenir liste des pilotes
' -> chaîne délimitée par des caractères nuls.
Do
    MaxBuffSize = MaxBuffSize + 256: strBuff = String(MaxBuffSize, vbNull)
    RetVal = SQLGetInstalledDrivers(strBuff, MaxBuffSize, BuffSize)
Loop Until BuffSize < MaxBuffSize
strBuff = Left(strBuff, BuffSize - 2)    ' -2 car deux caractères nul à la fin
' Convertir chaîne délimitée en tableau
arrDrvs = Split(strBuff, vbNullChar)
' Parcourir le tableau à la recherche du pilote
For i = LBound(arrDrvs) To UBound(arrDrvs)
    If arrDrvs(i) Like sDrv Then
       ' Si pilote trouvé, lire la base de registre pour touver
       ' le fichier dll du pilote
       sDrvName = arrDrvs(i)
       Set oSh = CreateObject("WScript.Shell")
       sRegK = "HKLM\SOFTWARE\ODBC\ODBCINST.INI\" & sDrvName & "\Driver"
       sDll = oSh.RegRead(sRegK)
       Set oSh = Nothing
       If Len(sDll) > 0 Then
          ' Obtenir la version du fichier dll du pilote
          sDllVersion = GetDllVersion(sDll)
       End If
       Exit For
    End If
Next
 
' Valeur de retour
If Len(sDllVersion) = 0 Then
   sDllVersion = "0.0.0.0"
ElseIf sDllVersion Like "E:" Then
   Debug.Print Mid(sDllVersion, 3)
   sDllVersion = "0.0.0.0"
End If
 
GetDrvVersion = sDllVersion
End Function

J'ai rajoute un point d'arret sur la ligne :

Code :

1
2
 
If arrDrvs(i) Like sDrv Then

Il s'est alors arrete je suppose sur le 1er driver trouve : Sql server. Ce qui est logique.
J'ai alors rajoute un point d'arret sur la ligne :

Code :

1
2
 
sDrvName = arrDrvs(i)

et, lorsque j'ai relance le programme il ne s'est pas arrete sur le point d'arret donc il n'a pas trouve la valeur "MySQL ODBC 5.1 Driver".

A quoi ca peut etre du ?
Y a t il une des fonction ou il faut modifier une valeur ?

Dans la base de registre je retrouve bien, dans HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBCINST.INI\, le catalogue "MySQL ODBC 5.1 Driver" puis dans ce dernier catalogue la valeur "Driver".

Merci.
Cdlt

[LedZeppII]

Bonsoir,

La fonction SQLGetInstalledDrivers de l'API ODBC lit le contenu de la clé de registre
HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBCINST.INI\ODBC Drivers

C'est la fonction dont se sert l'administrateur de source de données ODBC (odbcad32.exe ou odbccp32.cpl).

J'ai fait un test chez moi.
Si je supprime la valeur nommée "MySQL ODBC 3.51 Driver" dans la sous-clé ODBC Drivers,
l'administrateur de source de données ODBC ne voit plus le pilote, bien que la sous-clé "MySQL ODBC 3.51 Driver" existe toujours,
avec ses valeurs nommées CPTimeout, Driver, Setup, et UsageCount.

Pour moi, sur l'ordinateur où est installée la version 5.01.05.00, le pilote est mal installé, ou en tout cas pas de la manière attendue.
Vérifie si tu le vois avec odbcad32.exe.

De mon côté je regarde si la fonction SQLDrivers (ODBC 2 contre ODBC 1 pour SQLGetInstalledDrivers) fonctionne différemment.
Je l'ai laissée de côté car elle nécessite plus de code et de déclarations API.

A+

[LedZeppII]

Rebonsoir,

SQLDrivers fonctionne selon le même principe que SQLGetInstalledDrivers.

J'ai réécrit la fonction GetDrvVersion en changeant la logique d'énumération des pilotes.
J'énumère les sous-clés de HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBCINST.INI
à la recherche du pilote demandé.
J'ai trouvé une méthode sans API dans WMI.
J'espère qu'il n'y a pas de problème de niveaux d'autorisations pour lire la base de registre par code.

Code :

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
' ---------------------------------------------------------
' Fonction GetDrvVersion
' 2ème version avec classe WMI StdRegProv
' ---------------------------------------------------------
' Entrée
'       sDrv : Nom du pilote
'              Par ex. "SQL Server"
'                      "SQL Server Native*"
' Sortie
'       Chaîne de caractère xxxx.xxxx.xxxx.xxxx représentant
'       un numéro de version 64-bit (4 x 16)
' ---------------------------------------------------------
Function GetDrvVersion(sDrv As String) As String
Const HK_LM = &H80000002
Const SREGODBCINST = "SOFTWARE\ODBC\ODBCINST.INI"
Dim arrDrvs() As Variant, i As Integer
Dim oReg As Object, sRegK As String, lRet As Integer
Dim sDrvName As String, sDll As String, sDllVersion As String
 
On Error GoTo GetDrvVersionErr
' Obtenir liste des pilotes en énumérant les sous clés
' de HKLM\SOFTWARE\ODBC\ODBCINST.INI"
Set oReg = GetObject("winmgmts:\root\default:StdRegProv")
sRegK = SREGODBCINST
lRet = oReg.EnumKey(HK_LM, SREGODBCINST, arrDrvs)
 
' Parcourir le tableau à la recherche du pilote
For i = LBound(arrDrvs) To UBound(arrDrvs)
    If arrDrvs(i) Like sDrv Then
       ' Si pilote trouvé, lire la base de registre pour touver
       ' le fichier dll du pilote
       sDrvName = arrDrvs(i)
       sRegK = SREGODBCINST & "\" & sDrvName
       lRet = oReg.GetStringValue(HK_LM, sRegK, "Driver", sDll)
       If Len(sDll) > 0 Then
          ' Obtenir la version du fichier dll du pilote
          sDllVersion = GetDllVersion(sDll)
       End If
       Exit For
    End If
Next
 
GetDrvVersionExit:
    Set oReg = Nothing
    ' Valeur de retour
    If Len(sDllVersion) = 0 Then
       sDllVersion = "0.0.0.0"
    ElseIf sDllVersion Like "E:" Then
       Debug.Print Mid(sDllVersion, 3)
       sDllVersion = "0.0.0.0"
    End If
    GetDrvVersion = sDllVersion
    Exit Function
 
GetDrvVersionErr:
    Debug.Print "Erreur No. " & Err.Number & " : " & Err.Description
    Resume GetDrvVersionExit
End Function

A+

[jj4822]

Bonjour LedZeppII.

Merci pour la nouvelle version de la fonction GetDrvVersion.
Avec ca j'obtient bien le message comme quoi je dois avoir au minimum 5.01.08.00 sur l'ordi ayant le pilote ODBC Mysql 5.01.05.00.

Ca fonctionne.

Merci beaucoup pour cette aide.

Cdlt.