asked on

Simple & robust REGISTRY setting function

I have a problem writing to the registry on a certain machine. I don't wish to use the GetSetting and SaveSetting VB 6.0 functions as they save in the current_user node of the registry (a pain when multiple users on an NT machine log on and have to set the program parameters each time)

I have a good little function:

Public Function Registry(VariableName As String, VariableValue As Variant, Writing As Boolean) As Variant
On Error Resume Next
Dim WSHShell As Object
Set WSHShell = CreateObject("WScript.Shell")
If Writing = True Then
'Write values:
WSHShell.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\OmniTerm\" & Trim(VariableName), VariableValue
Registry = ""
Else
'Read values:
Registry = WSHShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\OmniTerm\" & Trim(VariableName))
' Set defaults, can be passed from calling code
If Registry = Empty Then WSHShell.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\OmniTerm\" & VariableName, VariableValue: Registry = VariableValue
End If
Set WSHShell = Nothing
If Err Then Debug.Print Error$ 'Do not report, always err's if registry empty
End Function

This is cool because in reading a value from the registry I can assign a default value if it has not been set. HOWEVER for some reason some NT installs don't like me using wscript.exe

Is there a nice simple API call I can make (avoiding pages and pages of code which someone once suggested)
which works in all circumstances?

Cheers

Stewart

CJ_S

You will need to use several API functions to read and write to the registry. I favor using a class module to achieve the registry results. You have all the necessary code in one file from which you do not have to worry about the code. If you want a wrapper, just ask.

Regards,
CJ

nvms

ASKER

ask :)

try that

' =========================================================
' Class: cRegistry
' Author: Steve McMahon
' Date : 21 Feb 1997
'
' A nice class wrapper around the registry functions
' Allows searching,deletion,modification and addition
' of Keys or Values.
'
' Updated 29 April 1998 for VB5.
' * Fixed GPF in EnumerateValues
' * Added support for all registry types, not just strings
' * Put all declares in local class
' * Added VB5 Enums
' * Added CreateKey and DeleteKey methods
'
' Updated 2 January 1999
' * The CreateExeAssociation method failed to set up the
' association correctly if the optional document icon
' was not provided.
' * Added new parameters to CreateExeAssociation to set up
' other standard handlers: Print, Add, New
' * Provided the CreateAdditionalEXEAssociations method
' to allow non-standard menu items to be added (for example,
' right click on a .VBP file. VB installs Run and Make
' menu items).
'
' Updated 8 February 2000
' * Ensure CreateExeAssociation and related items sets up the
' registry keys in the
' HKEY_LOCAL_MACHINE\SOFTWARE\Classes
' branch as well as the HKEY_CLASSES_ROOT branch.
'
' ---------------------------------------------------------------------------
' vbAccelerator - free, advanced source code for VB programmers.
' http://vbaccelerator.com
' =========================================================

