Writing to and Reading from the registry

Hi,
I am writing a piece of Security software to replace the glitchy, crappy windows policy editor (poledit). It is only when I come to writing the code for the policys that I realise that the 'GetSetting' and 'WriteSetting' function that I realise it can only be used to write to 'HKEY_CURRENT_USER/Software/VB/product/'. Could someone please recommend a way of writing to the registry wherever I want.

Thanks for any replies in advanced
Regards
S Roberts

You will need to use the API function for it

Add a new module to your project, and insert this in it:

VB Code:

Option Explicit
Public Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type
 
Public Declare Function RegCloseKey _
  Lib "advapi32.dll" _
  (ByVal lngHKey As Long) _
  As Long
 
Public Declare Function RegCreateKeyEx _
  Lib "advapi32.dll" _
  Alias "RegCreateKeyExA" _
  (ByVal lngHKey As Long, _
    ByVal lpSubKey As String, _
    ByVal Reserved As Long, _
    ByVal lpClass As String, _
    ByVal dwOptions As Long, _
    ByVal samDesired As Long, _
    ByVal lpSecurityAttributes As Long, _
    phkResult As Long, _
    lpdwDisposition As Long) _
  As Long
 
Public Declare Function RegOpenKeyEx _
  Lib "advapi32.dll" _
  Alias "RegOpenKeyExA" _
  (ByVal lngHKey As Long, _
    ByVal lpSubKey As String, _
    ByVal ulOptions As Long, _
    ByVal samDesired As Long, _
    phkResult As Long) _
  As Long
 
Public Declare Function RegQueryValueExString _
  Lib "advapi32.dll" _
  Alias "RegQueryValueExA" _
  (ByVal lngHKey As Long, _
    ByVal lpValueName As String, _
    ByVal lpReserved As Long, _
    lpType As Long, _
    ByVal lpData As String, _
    lpcbData As Long) _
  As Long
 
Public Declare Function RegQueryValueExLong _
  Lib "advapi32.dll" _
  Alias "RegQueryValueExA" _
  (ByVal lngHKey As Long, _
    ByVal lpValueName As String, _
    ByVal lpReserved As Long, _
    lpType As Long, _
    lpData As Long, _
    lpcbData As Long) _
  As Long
 
Public Declare Function RegQueryValueExBinary _
  Lib "advapi32.dll" _
  Alias "RegQueryValueExA" _
  (ByVal lngHKey As Long, _
    ByVal lpValueName As String, _
    ByVal lpReserved As Long, _
    lpType As Long, _
    ByVal lpData As Long, _
    lpcbData As Long) _
  As Long
  
Public Declare Function RegQueryValueExNULL _
  Lib "advapi32.dll" _
  Alias "RegQueryValueExA" _
  (ByVal lngHKey As Long, _
    ByVal lpValueName As String, _
    ByVal lpReserved As Long, _
    lpType As Long, _
    ByVal lpData As Long, _
    lpcbData As Long) _
  As Long
 
Public Declare Function RegSetValueExString _
  Lib "advapi32.dll" _
  Alias "RegSetValueExA" _
  (ByVal lngHKey As Long, _
    ByVal lpValueName As String, _
    ByVal Reserved As Long, _
    ByVal dwType As Long, _
    ByVal lpValue As String, _
    ByVal cbData As Long) _
  As Long
 
Public Declare Function RegSetValueExLong _
  Lib "advapi32.dll" _
  Alias "RegSetValueExA" _
  (ByVal lngHKey As Long, _
    ByVal lpValueName As String, _
    ByVal Reserved As Long, _
    ByVal dwType As Long, _
    lpValue As Long, _
    ByVal cbData As Long) _
  As Long
 
Public Declare Function RegSetValueExBinary _
  Lib "advapi32.dll" _
  Alias "RegSetValueExA" _
  (ByVal lngHKey As Long, _
    ByVal lpValueName As String, _
    ByVal Reserved As Long, _
    ByVal dwType As Long, _
    ByVal lpValue As Long, _
    ByVal cbData As Long) _
  As Long
  
