Seznam nainstalovan²ch ODBC ovladaΦ∙

Postup:
V deklaraΦnφ Φßsti formulß°e zapiÜte:


Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _
  Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, _
  ByVal ulOptions As Long, ByVal samDesired As Long, _
  phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" _
  (ByVal hKey As Long) As Long
Private Declare Function RegEnumValue Lib "advapi32.dll" _
  Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, _
  ByVal lpValueName As String, lpcbValueName As Long, _
  ByVal lpReserved As Long, lpType As Long, lpData As Any, _
  lpcbData As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
  (dest As Any, source As Any, ByVal numBytes As Long)

Private Const REG_SZ = 1
Private Const REG_EXPAND_SZ = 2
Private Const REG_BINARY = 3
Private Const REG_DWORD = 4
Private Const REG_MULTI_SZ = 7
Private Const ERROR_MORE_DATA = 234
Private Const KEY_READ = &H20019 
Private Const HKEY_LOCAL_MACHINE = &H80000002


Function EnumRegistryValues(ByVal hKey As Long, _
  ByVal KeyName As String) As Collection

   Dim handle As Long
   Dim index As Long
   Dim valueType As Long
   Dim name As String
   Dim nameLen As Long
   Dim resLong As Long
   Dim resString As String
   Dim dataLen As Long
   Dim valueInfo(0 To 1) As Variant
   Dim retVal As Long

   Set EnumRegistryValues = New Collection

   If Len(KeyName) Then
      If RegOpenKeyEx(hKey, KeyName, 0, KEY_READ, handle) Then Exit Function
      hKey = handle
   End If

   Do
      nameLen = 260
      name = Space$(nameLen)
      dataLen = 4096
      ReDim resBinary(0 To dataLen - 1) As Byte

      retVal = RegEnumValue(hKey, index, name, nameLen, ByVal 0&, _
         valueType, resBinary(0), dataLen)

      If retVal = ERROR_MORE_DATA Then
         ReDim resBinary(0 To dataLen - 1) As Byte
         retVal = RegEnumValue(hKey, index, name, nameLen, ByVal 0&, _
            valueType, resBinary(0), dataLen)
      End If
      If retVal Then Exit Do

      valueInfo(0) = Left$(name, nameLen)

      Select Case valueType
         Case REG_DWORD
            CopyMemory resLong, resBinary(0), 4
            valueInfo(1) = resLong
         Case REG_SZ, REG_EXPAND_SZ
            resString = Space$(dataLen - 1)
            CopyMemory ByVal resString, resBinary(0), dataLen - 1
            valueInfo(1) = resString
         Case REG_BINARY
            If dataLen < UBound(resBinary) + 1 Then
               ReDim Preserve resBinary(0 To dataLen - 1) As Byte
            End If
            valueInfo(1) = resBinary()
         Case REG_MULTI_SZ
            resString = Space$(dataLen - 2)
            CopyMemory ByVal resString, resBinary(0), dataLen - 2
            valueInfo(1) = resString
         Case Else
      End Select

      EnumRegistryValues.Add valueInfo, valueInfo(0)

      index = index + 1
   Loop

   If handle Then RegCloseKey handle

End Function

Sub GetODBCDrivers()

   Dim res As Collection
   Dim values As Variant

   For Each values In EnumRegistryValues(HKEY_LOCAL_MACHINE, _
      "Software\ODBC\ODBCINST.INI\ODBC Drivers")
      If StrComp(values(1), "Installed", 1) = 0 Then
         'P°φm² zßpis do prvku na formulß°i. Pokud mßte jin² prvek, zm∞≥te °ßdek
         List1.AddItem values(0)
      End If
   Next

End Sub

Na formulß° p°idejte ListBox a na udßlost Form_Load zapiÜte:
Private Sub Form_Load()

   GetODBCDrivers

End Sub

Zp∞t

Autor: The Bozena