'To get a String Value from the Registry
'
' Dim c As New cRegistry
' With c
' .ClassKey = HKEY_LOCAL_MACHINE
' .SectionKey = "Software\MyApp\Tips"
' .ValueKey = "Tip1"
' .ValueType = REG_SZ
' sTip = .Value
' End With
'
'
'To get a Numeric Value from the Registry
'
'
' Dim c As New cRegistry
' With c
' .ClassKey = HKEY_LOCAL_MACHINE
' .SectionKey = "Software\MyApp\Tips"
' .ValueKey = "TipCount"
' .ValueType = REG_DWORD
' lTipCount = .Value
' End With
'
'
'To Save a Form's position to the Registry
'
'
' Dim c As New cRegistry
' With c
' .ClassKey = HKEY_CURRENT_USER
' ' You don't need to check if this key already exists
' ' - the class will create it for you
' .SectionKey = "Software\" & App.EXEName & "\" & frmThis.Name
' .ValueKey = "Maximized"
' .ValueType = REG_DWORD
' .Value = (frmThis.WindowState = vbMaximized)
' If (frmThis.WindowState <> vbMaximized)
' .ValueKey = "Left"
' .Value = frmThis.Left
' .ValueKey = "Top"
' .Value = frmThis.Top
' .ValueKey = "Width"
' .Value = frmThis.Width
' .ValueKey = "Height"
' .Value = frmThis.Height
' End If
' End With
'
'
'To Get All The SubKeys of a Key
'Getting all the values with a key is achieved in a similar way, except you use EnumerateValues instead of EnumerateSections
'
'
'
' Dim c As New cRegistry
' Dim sKeys() As String, iKeyCount As Long
'
' With c
' .ClassKey = HKEY_LOCAL_MACHINE
' .SectionKey = "Software"
' .EnumerateSections(sKeys(), iKeyCount)
' For iKey = 1 To iKeyCount
' Debug.Print sKeys(iKey)
' Next iKey
' End With
'
'
'To Delete a Key
'
'
' Dim c As New cRegistry
' With c
' .ClassKey = HKEY_LOCAL_MACHINE
' .SectionKey = "Software\MyApp\Tips"
' .DeleteKey
' End With
'
'
'To Associate a File of type .CCD with your executable
'
'
' Dim c As New cRegistry
' With c
' .CreateEXEAssociation _
' App.Path & "\" & App.EXEName, _
' "CCarDesign.Project", _
' "Custom Car Designer Project", _
' "CCD"
' End With
'
'
'To Delete a Value
'
' Dim c As New cRegistry
' With c
' .ClassKey = HKEY_LOCAL_MACHINE
' .SectionKey = "Software\MyApp\Tips"
' .SectionKey = "Tip1"
' .DeleteValue
' End With
'
'
'
'To Read BINARY values from the registry
'Binary values are returned as a variant of type byte array. This code demonstrates how to format the returned value into a string of hexadecimal values, similar to the display provided in RegEdit:
'
' Dim cR As New cRegistry
' Dim iByte As Long
' Dim vR As Variant
'
' With cR
' .ClassKey = HKEY_CURRENT_USER
' .SectionKey = "Control Panel\Appearance"
' .ValueKey = "CustomColors"
' vR = .Value
'
' If .ValueType = REG_BINARY Then
' ' Read through the byte array and output it as a series of hex values:
' For iByte = LBound(vR) To UBound(vR)
' sOut = sOut & "&H"
' If (iByte < &H10) Then
' sOut = sOut & "0"
' End If
' sOut = sOut & Hex$(vR(iByte)) & " "
' Next iByte
' Else
' sOut = vR
' End If
'
' Debug.Print sOut
' End With
'
'
'
'To Set BINARY values from the registry
'Similarly, to store binary values in the registry, cRegistry.cls expects a byte array of the binary values you wish to store. This example (rather uselessly!) stores all the Red, Green, Blue values of each of VB's QBColors into a binary array:
'
' Dim cR As New cRegistry
' Dim i As Long
' Dim lC As Long
' Dim bR As Byte
' Dim bG As Byte
' Dim bB As Byte
' Dim bOut() As Byte
'
' ' Create a binary array containing all the Red,Green,Blue values of the QBColors:
' ReDim bOut(0 To 15 * 3 - 1) As Byte
' For i = 1 To 15
' ' Get the Red, Green, Blue for the QBColor at index i:
' lC = QBColor(i)
' bR = (lC And &HFF&)
' bG = ((lC And &HFF00&) \ &H100&)
' bB = ((lC And &HFF0000) \ &H10000)
'
' ' Add Red, Green, Blue to the byte array to store:
' bOut((i - 1) * 3) = bR
' bOut((i - 1) * 3 + 1) = bG
' bOut((i - 1) * 3 + 2) = bB
' Next i
'
' ' Store it:
' With cR
' .ClassKey = HKEY_CURRENT_USER
' .SectionKey = "software\vbaccelerator\cRegistry\Binary Test"
' .ValueKey = "QBColors"
' .ValueType = REG_BINARY
' .Value = bOut()
' End With

'Registry Specific Access Rights
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private Const KEY_ALL_ACCESS = &H3F

'Open/Create Options
Private Const REG_OPTION_NON_VOLATILE = 0&
Private Const REG_OPTION_VOLATILE = &H1

'Key creation/open disposition
Private Const REG_CREATED_NEW_KEY = &H1
Private Const REG_OPENED_EXISTING_KEY = &H2

'masks for the predefined standard access types
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const SPECIFIC_RIGHTS_ALL = &HFFFF

