Reading registry

Hi,

By default you can read/write to the VB area of Current user in the
registry.

To read/write to other area you need to reference another library file under
the Tools References command.

I've forgotten which file. Can someone remoind me please.


--


Laurie Comerford
CADApps
www.cadapps.com.au

 

Microsoft has one that i use, it's called regobj.dll. You can get it here:
http://download.microsoft.com/download/vb60pro/Update/6.0/W9X2K/EN-US/RegObji.exe

Kevin

 

Or you could use a VB class like the following. Save it to a file like
CRegistry.cls, and add it to your project. I've been using it for years
without problems. I haven't used the RemoteMachine property much, so I don't
know if I ever fully debugged that one.

Usage:

dim Reg as new CRegistry
Reg.RootKey = HKEY_LOCAL_MACHINE
if Reg.OpenKey("Software\Autodesk\AutoCAD", false) then
MsgBox "Current AutoCAD version: " & Reg.ReadString("CurVer")
end if

------------ BEGIN FILE -------------
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "CRegistry"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit

' root keys
Public Enum ROOTKEYS
HKEY_CLASSES_ROOT = &H80000000
HKEY_CURRENT_USER = &H80000001
HKEY_LOCAL_MACHINE = &H80000002
HKEY_USERS = &H80000003
HKEY_PERFORMANCE_DATA = &H80000004
HKEY_CURRENT_CONFIG = &H80000005
HKEY_DYN_DATA = &H80000006
End Enum

' Codes returned by Reg API calls
Private Const ERROR_SUCCESS = 0
Private Const ERROR_BADDB = 1
Private Const ERROR_BADKEY = 2
Private Const ERROR_CANTOPEN = 3
Private Const ERROR_CANTREAD = 4
Private Const ERROR_CANTWRITE = 5
Private Const ERROR_OUTOFMEMORY = 6
Private Const ERROR_INVALID_PARAMETER = 7
Private Const ERROR_ACCESS_DENIED = 8
Private Const ERROR_INVALID_PARAMETERS = 87
Private Const ERROR_NO_MORE_ITEMS = 259

' Registry value type definitions
Private Const REG_NONE As Long = 0
Private Const REG_SZ As Long = 1
Private Const REG_EXPAND_SZ As Long = 2
Private Const REG_BINARY As Long = 3
Private Const REG_DWORD As Long = 4
Private Const REG_LINK As Long = 6
Private Const REG_MULTI_SZ As Long = 7
Private Const REG_RESOURCE_LIST As Long = 8

'Security Mask constants
Public Enum ACCESSTYPE
READ_CONTROL = &H20000
SYNCHRONIZE = &H100000
STANDARD_RIGHTS_ALL = &H1F0000
STANDARD_RIGHTS_READ = READ_CONTROL
STANDARD_RIGHTS_WRITE = READ_CONTROL
KEY_QUERY_VALUE = &H1
KEY_SET_VALUE = &H2
KEY_CREATE_SUB_KEY = &H4
KEY_ENUMERATE_SUB_KEYS = &H8
KEY_NOTIFY = &H10
KEY_CREATE_LINK = &H20
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))
KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or
KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE))
KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or
KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
End Enum