Public Declare Function RegEnumKey _
  Lib "advapi32.dll" _
  Alias "RegEnumKeyA" _
  (ByVal lngHKey As Long, _
    ByVal dwIndex As Long, _
    ByVal lpName As String, _
    ByVal cbName As Long) _
  As Long
 
Public Declare Function RegQueryInfoKey _
  Lib "advapi32.dll" _
  Alias "RegQueryInfoKeyA" _
  (ByVal lngHKey As Long, _
    ByVal lpClass As String, _
    ByVal lpcbClass As Long, _
    ByVal lpReserved As Long, _
    lpcSubKeys As Long, _
    lpcbMaxSubKeyLen As Long, _
    ByVal lpcbMaxClassLen As Long, _
    lpcValues As Long, _
    lpcbMaxValueNameLen As Long, _
    ByVal lpcbMaxValueLen As Long, _
    ByVal lpcbSecurityDescriptor As Long, _
    lpftLastWriteTime As FILETIME) _
  As Long
 
Public Declare Function RegEnumValue _
  Lib "advapi32.dll" _
  Alias "RegEnumValueA" _
  (ByVal lngHKey As Long, _
    ByVal dwIndex As Long, _
    ByVal lpValueName As String, _
    lpcbValueName As Long, _
    ByVal lpReserved As Long, _
    ByVal lpType As Long, _
    ByVal lpData As Byte, _
    ByVal lpcbData As Long) _
  As Long
 
Public Declare Function RegDeleteKey _
  Lib "advapi32.dll" _
  Alias "RegDeleteKeyA" _
  (ByVal lngHKey As Long, _
    ByVal lpSubKey As String) _
  As Long
 
Public Declare Function RegDeleteValue _
  Lib "advapi32.dll" _
  Alias "RegDeleteValueA" _
  (ByVal lngHKey As Long, _
    ByVal lpValueName As String) _
  As Long
 
Public Enum EnumRegistryRootKeys
  rrkHKeyClassesRoot = &H80000000
  rrkHKeyCurrentUser = &H80000001
  rrkHKeyLocalMachine = &H80000002
  rrkHKeyUsers = &H80000003
End Enum
 
Public Enum EnumRegistryValueType
  rrkRegSZ = 1
  rrkregBinary = 3
  rrkRegDWord = 4
End Enum
 
Public Const mcregOptionNonVolatile = 0
 
Public Const mcregErrorNone = 0
Public Const mcregErrorBadDB = 1
Public Const mcregErrorBadKey = 2
Public Const mcregErrorCantOpen = 3
Public Const mcregErrorCantRead = 4
Public Const mcregErrorCantWrite = 5
Public Const mcregErrorOutOfMemory = 6
Public Const mcregErrorInvalidParameter = 7
Public Const mcregErrorAccessDenied = 8
Public Const mcregErrorInvalidParameterS = 87
Public Const mcregErrorNoMoreItems = 259
 
Public Const mcregKeyAllAccess = &H3F
Public Const mcregKeyQueryValue = &H1
 