'Define severity codes
Private Const ERROR_SUCCESS = 0&
Private Const ERROR_ACCESS_DENIED = 5
Private Const ERROR_INVALID_DATA = 13&
Private Const ERROR_MORE_DATA = 234 ' dderror
Private Const ERROR_NO_MORE_ITEMS = 259

'Structures Needed For Registry Prototypes
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Boolean
End Type

Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

'Registry Function Prototypes
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 RegSetValueExStr Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal szData 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, szData As Long, ByVal cbData As Long) As Long
Private Declare Function RegSetValueExByte Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, szData As Byte, ByVal cbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegQueryValueExStr Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal szData As String, ByRef 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, ByRef lpType As Long, szData As Long, ByRef lpcbData As Long) As Long
Private Declare Function RegQueryValueExByte Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, szData As Byte, ByRef lpcbData As Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition As Long) As Long
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As FILETIME) 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, ByVal lpType As Long, ByVal lpData As Long, ByVal lpcbData As Long) As Long
Private Declare Function RegEnumValueLong 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 Long, lpcbData As Long) As Long
Private Declare Function RegEnumValueStr 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 RegEnumValueByte 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
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 Any) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long

' Other declares:
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Private Declare Function ExpandEnvironmentStrings Lib "kernel32" Alias "ExpandEnvironmentStringsA" (ByVal lpSrc As String, ByVal lpDst As String, ByVal nSize As Long) As Long

Public Enum ERegistryClassConstants
HKEY_CLASSES_ROOT = &H80000000
HKEY_CURRENT_USER = &H80000001
HKEY_LOCAL_MACHINE = &H80000002
HKEY_USERS = &H80000003
End Enum

Public Enum ERegistryValueTypes
'Predefined Value Types
REG_NONE = (0) 'No value type
REG_SZ = (1) 'Unicode nul terminated string
REG_EXPAND_SZ = (2) 'Unicode nul terminated string w/enviornment var
REG_BINARY = (3) 'Free form binary
REG_DWORD = (4) '32-bit number
REG_DWORD_LITTLE_ENDIAN = (4) '32-bit number (same as REG_DWORD)
REG_DWORD_BIG_ENDIAN = (5) '32-bit number
REG_LINK = (6) 'Symbolic Link (unicode)
REG_MULTI_SZ = (7) 'Multiple Unicode strings
REG_RESOURCE_LIST = (8) 'Resource list in the resource map
REG_FULL_RESOURCE_DESCRIPTOR = (9) 'Resource list in the hardware description
REG_RESOURCE_REQUIREMENTS_LIST = (10)
End Enum

Private m_hClassKey As Long
Private m_sSectionKey As String
Private m_sValueKey As String
Private m_vValue As Variant
Private m_sSetValue As String
Private m_vDefault As Variant
Private m_eValueType As ERegistryValueTypes

andyclap

Note that registry permissions are set at an NT user level, so you still might get problems using the API to change settings if the logged on user doesn't have the required access level.

ASKER CERTIFIED SOLUTION

CJ_S

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Hearing...

I found something in the net. To me, that is the most simple way:
The page is in japanese but code is in plain VB.
http://plaza5.mbn.or.jp/~heropa/vb123.htm

Netminder

There has been no activity in this question in quite some time, and it looks like it has been abandoned. As part of our ongoing mission to clean up the topic areas, a Moderator will finalize this question within the next seven (7) days. At that time, either I or one of the other Moderators will force/accept the comment of CJ_S.

DO NOT ACCEPT THIS COMMENT AS AN ANSWER. If you have further comments on this question or the recommendation, please leave them here.

Thanks,

Netminder
Community Support Moderator
Experts Exchange

Netminder

nvms,

You last logged in on 1/14/2002, and you have disregarded our requests for you to clean up your open questions. I am therefore force/accepting a comment to close this question.

Netminder
Community Support Moderator
Experts Exchange

Richie_Simonetti

Simple... uh?

Netminder

Richie,

I wish. Considering the backlog of open questions in VB goes back to March of last year, this is what it's coming down to, though.

Netminder

Simple &amp; robust REGISTRY setting function

Simple & robust REGISTRY setting function