INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

Visual Basic (Microsoft) Versions 5/6 FAQ

Windows API

How to get all the System DSN and their settings from the registry by kb244
Posted: 20 Jun 00

Basically all settings are placed under

HKEY_LOCAL_MACHINE\Software\ODBC\ODBC.INIthe settings are there, the list of the DSN and their drivers
are under the \ODBC Data Sources under the path above, since a simple GetSetting SaveSetting not going to really work in this case, here is the API declarations, plus some helper functions.
API Declarations

Public Const KEY_READ = &H20019

Public Const REG_SZ = 1
Public Const REG_EXPAND_SZ = 2
Public Const REG_BINARY = 3
Public Const REG_DWORD = 4
Public Const REG_MULTI_SZ = 7
Public Const ERROR_MORE_DATA = 234
Public Const ERROR_SUCCESS = 0&
Public Const KEY_ALL_ACCESS = &H2003F
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_DYN_DATA = &H80000006
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_USERS = &H80000003

Public Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long

Public Declare Function RegCreateKey Lib "advapi32.dll" _
Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey _
As String, phkResult As Long) As Long

Public Declare Function RegDeleteKey Lib "advapi32.dll" _
Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey _
As String) As Long

Public Declare Function RegDeleteValue Lib "advapi32.dll" _
Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal _
lpValueName As String) As Long

Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal _
   lpSubKey As String, phkResult As Long) As Long

Public Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" _
    (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
    ByVal samDesired As Long, ByRef phkResult As Long) As Long

Public Declare Function RegQueryValueEx Lib "advapi32" Alias _
    "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
    ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, _
    ByRef lpcbData As Long) As Long
    
Public Declare Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" _
(ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue As Long) As Long

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, source As Any, ByVal numBytes As Long)

Public 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

Public Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
Public 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 Byte, lpcbData As Long) As Long

Helper Functions to grab certain types of values
Public Function GetSettingString(hKey As Long, strPath As String, strValue As String, Optional Default As String) As String
Dim hCurKey As Long
Dim lValueType As Long
Dim strBuffer As String
Dim lDataBufferSize As Long
Dim intZeroPos As Integer
Dim lRegResult As Long

' Set up default value
If Not IsEmpty(Default) Then
  GetSettingString = Default
Else
  GetSettingString = ""
End If

' Open the key and get length of string
lRegResult = RegOpenKey(hKey, strPath, hCurKey)
lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, lValueType, ByVal 0&, lDataBufferSize)

If lRegResult = ERROR_SUCCESS Or lRegResult = ERROR_MORE_DATA Then

  If lValueType = REG_SZ Then
    ' initialise string buffer and retrieve string
    strBuffer = String(lDataBufferSize, " ")
    lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, 0&, ByVal strBuffer, lDataBufferSize)
    
    ' format string
    intZeroPos = InStr(strBuffer, Chr$(0))
    If intZeroPos > 0 Then
      GetSettingString = Left$(strBuffer, intZeroPos - 1)
    Else
      GetSettingString = strBuffer
    End If

  End If

Else
  ' there is a problem
End If

lRegResult = RegCloseKey(hCurKey)
End Function


Public Function GetSettingLong(ByVal hKey As Long, _
ByVal strPath As String, ByVal strValue As String, _
Optional Default As Long) As Long

   Dim lRegResult As Long
   Dim lValueType As Long
   Dim lBuffer As Long
   Dim lDataBufferSize As Long
   Dim hCurKey As Long

   'Set up default value
   If Not IsEmpty(Default) Then
      GetSettingLong = Default
   Else
      GetSettingLong = 0
   End If

   lRegResult = RegOpenKey(hKey, strPath, hCurKey)
   lDataBufferSize = 4 '4 bytes = 32 bits = long

   lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, _
   lValueType, lBuffer, lDataBufferSize)

   If lRegResult = ERROR_SUCCESS Then

      If lValueType = REG_DWORD Then
         GetSettingLong = lBuffer
      End If

   Else
      'there is a problem
   End If

   lRegResult = RegCloseKey(hCurKey)
End Function

Public Function GetSettingByte(ByVal hKey As Long, _
ByVal strPath As String, ByVal strValueName As String, _
Optional Default As Variant) As Variant
   Dim lValueType As Long
   Dim byBuffer() As Byte
   Dim lDataBufferSize As Long
   Dim lRegResult As Long
   Dim hCurKey As Long

   If Not IsEmpty(Default) Then
      If VarType(Default) = vbArray + vbByte Then
         GetSettingByte = Default
      Else
         GetSettingByte = 0
      End If

   Else
      GetSettingByte = 0
   End If

   lRegResult = RegOpenKey(hKey, strPath, hCurKey)

   lRegResult = RegQueryValueEx(hCurKey, strValueName, 0&, _
   lValueType, ByVal 0&, lDataBufferSize)

   If lRegResult = ERROR_SUCCESS Or lRegResult = ERROR_MORE_DATA Then
      If lValueType = REG_BINARY Then
         ReDim byBuffer(lDataBufferSize - 1) As Byte
         lRegResult = RegQueryValueEx(hCurKey, strValueName, 0&, _
         lValueType, byBuffer(0), lDataBufferSize)
         GetSettingByte = byBuffer
      End If
   Else
      'there is a problem
   End If
   lRegResult = RegCloseKey(hCurKey)