Public Function RegistryGetKeyValue( _
  eRootKey As EnumRegistryRootKeys, _
  strKeyName As String, _
  strValueName As String) _
  As Variant
  ' Comments  : Returns a value from the system registry
  ' Parameters: eRootKey - The root key
  '             strKeyName - The name of the key
  '             strValueName - The name of the value
  ' Returns   : The data in the registry value
  '
  Dim lngRetVal As Long
  Dim lngHKey As Long
  Dim varValue As Variant
  Dim strValueData As String
  Dim abytValueData() As Byte
  Dim lngValueData As Long
  Dim lngValueType As Long
  Dim lngDataSize As Long
  
  On Error GoTo PROC_ERR
  
  varValue = Empty
  
  lngRetVal = RegOpenKeyEx(eRootKey, strKeyName, 0&, mcregKeyQueryValue, _
    lngHKey)
  
  If mcregErrorNone = lngRetVal Then
    
    lngRetVal = RegQueryValueExNULL(lngHKey, strValueName, 0&, lngValueType, _
      0&, lngDataSize)
    
    If lngRetVal = mcregErrorNone Then
      
      Select Case lngValueType
      
      ' String type
 
        Case rrkRegSZ:
          If lngDataSize > 0 Then
            strValueData = String(lngDataSize, 0)
            lngRetVal = RegQueryValueExString(lngHKey, strValueName, 0&, _
              lngValueType, strValueData, lngDataSize)
            If InStr(strValueData, vbNullChar) > 0 Then
              strValueData = Mid$(strValueData, 1, InStr(strValueData, _
                vbNullChar) - 1)
            End If
          End If
          If mcregErrorNone = lngRetVal Then
            varValue = Left$(strValueData, lngDataSize)
          Else
            varValue = Empty
          End If
        
        ' Long type
        Case rrkRegDWord:
          lngRetVal = RegQueryValueExLong(lngHKey, strValueName, 0&, _
            lngValueType, lngValueData, lngDataSize)
          If mcregErrorNone = lngRetVal Then
            varValue = lngValueData
          End If
                
        ' Binary type
        Case rrkregBinary
          If lngDataSize > 0 Then
            ReDim abytValueData(lngDataSize) As Byte
            lngRetVal = RegQueryValueExBinary(lngHKey, strValueName, 0&, _
              lngValueType, VarPtr(abytValueData(0)), lngDataSize)
          End If
          If mcregErrorNone = lngRetVal Then
            varValue = abytValueData
          Else
            varValue = Empty
          End If
                
        Case Else
          'No other data types supported
          lngRetVal = -1
        
      End Select
      
    End If
    
    RegCloseKey (lngHKey)
  End If
  
  'Return varValue
  RegistryGetKeyValue = varValue
PROC_EXIT:
  Exit Function
 
PROC_ERR:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
    "RegistryGetKeyValue"
  Resume PROC_EXIT
End Function
 
Public Sub RegistrySetKeyValue( _
  eRootKey As EnumRegistryRootKeys, _
  strKeyName As String, _
  strValueName As String, _
  varData As Variant, _
  eDataType As EnumRegistryValueType)
  ' Comments  : This procedure sets a key value
  ' Parameters: eRootKey - The root key
  '             strKeyName - The name of the key
  '             strValueName - The name of the value
  '             varData - The data to store in the value
  '             eDataType - The type of data to store in the value
  ' Returns   : Nothing
  '
  Dim lngRetVal As Long
  Dim lngHKey As Long
  Dim strData As String
  Dim lngData As Long
  Dim abytData() As Byte
    
  On Error GoTo PROC_ERR
  
  ' Open the specified key, if it does not exist then create it
  lngRetVal = RegCreateKeyEx(eRootKey, strKeyName, 0&, vbNullString, _
    mcregOptionNonVolatile, mcregKeyAllAccess, 0&, lngHKey, 0&)
  
  ' Determine the data type of the key
  Select Case eDataType
  
  Case rrkRegSZ
    strData = varData & vbNullChar
    lngRetVal = RegSetValueExString(lngHKey, strValueName, 0&, eDataType, _
      strData, Len(strData))
    
  Case rrkRegDWord
    lngData = varData
    lngRetVal = RegSetValueExLong(lngHKey, strValueName, 0&, eDataType, _
      lngData, Len(lngData))
  
  ' Binary type
  Case rrkregBinary
    abytData = varData
    lngRetVal = RegSetValueExBinary(lngHKey, strValueName, 0&, eDataType, _
      VarPtr(abytData(0)), UBound(abytData) + 1)
  
  End Select
  
  RegCloseKey (lngHKey)
    
PROC_EXIT:
  Exit Sub
 
PROC_ERR:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , _
    "RegistrySetKeyValue"
  Resume PROC_EXIT
    
End Sub

Usage:

VB Code:

'Example of usage
Call RegistrySetKeyValue(rrkHKeyCurrentUser, "Software\Microsoft...", "Pen Color", DecFore.Text, rrkRegDWord)

Good luck

Thanks very much. Also I wonder if you could answer this question:

Is there anyway that I can obtain a list of users that are use the machine and put them into an array

Thanks
S Roberts