Private Declare Function RegConnectRegistry Lib "advapi32.dll" Alias
"RegConnectRegistryA" ( _
ByVal lpMachineName As String, _
ByVal hKey As Long, _
phkResult As Long) As Long
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 RegQueryValueExString Lib "advapi32.dll" Alias
"RegQueryValueExA" ( _
ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal lpReserved As Long, _
lpType As Long, _
ByVal lpData As String, _
lpcbData As Long) As Long
Private Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias
"RegQueryValueExA" ( _
ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal lpReserved As Long, _
lpType As Long, _
lpData As Long, _
lpcbData As Long) As Long
Private Declare Function RegSetValueExString Lib "advapi32.dll" Alias
"RegSetValueExA" ( _
ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal Reserved As Long, _
ByVal dwType As Long, _
ByVal lpValue As String, _
ByVal cbData As Long) As Long
Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias
"RegSetValueExA" ( _
ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal Reserved As Long, _
ByVal dwType As Long, _
lpValue As Long, _
ByVal cbData 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 RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA"
( _
ByVal hKey As Long, _
ByVal dwIndex As Long, _
ByVal lpName As String, _
ByVal cbName 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, _
ByVal lpData As String, _
lpcbData As Long) As Long
Private Declare Function RegQueryInfoKey Lib "advapi32.dll" Alias
"RegQueryInfoKeyA" ( _
ByVal hKey As Long, _
ByVal lpClass As String, _
lpcbClass As Long, _
ByVal lpReserved As Long, _
lpcSubKeys As Long, _
lpcbMaxSubKeyLen As Long, _
lpcbMaxClassLen As Long, _
lpcValues As Long, _
lpcbMaxValueNameLen As Long, _
lpcbMaxValueLen As Long, _
lpcbSecurityDescriptor As Long, _
lpftLastWriteTime As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias
"RegDeleteKeyA" ( _
ByVal hKey As Long, _
ByVal lpSubKey As String) As Long

Private mAccess As Long
Private mCurrentKey As Long
Private mCurrentPath As String
Private mIsOpen As Boolean
Private mRootKey As ROOTKEYS
Private mRootKeyBackup As ROOTKEYS
Private mRemoteMachine As String

Private Sub Class_Initialize()
mAccess = KEY_ALL_ACCESS
mRootKey = HKEY_CURRENT_USER
mRootKeyBackup = HKEY_CURRENT_USER
End Sub

Private Sub Class_Terminate()
CloseKey
End Sub

Public Sub CloseKey()
If mIsOpen Then
If RegCloseKey(mCurrentKey) = ERROR_SUCCESS Then
mIsOpen = False
Else
Err.Raise vbObjectError + 514, , "Error closing key"
End If
End If
End Sub

Public Function DeleteKey(ByVal Key As String) As Boolean
' if trying to delete currently open key, open root key first
' If StrComp(Key, mCurrentPath, vbTextCompare) = 0 Then
OpenKey "", False
' End If
DeleteKey = RegDeleteKey(mCurrentKey, Key) = ERROR_SUCCESS
End Function

Public Sub GetKeyNames(Keys() As String)
Dim Name As String
Dim SubkeyCount As Long
Dim MaxSubkeyLength As Long
Dim i As Long

If RegQueryInfoKey(mCurrentKey, vbNullString, 0&, 0&, SubkeyCount,
MaxSubkeyLength, 0&, 0&, 0&, 0&, 0&, 0&) = ERROR_SUCCESS Then
If SubkeyCount > 0 Then
ReDim Keys(0 To SubkeyCount - 1)
Else
Keys = Split("")
End If
MaxSubkeyLength = MaxSubkeyLength + 1
Name = Space(MaxSubkeyLength)
For i = 0 To SubkeyCount - 1
If RegEnumKey(mCurrentKey, i, Name, MaxSubkeyLength) = ERROR_SUCCESS
Then
Keys(i) = Left(Name, InStr(1, Name, Chr(0), vbBinaryCompare) - 1)
Else
Err.Raise vbObjectError + 518, , "Error reading subkey name"
End If
Next
Else
Err.Raise vbObjectError + 519, , "Error reading subkey names"
End If
End Sub

Public Sub GetValueNames(Values() As String)
Dim Name As String
Dim NameLength As Long
Dim ValueCount As Long
Dim MaxValueLength As Long
Dim i As Long

If RegQueryInfoKey(mCurrentKey, vbNullString, 0&, 0&, 0&, 0&, 0&,
ValueCount, MaxValueLength, 0&, 0&, 0&) = ERROR_SUCCESS Then
If ValueCount > 0 Then
ReDim Values(0 To ValueCount - 1)
Else
Values = Split("")
End If
MaxValueLength = MaxValueLength + 1
Name = Space(MaxValueLength)
For i = 0 To ValueCount - 1
NameLength = MaxValueLength
If RegEnumValue(mCurrentKey, i, Name, NameLength, 0&, 0&,
vbNullString, 0&) = ERROR_SUCCESS Then
Values(i) = Left(Name, NameLength)
Else
Err.Raise vbObjectError + 520, , "Error reading value name"
End If
Next
Else
Err.Raise vbObjectError + 521, , "Error reading value names"
End If
End Sub

Public Sub OpenKey(ByVal Key As String, ByVal CanCreate As Boolean)
Dim Result As Long

CloseKey
If CanCreate Then
Result = RegCreateKey(mRootKey, Key, mCurrentKey)
Else
Result = RegOpenKeyEx(mRootKey, Key, 0&, mAccess, mCurrentKey)
End If
If Result = ERROR_SUCCESS Then
mCurrentPath = Key
mIsOpen = True
Else
Err.Raise vbObjectError + 513, , "Cannot open key: " & Key
End If
End Sub

Public Function ReadBool(ByVal Name As String) As Boolean
If ReadLong(Name) = 0 Then
ReadBool = False
Else
ReadBool = True
End If
End Function

Public Function ReadLong(ByVal Name As String) As Long
Dim DataType As Long
Dim Value As Long
Dim ValueLength As Long

ValueLength = 4
If RegQueryValueExLong(mCurrentKey, Name, 0&, DataType, Value,
ValueLength) = ERROR_SUCCESS Then
If DataType = REG_DWORD Then
ReadLong = Value
Else
Err.Raise vbObjectError + 515, , "Not a DWORD value: " & Name
End If
Else
Err.Raise vbObjectError + 515, , "Cannot read DWORD value: " & Name
End If
End Function

Public Function ReadString(ByVal Name As String) As String
Dim DataType As Long
Dim Value As String
Dim ValueLength As Long
Dim Result As Long

Result = RegQueryValueExString(mCurrentKey, Name, 0&, DataType,
vbNullString, ValueLength)
If Result = ERROR_SUCCESS Then
Value = Space(ValueLength)
Result = RegQueryValueExString(mCurrentKey, Name, 0&, DataType, Value,
ValueLength)
If Result = ERROR_SUCCESS Then
Select Case DataType
Case REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ
ReadString = Left(Value, ValueLength - 1)
Case Else
Err.Raise vbObjectError + 515, , "Not a string value: " & Name
End Select
End If
End If
If Result <> ERROR_SUCCESS Then
Err.Raise vbObjectError + 515, , "Cannot read string value: " & Name
End If
End Function

Public Function WriteBool(ByVal Name As String, ByVal Value As Boolean)
If Value Then
WriteLong Name, 1
Else
WriteLong Name, 0
End If
End Function

Public Sub WriteLong(ByVal Name As String, ByVal Value As Long)
Dim ValueLength As Long

ValueLength = 4
If RegSetValueExLong(mCurrentKey, Name, 0&, REG_DWORD, Value, ValueLength)
<> ERROR_SUCCESS Then
Err.Raise vbObjectError + 517, , "Cannot write DWORD value: " & Name
End If
End Sub

Public Sub WriteString(ByVal Name As String, ByVal Value As String)
Dim ValueLength As Long

Value = Value + Chr(0)
ValueLength = Len(Value)
If RegSetValueExString(mCurrentKey, Name, 0&, REG_SZ, Value, ValueLength)
<> ERROR_SUCCESS Then
Err.Raise vbObjectError + 517, , "Cannot write string value: " & Name
End If
End Sub

Public Function ValueExists(ByVal Name As String)
Dim ValueLength As Long
Dim Result As Long

Result = RegQueryValueExString(mCurrentKey, Name, 0&, 0&, 0&, 0&)
ValueExists = Result <> ERROR_BADKEY
End Function

' PROPERTIES
Public Property Get Access() As ACCESSTYPE
Access = mAccess
End Property

Public Property Let Access(ByVal Value As ACCESSTYPE)
mAccess = Value
End Property

Public Property Get CurrentKey() As Long
CurrentKey = mCurrentKey
End Property

Public Property Get CurrentPath() As String
CurrentPath = mCurrentPath
End Property

Public Property Get RootKey() As ROOTKEYS
RootKey = mRootKey
End Property

Public Property Let RootKey(ByVal Value As ROOTKEYS)
CloseKey
mRootKey = Value
mRootKeyBackup = Value
End Property

Public Property Get RemoteMachine() As String
RemoteMachine = mRemoteMachine
End Property

Public Property Let RemoteMachine(ByVal Value As String)
Dim Result As Long

mRemoteMachine = Value
Result = RegConnectRegistry(mRemoteMachine, mRootKey, mRootKey)
If Result <> ERROR_SUCCESS Then
Err.Raise vbObjectError + 513, "CRegistry", "Cannot connect to registry"
End If
End Property
------------ END FILE ---------------