home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Programmer'…arterly (Limited Edition) / Visual_Basic_Programmers_Journal_VB-CD_Quarterly_Limited_Edition_1995.iso / code / ch29code / registry.bas < prev    next >
Encoding:
BASIC Source File  |  1995-08-02  |  3.6 KB  |  71 lines
  1. Attribute VB_Name = "Registry"
  2. '********************************************************************
  3. ' REGSITRY.BAS - Contains the code necessary to access the Windows
  4. '                registration datbase.
  5. '********************************************************************
  6. #If Win32 Then
  7. Option Explicit
  8. '********************************************************************
  9. ' The minimal API calls required to read from the registry.
  10. '********************************************************************
  11. Private Declare Function RegOpenKey Lib "advapi32" Alias _
  12.     "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, _
  13.     phkResult As Long) As Long
  14. Private Declare Function RegQueryValueEx Lib "advapi32" Alias _
  15.     "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
  16.     String, lpReserved As Long, lptype As Long, lpData As Any, _
  17.     lpcbData As Long) As Long
  18. Private Declare Function RegCloseKey& Lib "advapi32" (ByVal hKey&)
  19. '********************************************************************
  20. ' The constants used in this module for the regsitry API calls.
  21. '********************************************************************
  22. Private Const REG_SZ = 1        ' Unicode null terminated string
  23. Private Const REG_EXPAND_SZ = 2 ' Unicode null terminated string
  24.                                 ' with environment variable
  25.                                 ' references.
  26. Private Const ERROR_SUCCESS = 0
  27. '********************************************************************
  28. ' The numeric constants for the major keys in the regsitry.
  29. '********************************************************************
  30. Public Const HKEY_CLASSES_ROOT = &H80000000
  31. Public Const HKEY_CURRENT_USER = &H80000001
  32. Public Const HKEY_LOCAL_MACHINE = &H80000002
  33. Public Const HKEY_USERS = &H80000003
  34. Public Const HKEY_PERFORMANCE_DATA = &H80000004
  35. '********************************************************************
  36. ' GetRegString takes three arguments. A HKEY constant (listed above),
  37. ' a subkey, and a value in that subkey. This function returns the
  38. ' string stored in the strValueName value in the registry.
  39. '********************************************************************
  40. Public Function GetRegString(hKey As Long, strSubKey As String, _
  41.                                 strValueName As String) As String
  42. Dim strSetting As String
  43. Dim lngDataLen As Long
  44. Dim lngRes As Long
  45.     '****************************************************************
  46.     ' Open the key. If success, then get the data from the key.
  47.     '****************************************************************
  48.     If RegOpenKey(hKey, strSubKey, lngRes) = ERROR_SUCCESS Then
  49.         strSetting = Space(255)
  50.         lngDataLen = Len(strSetting)
  51.         '************************************************************
  52.         ' Query the key for the current setting. If this call
  53.         ' succeeds, then return the string.
  54.         '************************************************************
  55.         If RegQueryValueEx(lngRes, strValueName, ByVal 0, _
  56.             REG_EXPAND_SZ, ByVal strSetting, lngDataLen) = _
  57.             ERROR_SUCCESS Then
  58.             If lngDataLen > 1 Then
  59.                 GetRegString = Left(strSetting, lngDataLen - 1)
  60.             End If
  61.         End If
  62.         '************************************************************
  63.         ' ALWAYS close any keys that you open.
  64.         '************************************************************
  65.         If RegCloseKey(lngRes) <> ERROR_SUCCESS Then
  66.             MsgBox "RegCloseKey Failed: " & strSubKey, vbCritical
  67.         End If
  68.     End If
  69. End Function
  70. #End If
  71.