End Function

Code to place in Form or wherever
previously had these seperate, to use this new modified function, use False if you just want to get back the name of all the System DSN on the computer, use True, then type in a DSN to get back the settings for that particular DSN
Private Function GetDSNs(DSNExist As Boolean, Optional DSN As String = "") As Variant
   'Returns: a 2D array.
   '(x,0) is value name
   '(x,1) is value type (see constants)
   Dim lRegResult As Long
   Dim hCurKey As Long
   Dim lValueNameSize As Long
   Dim strValueName As String
   Dim lCounter As Long
   Dim byDataBuffer(4000) As Byte
   Dim lDataBufferSize As Long
   Dim lValueType As Long
   Dim strNames() As String
   Dim lTypes() As Long
   Dim intZeroPos As Integer
   Const ODBCINIPath = "Software\ODBC\ODBC.INI\"
   Const ODBCPath = "ODBC Data Sources"
   Dim TempPath As String
   
   If DSNExist Then
      TempPath = ODBCINIPath & DSN
   Else
      TempPath = ODBCINIPath & ODBCPath
   End If
   lRegResult = RegOpenKey(HKEY_LOCAL_MACHINE, TempPath, hCurKey)
   Do
      lValueNameSize = 255
      strValueName = String$(lValueNameSize, " ")
      lDataBufferSize = 4000

      lRegResult = RegEnumValue(hCurKey, lCounter, _
      strValueName, lValueNameSize, 0&, lValueType, _
      byDataBuffer(0), lDataBufferSize)

      If lRegResult = ERROR_SUCCESS Then
   
         ReDim Preserve strNames(lCounter) As String
         ReDim Preserve lTypes(lCounter) As Long
         lTypes(UBound(lTypes)) = lValueType

         intZeroPos = InStr(strValueName, Chr$(0))
         If intZeroPos > 0 Then
            strNames(UBound(strNames)) = _
            Left$(strValueName, intZeroPos - 1)
         Else
            strNames(UBound(strNames)) = strValueName
         End If

         lCounter = lCounter + 1

      Else
         Exit Do
      End If
   Loop
   
   Dim Finisheddata() As Variant
   ReDim Finisheddata(UBound(strNames), 0 To 1) As Variant
   
   For lCounter = 0 To UBound(strNames)
      Finisheddata(lCounter, 0) = strNames(lCounter)
      Select Case lTypes(lCounter)
         Case REG_DWORD
            Finisheddata(lCounter, 1) = GetSettingLong(HKEY_LOCAL_MACHINE, TempPath, CStr(strNames(lCounter)))
         Case REG_BINARY
            Finisheddata(lCounter, 1) = GetSettingByte(HKEY_LOCAL_MACHINE, TempPath, Hex$(strNames(lCounter)))(0)
         Case REG_SZ
            Finisheddata(lCounter, 1) = GetSettingString(HKEY_LOCAL_MACHINE, TempPath, CStr(strNames(lCounter)))
      End Select
   Next
   
   GetDSNs = Finisheddata
End Function

how to decode variant returned from above function
'Dim SubKeys As Variant
'Dim KeyLoop As Integer
'SubKeys = GetAllKeys(HKEY_CURRENT_USER, vbNullString)
'
'If VarType(SubKeys) = vbArray + vbString Then
'For KeyLoop = 0 To UBound(SubKeys)
'Debug.Print SubKeys(KeyLoop)
'Next
'End If
an extra function, that just lets you get all the subkeys under a certain key
'   Dim lRegResult As Long
'   Dim lCounter As Long
'   Dim hCurKey As Long
'   Dim strBuffer As String
'   Dim lDataBufferSize As Long
'   Dim strNames() As String
'   Dim intZeroPos As Integer
'   lCounter = 0
'   lRegResult = RegOpenKey(HKEY_LOCAL_MACHINE, "Software\ODBC\ODBC.INI\", hCurKey)
'
'   Do
'      'initialise buffers (longest possible length=255)
'      lDataBufferSize = 255
'      strBuffer = String(lDataBufferSize, " ")
'      lRegResult = RegEnumKey(hCurKey, _
'      lCounter, strBuffer, lDataBufferSize)
'
'      If lRegResult = ERROR_SUCCESS Then
'         'tidy up string and save it
'         ReDim Preserve strNames(lCounter) As String
'
'         intZeroPos = InStr(strBuffer, Chr$(0))
'         If intZeroPos > 0 Then
'            strNames(UBound(strNames)) = Left$(strBuffer, intZeroPos - 1)
'         Else
'            strNames(UBound(strNames)) = strBuffer
'         End If
'
'         lCounter = lCounter + 1
'      Else
'         Exit Do
'      End If
'   Loop
'   GetAllDSN = strNames


Partial credit given to vb-world.net for the registry helper functions(which were slightly modified to fix the 234 error code bug)

Back to Visual Basic (Microsoft) Versions 5/6 FAQ Index
Back to Visual Basic (Microsoft) Versions 5/6 Forum

My Archive

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close