Writing in HKEY_LOCAL_MACHINE...Access is denied - Page 2


DevX Home    Today's Headlines   Articles Archive   Tip Bank   Forums   

Page 2 of 2 FirstFirst 12
Results 16 to 23 of 23

Thread: Writing in HKEY_LOCAL_MACHINE...Access is denied

  1. #16
    Michael Culley Guest

    Re: Writing in HKEY_LOCAL_MACHINE...Access is denied

    Bernie,

    I tried you code and could not get it to work in win2000. I was using the
    guest account and kept getting an message saying I did not have access. Am I
    doing something wrong?

    --
    Michael Culley
    www.vbdotcom.com


    "Bernie" <magnus.bernroth@rejlers.se> wrote in message
    news:3c04cbb3$1@147.208.176.211...
    >
    > "Bernie" <magnus.bernroth@rejlers.se> wrote:
    > >
    > >Hi,
    > >
    > >You should run the API RegCreateKeyEx with the flags

    REG_OPTION_NON_VOLATILE
    > >and (KEY_CREATE_SUB_KEY Or KEY_SET_VALUE) to let users without admin

    rights
    > >be able to create/write in the registry.
    > >
    > >Most samples on how RegCreateKeyEx works requests the highest possible

    rights
    > >wich works great on Win9X but returns Errcode 5 on NT-systems. By doing

    > so
    > >the user can write virtually everywhere in the registry, at least those

    > ordinary
    > >places like hkey\local machine\Software... or hkey\current

    user\software...
    > >
    > >Bu no means start juggeling with the user's rights...
    > >
    > >Bernie

    >
    > Well, what the heck. Try this code. It's on the house!!
    >
    > Put it in a module and call it's varoius functions. There is a lot of

    comments
    > in it, especially concerning the aspect of rights!! Most of it works on

    9X,
    > NT, 2K and XP though some parts haven't been fully tested on all OS's yet
    > (see the notes inside). I guess the last function GetComputerName()

    explains
    > how to simply name the keys as strings...
    >
    >
    > Option Explicit
    >
    > 'Registry classes....
    > Private Const HKEY_CLASSES_ROOT = &H80000000
    > Private Const HKEY_CURRENT_USER = &H80000001
    > Private Const HKEY_LOCAL_MACHINE = &H80000002
    > Private Const HKEY_USERS = &H80000003
    >
    > 'Predefined value types (just a few of them used here)...
    > Private Const REG_NONE = (0) 'No value type
    > Private Const REG_SZ = (1) 'Unicode null

    terminated
    > string
    > Private Const REG_EXPAND_SZ = (2) 'Unicode null

    terminated
    > string with environment variable
    > Private Const REG_BINARY = (3) 'Binary format
    > Private Const REG_DWORD = (4) '32-bit number
    > Private Const REG_DWORD_LITTLE_ENDIAN = (4) '32-bit number (same
    > as REG_DWORD)
    > Private Const REG_DWORD_BIG_ENDIAN = (5) '32-bit number
    > Private Const REG_LINK = (6) 'Symbolic Link

    (unicode)
    > Private Const REG_MULTI_SZ = (7) 'Multiple Unicode

    strings
    > Private Const REG_RESOURCE_LIST = (8) 'Resource list in

    resource
    > map
    > Private Const REG_FULL_RESOURCE_DESCRIPTOR = (9) 'Resource list in

    hardware
    > description
    > Private Const REG_RESOURCE_REQUIREMENTS_LIST = (10) '??????
    >
    > Private Const REG_OPTION_NON_VOLATILE = 0
    >
    > 'This is a tricky part when i comes to NT/W2000 to
    > 'handle the security nicely. You should not need to
    > 'be an Admin to make use of the registry when running
    > 'an application. It is the programmers responsibility
    > 'to make these routines work properly...
    > Private Type SECURITY_ATTRIBUTES
    > nLength As Long
    > lpSecurityDescriptor As Long
    > bInheritHandle As Long
    > End Type
    >
    > Private Const KEY_QUERY_VALUE = &H1
    > Private Const KEY_SET_VALUE = &H2
    > Private Const KEY_CREATE_SUB_KEY = &H4
    >
    > 'Return values from API:s
    > Private Const ERROR_SUCCESS = 0&
    > Private Const ERROR_ACCESS_DENIED = 5&
    > Private Const ERROR_KEY_DOES_NOT_EXIST = 2&
    >
    > 'Predeclared API:s....
    > 'Creates a new key...
    > 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
    >
    > 'Opens the specific key for further action...
    > 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
    >
    > 'Gets type and data to from a value name associted with the open key...
    > Declare Function RegQueryValueEx 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
    >
    > 'Sets a new value to an open key...
    > Declare Function RegSetValueEx 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
    >
    > 'Closes the specified key...
    > Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As

    Long
    >
    > 'Deletes a value...
    > Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias

    "RegDeleteValueA"
    > (ByVal hKey As Long, ByVal lpValueName As String) As Long
    >
    > 'Deletes a key if no subkeys exist...
    > Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias

    "RegDeleteKeyA"
    > (ByVal hKey As Long, ByVal lpSubKey As String) As Long
    > '
    >
    > Private Function StripNullTerminator(KeyValue As String) As String
    >
    > 'KeyValue returned is a fixlength string (usually 255 spaces) which has

    been
    > populated
    > 'with the value returned from the API. It is populated from left to right
    > and the returned
    > 'value is terminated with chr(0). After that position only garbage exists.
    > So we search for
    > 'the first chr(0) and cut off everything from that position.
    >
    > Dim FirstNullPosition As Integer
    >
    > FirstNullPosition = InStr(1, KeyValue, vbNullChar)
    > StripNullTerminator = Left(KeyValue, FirstNullPosition - 1)
    >
    > End Function
    >
    > Public Function GetRegistryValue(ByVal KeyName As String, ByVal ValueName
    > As String, Optional BufferSize As Long) As Variant
    >
    > 'Gets the value in ValueName from the registrybranch KeyName...
    > 'Returns a string with the value. If an error occures Null is returned...
    > 'If a large value is expected the buffer can be increased from its default
    > 255 bytes...
    >
    > Dim hKey As Long
    > Dim SubKey As String
    > Dim dataBuffer As String
    > Dim Result As Long
    > Dim RetVal As Long
    > Dim Value As String
    >
    >
    > 'Determine main key (hKey) and sub key (SubKey) from KeyName...
    > If InStr(1, KeyName, "HKEY_CLASSES_ROOT\", vbTextCompare) = 1 Then
    > hKey = HKEY_CLASSES_ROOT
    > SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_CLASSES_ROOT\"))
    > ElseIf InStr(1, KeyName, "HKEY_CURRENT_USER\", vbTextCompare) = 1 Then
    > hKey = HKEY_CURRENT_USER
    > SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_CURRENT_USER\"))
    > ElseIf InStr(1, KeyName, "HKEY_LOCAL_MACHINE\", vbTextCompare) = 1

    Then
    > hKey = HKEY_LOCAL_MACHINE
    > SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_LOCAL_MACHINE\"))
    > ElseIf InStr(1, KeyName, "HKEY_USERS\", vbTextCompare) = 1 Then
    > hKey = HKEY_USERS
    > SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_USERS\"))
    > Else
    > 'Invalid KeyName...
    > GoTo GetRegistryValueError
    > End If
    >
    > 'Create string with spaces as a buffer to be filled by the API...
    > If BufferSize < 255 Then BufferSize = 255
    > dataBuffer = Space(BufferSize)
    >
    >
    > 'Open the key for reading only...
    > RetVal = RegOpenKeyEx(hKey, SubKey, 0, KEY_QUERY_VALUE, Result)
    >
    >
    > If RetVal = ERROR_ACCESS_DENIED Then
    > MsgBox "ERROR: Unauthorized attempt to read in registry!",

    vbCritical,
    > "ACCESSVIOLATION"
    > GoTo GetRegistryValueError
    > ElseIf RetVal = ERROR_SUCCESS Then
    > 'Try to fill up dataBuffer with the value in ValueName...
    > 'It doesn't matter if it was stored as a string or as binary, it
    > is copied
    > 'into the spacestring in dataBuffer as a binarystring ended with
    > chr(0) anyway...
    > RetVal = RegQueryValueEx(Result, ValueName, 0, 0, dataBuffer,

    BufferSize)
    > If RetVal = ERROR_SUCCESS Then
    > 'ValueName was found and the value in it is now in the

    beginning
    > of dataBuffer...
    > 'Se StripNullTerminator on how to extract it...
    > GetRegistryValue = StripNullTerminator(dataBuffer)
    > Else
    > 'ValueName was not found...
    > GoTo GetRegistryValueError
    > End If
    > Else
    > GoTo GetRegistryValueError
    > End If
    >
    >
    >
    > GetRegistryValueExit:
    >
    > On Error Resume Next
    >
    > RegCloseKey hKey
    > RegCloseKey Result
    >
    > Exit Function
    >
    > GetRegistryValueError:
    >
    > GetRegistryValue = Null
    > GoTo GetRegistryValueExit
    >
    > End Function
    >
    > Public Function SetRegistryValue(ByVal KeyName As String, ByVal ValueName
    > As String, ByVal Value As String, Optional BinaryValue As Boolean) As

    Boolean
    >
    > 'Sets ValueName in branch KeyName to Value. If it does not exist it is

    created...
    > 'Returns True if success, otherwise False...
    >
    > 'If BinaryValue = False, Value sets as a string, otherwise as binary...
    > 'The binary value has to be supplied in a string though...
    >
    > Dim hKey As Long
    > Dim SubKey As String
    > Dim Result As Long
    > Dim RetVal As Long
    > Dim RegType As Long
    > Dim SecAttrib As SECURITY_ATTRIBUTES
    > Dim Disp As Long
    >
    > 'ATTENTION: To remove the value a zerolength string can be passed for
    > 'Win9X. But if that is done with NT4/W2000 the system goes bezerk.

    Putting
    > 'a chr(0) in the empty string makes it work in all systems. Don't ask
    > me why,
    > '-When it works I don't spend any more time thinking of why...
    > If Len(Value) = 0 Then Value = Chr(0)
    >
    >
    > 'Determine main key (hKey) and sub key (SubKey) from KeyName...
    > If InStr(1, KeyName, "HKEY_CLASSES_ROOT\", vbTextCompare) = 1 Then
    > hKey = HKEY_CLASSES_ROOT
    > SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_CLASSES_ROOT\"))
    > ElseIf InStr(1, KeyName, "HKEY_CURRENT_USER\", vbTextCompare) = 1 Then
    > hKey = HKEY_CURRENT_USER
    > SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_CURRENT_USER\"))
    > ElseIf InStr(1, KeyName, "HKEY_LOCAL_MACHINE\", vbTextCompare) = 1

    Then
    > hKey = HKEY_LOCAL_MACHINE
    > SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_LOCAL_MACHINE\"))
    > ElseIf InStr(1, KeyName, "HKEY_USERS\", vbTextCompare) = 1 Then
    > hKey = HKEY_USERS
    > SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_USERS\"))
    > Else
    > 'Invalid KeyName...
    > GoTo SetRegistryValueError
    > End If
    >
    >
    > 'Open the key (creates it if it does not exist)...
    > 'Note that authority asked for is a mix of flags (KEY_CREATE_SUB_KEY
    > Or KEY_SET_VALUE)
    > 'which is no more than you need for creating and writing in the

    registry.
    > All samples I
    > 'have seen used KEY_ALL_ACCESS but in NT4/W2000 you must be Admin to
    > get it. In Win9X it
    > 'does not matter though...
    > RetVal = RegCreateKeyEx(hKey, SubKey, 0, "REG_DWORD",

    REG_OPTION_NON_VOLATILE,
    > (KEY_CREATE_SUB_KEY Or KEY_SET_VALUE), SecAttrib, Result, Disp)
    >
    > Select Case RetVal
    > Case ERROR_ACCESS_DENIED
    > 'Probably NT and somewhere you should not be messing around...
    > MsgBox "ERROR: Unauthorized attempt to write in registry!",

    vbCritical,
    > "ACCESSVIOLATION"
    > GoTo SetRegistryValueError
    > Case ERROR_SUCCESS
    > Case Else
    > 'Unknown error...
    > MsgBox "ERROR: Unknown error when writing in registry!",

    vbCritical,
    > "REGISTRY ERROR"
    > GoTo SetRegistryValueError
    > End Select
    >
    > If BinaryValue = True Then
    > RegType = REG_BINARY
    > Else
    > RegType = REG_SZ
    > End If
    >
    > 'Put in the data...
    > RetVal = RegSetValueEx(Result, ValueName, 0, RegType, Value,

    CLng(Len(Value)
    > + 1))
    >
    > Select Case RetVal
    > Case ERROR_ACCESS_DENIED
    > MsgBox "ERROR: Unauthorized attempt to write in registry!",

    vbCritical,
    > "ACCESSVIOLATION"
    > GoTo SetRegistryValueError
    > Case ERROR_SUCCESS
    > Case Else
    > 'Unknown error...
    > MsgBox "ERROR: Unknown error when writing in registry!",

    vbCritical,
    > "REGISTRY ERROR"
    > GoTo SetRegistryValueError
    > End Select
    >
    > SetRegistryValue = True
    >
    > SetRegistryValueExit:
    >
    > On Error Resume Next
    >
    > 'Close the keys...
    > RegCloseKey hKey
    > RegCloseKey Result
    >
    > Exit Function
    >
    > SetRegistryValueError:
    >
    > SetRegistryValue = False
    > GoTo SetRegistryValueExit
    >
    > End Function
    >
    > Public Function DeleteRegistryValue(ByVal KeyName As String, ByVal

    ValueName
    > As String) As Boolean
    >
    > 'Deletes a complete ValueName and the value associated with it...
    > 'Returns True if succeded, otherwise False...
    >
    >
    > Dim hKey As Long
    > Dim SubKey As String
    > Dim Result As Long
    > Dim RetVal As Long
    >
    > 'Determine main key (hKey) and sub key (SubKey) from KeyName...
    > If InStr(1, KeyName, "HKEY_CLASSES_ROOT\", vbTextCompare) = 1 Then
    > hKey = HKEY_CLASSES_ROOT
    > SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_CLASSES_ROOT\"))
    > ElseIf InStr(1, KeyName, "HKEY_CURRENT_USER\", vbTextCompare) = 1 Then
    > hKey = HKEY_CURRENT_USER
    > SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_CURRENT_USER\"))
    > ElseIf InStr(1, KeyName, "HKEY_LOCAL_MACHINE\", vbTextCompare) = 1

    Then
    > hKey = HKEY_LOCAL_MACHINE
    > SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_LOCAL_MACHINE\"))
    > ElseIf InStr(1, KeyName, "HKEY_USERS\", vbTextCompare) = 1 Then
    > hKey = HKEY_USERS
    > SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_USERS\"))
    > Else
    > 'Invalid KeyName...
    > GoTo DeleteRegistryValueError
    > End If
    >
    > 'Open the key with Set_Value access...
    > 'Try this on NT/W2000!!! KEY_SET_VALUE should be sufficient according
    > to SDK documentation
    > 'but who knows that is true...
    > RetVal = RegOpenKeyEx(hKey, SubKey, 0, KEY_SET_VALUE, Result)
    >
    > Select Case RetVal
    > Case ERROR_ACCESS_DENIED
    > 'Probably NT and somewhere you should not be messing around...
    > MsgBox "ERROR: Unauthorized attempt to write in registry!",

    vbCritical,
    > "ACCESSVIOLATION"
    > GoTo DeleteRegistryValueError
    > Case ERROR_KEY_DOES_NOT_EXIST
    > 'Key does not exist...
    > GoTo DeleteRegistryValueError
    > Case ERROR_SUCCESS
    > Case Else
    > 'Unknown error...
    > MsgBox "ERROR: Unknown error when writing in registry!",

    vbCritical,
    > "REGISTRY ERROR"
    > GoTo DeleteRegistryValueError
    > End Select
    >
    > 'Delete the key's value
    > RetVal = RegDeleteValue(Result, ValueName)
    >
    > Select Case RetVal
    > Case ERROR_SUCCESS
    > 'ValueName was found and deleted...
    > DeleteRegistryValue = True
    > Case ERROR_KEY_DOES_NOT_EXIST
    > 'ValueName did not exist...
    > GoTo DeleteRegistryValueError
    > Case Else
    > 'Unknown error...
    > MsgBox "ERROR: Unknown error when writing in registry!",

    vbCritical,
    > "REGISTRY ERROR"
    > GoTo DeleteRegistryValueError
    > End Select
    >
    > DeleteRegistryValueExit:
    >
    > On Error Resume Next
    >
    > 'Close the keys...
    > RegCloseKey hKey
    > RegCloseKey Result
    >
    > Exit Function
    >
    >
    > DeleteRegistryValueError:
    >
    > DeleteRegistryValue = False
    > GoTo DeleteRegistryValueExit
    >
    > End Function
    >
    > Public Function DeleteRegistryKey(ByVal KeyName As String) As Boolean
    >
    > 'Deletes a key and all values associated with it.
    > 'Returns True if succeded, otherwise False...
    >
    > 'OS differences:
    > 'Win 9X Deletes each and every subkey as well...
    > 'Win NT/2000 Subkeys must not exist. These must first be handled
    > ' individually from bottom and up...
    >
    >
    > Dim hKey As Long
    > Dim SubKey As String
    > Dim Result As Long
    > Dim RetVal As Long
    >
    > 'Determine main key (hKey) and sub key (SubKey) from KeyName...
    > If InStr(1, KeyName, "HKEY_CLASSES_ROOT\", vbTextCompare) = 1 Then
    > hKey = HKEY_CLASSES_ROOT
    > SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_CLASSES_ROOT\"))
    > ElseIf InStr(1, KeyName, "HKEY_CURRENT_USER\", vbTextCompare) = 1 Then
    > hKey = HKEY_CURRENT_USER
    > SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_CURRENT_USER\"))
    > ElseIf InStr(1, KeyName, "HKEY_LOCAL_MACHINE\", vbTextCompare) = 1

    Then
    > hKey = HKEY_LOCAL_MACHINE
    > SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_LOCAL_MACHINE\"))
    > ElseIf InStr(1, KeyName, "HKEY_USERS\", vbTextCompare) = 1 Then
    > hKey = HKEY_USERS
    > SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_USERS\"))
    > Else
    > 'Invalid KeyName...
    > GoTo DeleteRegistryKeyError
    > End If
    >
    > 'Open the key...
    > 'Try this on NT/W2000!!! KEY_SET_VALUE may not be sufficient to delete
    > the key...
    > RetVal = RegOpenKeyEx(hKey, SubKey, 0, KEY_SET_VALUE, Result)
    >
    > Select Case RetVal
    > Case ERROR_ACCESS_DENIED
    > 'Probably NT and somewhere you should not be messing around...
    > MsgBox "ERROR: Unauthorized attempt to write in registry!",

    vbCritical,
    > "ACCESSVIOLATION"
    > GoTo DeleteRegistryKeyError
    > Case ERROR_KEY_DOES_NOT_EXIST
    > 'Specified key did not exist...
    > GoTo DeleteRegistryKeyError
    > Case ERROR_SUCCESS
    > Case Else
    > 'Unknown error...
    > MsgBox "ERROR: Unknown error when writing in registry!",

    vbCritical,
    > "REGISTRY ERROR"
    > GoTo DeleteRegistryKeyError
    > End Select
    >
    > 'Delete the key and all valuenames in it...
    > RetVal = RegDeleteKey(Result, "")
    >
    > Select Case RetVal
    > Case ERROR_SUCCESS
    > 'ValueName was found and deleted...
    > 'With Win9X all subkeys are deleted as well...
    > DeleteRegistryKey = True
    > Case ERROR_ACCESS_DENIED
    > 'Happens with NT/W2000 if there are any subkeys attached...
    > 'If so each of them has to be deleted individually from bottom
    > and up.
    > 'There is a newer API-function, SHDeleteKey in Shlwapi.dll,

    which
    > should
    > 'delete each and every subkey as this one does in Win9X, but
    > I haven't tried
    > 'it out yet...
    > GoTo DeleteRegistryKeyError
    > Case Else
    > '????...
    > GoTo DeleteRegistryKeyError
    > End Select
    >
    > DeleteRegistryKeyExit:
    >
    > On Error Resume Next
    >
    > 'Close the keys...
    > RegCloseKey hKey
    > RegCloseKey Result
    >
    > Exit Function
    >
    >
    > DeleteRegistryKeyError:
    >
    > DeleteRegistryKey = False
    > GoTo DeleteRegistryKeyExit
    >
    > End Function
    >
    > Public Function GetComputerName() As String
    >
    > 'Yeah, there is an API for this, but why not like this when it only
    > 'takes a single row of code to do it?
    >
    > GetComputerName =

    GetRegistryValue("HKEY_LOCAL_MACHINE\System\CurrentControlSet\Control\Comput
    erName\ComputerName",
    > "ComputerName")
    >
    > End Function
    >
    >




  2. #17
    Michael Culley Guest

    Re: Writing in HKEY_LOCAL_MACHINE...Access is denied

    Bernie,

    I tried you code and could not get it to work in win2000. I was using the
    guest account and kept getting an message saying I did not have access. Am I
    doing something wrong?

    --
    Michael Culley
    www.vbdotcom.com


    "Bernie" <magnus.bernroth@rejlers.se> wrote in message
    news:3c04cbb3$1@147.208.176.211...
    >
    > "Bernie" <magnus.bernroth@rejlers.se> wrote:
    > >
    > >Hi,
    > >
    > >You should run the API RegCreateKeyEx with the flags

    REG_OPTION_NON_VOLATILE
    > >and (KEY_CREATE_SUB_KEY Or KEY_SET_VALUE) to let users without admin

    rights
    > >be able to create/write in the registry.
    > >
    > >Most samples on how RegCreateKeyEx works requests the highest possible

    rights
    > >wich works great on Win9X but returns Errcode 5 on NT-systems. By doing

    > so
    > >the user can write virtually everywhere in the registry, at least those

    > ordinary
    > >places like hkey\local machine\Software... or hkey\current

    user\software...
    > >
    > >Bu no means start juggeling with the user's rights...
    > >
    > >Bernie

    >
    > Well, what the heck. Try this code. It's on the house!!
    >
    > Put it in a module and call it's varoius functions. There is a lot of

    comments
    > in it, especially concerning the aspect of rights!! Most of it works on

    9X,
    > NT, 2K and XP though some parts haven't been fully tested on all OS's yet
    > (see the notes inside). I guess the last function GetComputerName()

    explains
    > how to simply name the keys as strings...
    >
    >
    > Option Explicit
    >
    > 'Registry classes....
    > Private Const HKEY_CLASSES_ROOT = &H80000000
    > Private Const HKEY_CURRENT_USER = &H80000001
    > Private Const HKEY_LOCAL_MACHINE = &H80000002
    > Private Const HKEY_USERS = &H80000003
    >
    > 'Predefined value types (just a few of them used here)...
    > Private Const REG_NONE = (0) 'No value type
    > Private Const REG_SZ = (1) 'Unicode null

    terminated
    > string
    > Private Const REG_EXPAND_SZ = (2) 'Unicode null

    terminated
    > string with environment variable
    > Private Const REG_BINARY = (3) 'Binary format
    > Private Const REG_DWORD = (4) '32-bit number
    > Private Const REG_DWORD_LITTLE_ENDIAN = (4) '32-bit number (same
    > as REG_DWORD)
    > Private Const REG_DWORD_BIG_ENDIAN = (5) '32-bit number
    > Private Const REG_LINK = (6) 'Symbolic Link

    (unicode)
    > Private Const REG_MULTI_SZ = (7) 'Multiple Unicode

    strings
    > Private Const REG_RESOURCE_LIST = (8) 'Resource list in

    resource
    > map
    > Private Const REG_FULL_RESOURCE_DESCRIPTOR = (9) 'Resource list in

    hardware
    > description
    > Private Const REG_RESOURCE_REQUIREMENTS_LIST = (10) '??????
    >
    > Private Const REG_OPTION_NON_VOLATILE = 0
    >
    > 'This is a tricky part when i comes to NT/W2000 to
    > 'handle the security nicely. You should not need to
    > 'be an Admin to make use of the registry when running
    > 'an application. It is the programmers responsibility
    > 'to make these routines work properly...
    > Private Type SECURITY_ATTRIBUTES
    > nLength As Long
    > lpSecurityDescriptor As Long
    > bInheritHandle As Long
    > End Type
    >
    > Private Const KEY_QUERY_VALUE = &H1
    > Private Const KEY_SET_VALUE = &H2
    > Private Const KEY_CREATE_SUB_KEY = &H4
    >
    > 'Return values from API:s
    > Private Const ERROR_SUCCESS = 0&
    > Private Const ERROR_ACCESS_DENIED = 5&
    > Private Const ERROR_KEY_DOES_NOT_EXIST = 2&
    >
    > 'Predeclared API:s....
    > 'Creates a new key...
    > 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
    >
    > 'Opens the specific key for further action...
    > 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
    >
    > 'Gets type and data to from a value name associted with the open key...
    > Declare Function RegQueryValueEx 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
    >
    > 'Sets a new value to an open key...
    > Declare Function RegSetValueEx 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
    >
    > 'Closes the specified key...
    > Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As

    Long
    >
    > 'Deletes a value...
    > Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias

    "RegDeleteValueA"
    > (ByVal hKey As Long, ByVal lpValueName As String) As Long
    >
    > 'Deletes a key if no subkeys exist...
    > Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias

    "RegDeleteKeyA"
    > (ByVal hKey As Long, ByVal lpSubKey As String) As Long
    > '
    >
    > Private Function StripNullTerminator(KeyValue As String) As String
    >
    > 'KeyValue returned is a fixlength string (usually 255 spaces) which has

    been
    > populated
    > 'with the value returned from the API. It is populated from left to right
    > and the returned
    > 'value is terminated with chr(0). After that position only garbage exists.
    > So we search for
    > 'the first chr(0) and cut off everything from that position.
    >
    > Dim FirstNullPosition As Integer
    >
    > FirstNullPosition = InStr(1, KeyValue, vbNullChar)
    > StripNullTerminator = Left(KeyValue, FirstNullPosition - 1)
    >
    > End Function
    >
    > Public Function GetRegistryValue(ByVal KeyName As String, ByVal ValueName
    > As String, Optional BufferSize As Long) As Variant
    >
    > 'Gets the value in ValueName from the registrybranch KeyName...
    > 'Returns a string with the value. If an error occures Null is returned...
    > 'If a large value is expected the buffer can be increased from its default
    > 255 bytes...
    >
    > Dim hKey As Long
    > Dim SubKey As String
    > Dim dataBuffer As String
    > Dim Result As Long
    > Dim RetVal As Long
    > Dim Value As String
    >
    >
    > 'Determine main key (hKey) and sub key (SubKey) from KeyName...
    > If InStr(1, KeyName, "HKEY_CLASSES_ROOT\", vbTextCompare) = 1 Then
    > hKey = HKEY_CLASSES_ROOT
    > SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_CLASSES_ROOT\"))
    > ElseIf InStr(1, KeyName, "HKEY_CURRENT_USER\", vbTextCompare) = 1 Then
    > hKey = HKEY_CURRENT_USER
    > SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_CURRENT_USER\"))
    > ElseIf InStr(1, KeyName, "HKEY_LOCAL_MACHINE\", vbTextCompare) = 1

    Then
    > hKey = HKEY_LOCAL_MACHINE
    > SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_LOCAL_MACHINE\"))
    > ElseIf InStr(1, KeyName, "HKEY_USERS\", vbTextCompare) = 1 Then
    > hKey = HKEY_USERS
    > SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_USERS\"))
    > Else
    > 'Invalid KeyName...
    > GoTo GetRegistryValueError
    > End If
    >
    > 'Create string with spaces as a buffer to be filled by the API...
    > If BufferSize < 255 Then BufferSize = 255
    > dataBuffer = Space(BufferSize)
    >
    >
    > 'Open the key for reading only...
    > RetVal = RegOpenKeyEx(hKey, SubKey, 0, KEY_QUERY_VALUE, Result)
    >
    >
    > If RetVal = ERROR_ACCESS_DENIED Then
    > MsgBox "ERROR: Unauthorized attempt to read in registry!",

    vbCritical,
    > "ACCESSVIOLATION"
    > GoTo GetRegistryValueError
    > ElseIf RetVal = ERROR_SUCCESS Then
    > 'Try to fill up dataBuffer with the value in ValueName...
    > 'It doesn't matter if it was stored as a string or as binary, it
    > is copied
    > 'into the spacestring in dataBuffer as a binarystring ended with
    > chr(0) anyway...
    > RetVal = RegQueryValueEx(Result, ValueName, 0, 0, dataBuffer,

    BufferSize)
    > If RetVal = ERROR_SUCCESS Then
    > 'ValueName was found and the value in it is now in the

    beginning
    > of dataBuffer...
    > 'Se StripNullTerminator on how to extract it...
    > GetRegistryValue = StripNullTerminator(dataBuffer)
    > Else
    > 'ValueName was not found...
    > GoTo GetRegistryValueError
    > End If
    > Else
    > GoTo GetRegistryValueError
    > End If
    >
    >
    >
    > GetRegistryValueExit:
    >
    > On Error Resume Next
    >
    > RegCloseKey hKey
    > RegCloseKey Result
    >
    > Exit Function
    >
    > GetRegistryValueError:
    >
    > GetRegistryValue = Null
    > GoTo GetRegistryValueExit
    >
    > End Function
    >
    > Public Function SetRegistryValue(ByVal KeyName As String, ByVal ValueName
    > As String, ByVal Value As String, Optional BinaryValue As Boolean) As

    Boolean
    >
    > 'Sets ValueName in branch KeyName to Value. If it does not exist it is

    created...
    > 'Returns True if success, otherwise False...
    >
    > 'If BinaryValue = False, Value sets as a string, otherwise as binary...
    > 'The binary value has to be supplied in a string though...
    >
    > Dim hKey As Long
    > Dim SubKey As String
    > Dim Result As Long
    > Dim RetVal As Long
    > Dim RegType As Long
    > Dim SecAttrib As SECURITY_ATTRIBUTES
    > Dim Disp As Long
    >
    > 'ATTENTION: To remove the value a zerolength string can be passed for
    > 'Win9X. But if that is done with NT4/W2000 the system goes bezerk.

    Putting
    > 'a chr(0) in the empty string makes it work in all systems. Don't ask
    > me why,
    > '-When it works I don't spend any more time thinking of why...
    > If Len(Value) = 0 Then Value = Chr(0)
    >
    >
    > 'Determine main key (hKey) and sub key (SubKey) from KeyName...
    > If InStr(1, KeyName, "HKEY_CLASSES_ROOT\", vbTextCompare) = 1 Then
    > hKey = HKEY_CLASSES_ROOT
    > SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_CLASSES_ROOT\"))
    > ElseIf InStr(1, KeyName, "HKEY_CURRENT_USER\", vbTextCompare) = 1 Then
    > hKey = HKEY_CURRENT_USER
    > SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_CURRENT_USER\"))
    > ElseIf InStr(1, KeyName, "HKEY_LOCAL_MACHINE\", vbTextCompare) = 1

    Then
    > hKey = HKEY_LOCAL_MACHINE
    > SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_LOCAL_MACHINE\"))
    > ElseIf InStr(1, KeyName, "HKEY_USERS\", vbTextCompare) = 1 Then
    > hKey = HKEY_USERS
    > SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_USERS\"))
    > Else
    > 'Invalid KeyName...
    > GoTo SetRegistryValueError
    > End If
    >
    >
    > 'Open the key (creates it if it does not exist)...
    > 'Note that authority asked for is a mix of flags (KEY_CREATE_SUB_KEY
    > Or KEY_SET_VALUE)
    > 'which is no more than you need for creating and writing in the

    registry.
    > All samples I
    > 'have seen used KEY_ALL_ACCESS but in NT4/W2000 you must be Admin to
    > get it. In Win9X it
    > 'does not matter though...
    > RetVal = RegCreateKeyEx(hKey, SubKey, 0, "REG_DWORD",

    REG_OPTION_NON_VOLATILE,
    > (KEY_CREATE_SUB_KEY Or KEY_SET_VALUE), SecAttrib, Result, Disp)
    >
    > Select Case RetVal
    > Case ERROR_ACCESS_DENIED
    > 'Probably NT and somewhere you should not be messing around...
    > MsgBox "ERROR: Unauthorized attempt to write in registry!",

    vbCritical,
    > "ACCESSVIOLATION"
    > GoTo SetRegistryValueError
    > Case ERROR_SUCCESS
    > Case Else
    > 'Unknown error...
    > MsgBox "ERROR: Unknown error when writing in registry!",

    vbCritical,
    > "REGISTRY ERROR"
    > GoTo SetRegistryValueError
    > End Select
    >
    > If BinaryValue = True Then
    > RegType = REG_BINARY
    > Else
    > RegType = REG_SZ
    > End If
    >
    > 'Put in the data...
    > RetVal = RegSetValueEx(Result, ValueName, 0, RegType, Value,

    CLng(Len(Value)
    > + 1))
    >
    > Select Case RetVal
    > Case ERROR_ACCESS_DENIED
    > MsgBox "ERROR: Unauthorized attempt to write in registry!",

    vbCritical,
    > "ACCESSVIOLATION"
    > GoTo SetRegistryValueError
    > Case ERROR_SUCCESS
    > Case Else
    > 'Unknown error...
    > MsgBox "ERROR: Unknown error when writing in registry!",

    vbCritical,
    > "REGISTRY ERROR"
    > GoTo SetRegistryValueError
    > End Select
    >
    > SetRegistryValue = True
    >
    > SetRegistryValueExit:
    >
    > On Error Resume Next
    >
    > 'Close the keys...
    > RegCloseKey hKey
    > RegCloseKey Result
    >
    > Exit Function
    >
    > SetRegistryValueError:
    >
    > SetRegistryValue = False
    > GoTo SetRegistryValueExit
    >
    > End Function
    >
    > Public Function DeleteRegistryValue(ByVal KeyName As String, ByVal

    ValueName
    > As String) As Boolean
    >
    > 'Deletes a complete ValueName and the value associated with it...
    > 'Returns True if succeded, otherwise False...
    >
    >
    > Dim hKey As Long
    > Dim SubKey As String
    > Dim Result As Long
    > Dim RetVal As Long
    >
    > 'Determine main key (hKey) and sub key (SubKey) from KeyName...
    > If InStr(1, KeyName, "HKEY_CLASSES_ROOT\", vbTextCompare) = 1 Then
    > hKey = HKEY_CLASSES_ROOT
    > SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_CLASSES_ROOT\"))
    > ElseIf InStr(1, KeyName, "HKEY_CURRENT_USER\", vbTextCompare) = 1 Then
    > hKey = HKEY_CURRENT_USER
    > SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_CURRENT_USER\"))
    > ElseIf InStr(1, KeyName, "HKEY_LOCAL_MACHINE\", vbTextCompare) = 1

    Then
    > hKey = HKEY_LOCAL_MACHINE
    > SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_LOCAL_MACHINE\"))
    > ElseIf InStr(1, KeyName, "HKEY_USERS\", vbTextCompare) = 1 Then
    > hKey = HKEY_USERS
    > SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_USERS\"))
    > Else
    > 'Invalid KeyName...
    > GoTo DeleteRegistryValueError
    > End If
    >
    > 'Open the key with Set_Value access...
    > 'Try this on NT/W2000!!! KEY_SET_VALUE should be sufficient according
    > to SDK documentation
    > 'but who knows that is true...
    > RetVal = RegOpenKeyEx(hKey, SubKey, 0, KEY_SET_VALUE, Result)
    >
    > Select Case RetVal
    > Case ERROR_ACCESS_DENIED
    > 'Probably NT and somewhere you should not be messing around...
    > MsgBox "ERROR: Unauthorized attempt to write in registry!",

    vbCritical,
    > "ACCESSVIOLATION"
    > GoTo DeleteRegistryValueError
    > Case ERROR_KEY_DOES_NOT_EXIST
    > 'Key does not exist...
    > GoTo DeleteRegistryValueError
    > Case ERROR_SUCCESS
    > Case Else
    > 'Unknown error...
    > MsgBox "ERROR: Unknown error when writing in registry!",

    vbCritical,
    > "REGISTRY ERROR"
    > GoTo DeleteRegistryValueError
    > End Select
    >
    > 'Delete the key's value
    > RetVal = RegDeleteValue(Result, ValueName)
    >
    > Select Case RetVal
    > Case ERROR_SUCCESS
    > 'ValueName was found and deleted...
    > DeleteRegistryValue = True
    > Case ERROR_KEY_DOES_NOT_EXIST
    > 'ValueName did not exist...
    > GoTo DeleteRegistryValueError
    > Case Else
    > 'Unknown error...
    > MsgBox "ERROR: Unknown error when writing in registry!",

    vbCritical,
    > "REGISTRY ERROR"
    > GoTo DeleteRegistryValueError
    > End Select
    >
    > DeleteRegistryValueExit:
    >
    > On Error Resume Next
    >
    > 'Close the keys...
    > RegCloseKey hKey
    > RegCloseKey Result
    >
    > Exit Function
    >
    >
    > DeleteRegistryValueError:
    >
    > DeleteRegistryValue = False
    > GoTo DeleteRegistryValueExit
    >
    > End Function
    >
    > Public Function DeleteRegistryKey(ByVal KeyName As String) As Boolean
    >
    > 'Deletes a key and all values associated with it.
    > 'Returns True if succeded, otherwise False...
    >
    > 'OS differences:
    > 'Win 9X Deletes each and every subkey as well...
    > 'Win NT/2000 Subkeys must not exist. These must first be handled
    > ' individually from bottom and up...
    >
    >
    > Dim hKey As Long
    > Dim SubKey As String
    > Dim Result As Long
    > Dim RetVal As Long
    >
    > 'Determine main key (hKey) and sub key (SubKey) from KeyName...
    > If InStr(1, KeyName, "HKEY_CLASSES_ROOT\", vbTextCompare) = 1 Then
    > hKey = HKEY_CLASSES_ROOT
    > SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_CLASSES_ROOT\"))
    > ElseIf InStr(1, KeyName, "HKEY_CURRENT_USER\", vbTextCompare) = 1 Then
    > hKey = HKEY_CURRENT_USER
    > SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_CURRENT_USER\"))
    > ElseIf InStr(1, KeyName, "HKEY_LOCAL_MACHINE\", vbTextCompare) = 1

    Then
    > hKey = HKEY_LOCAL_MACHINE
    > SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_LOCAL_MACHINE\"))
    > ElseIf InStr(1, KeyName, "HKEY_USERS\", vbTextCompare) = 1 Then
    > hKey = HKEY_USERS
    > SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_USERS\"))
    > Else
    > 'Invalid KeyName...
    > GoTo DeleteRegistryKeyError
    > End If
    >
    > 'Open the key...
    > 'Try this on NT/W2000!!! KEY_SET_VALUE may not be sufficient to delete
    > the key...
    > RetVal = RegOpenKeyEx(hKey, SubKey, 0, KEY_SET_VALUE, Result)
    >
    > Select Case RetVal
    > Case ERROR_ACCESS_DENIED
    > 'Probably NT and somewhere you should not be messing around...
    > MsgBox "ERROR: Unauthorized attempt to write in registry!",

    vbCritical,
    > "ACCESSVIOLATION"
    > GoTo DeleteRegistryKeyError
    > Case ERROR_KEY_DOES_NOT_EXIST
    > 'Specified key did not exist...
    > GoTo DeleteRegistryKeyError
    > Case ERROR_SUCCESS
    > Case Else
    > 'Unknown error...
    > MsgBox "ERROR: Unknown error when writing in registry!",

    vbCritical,
    > "REGISTRY ERROR"
    > GoTo DeleteRegistryKeyError
    > End Select
    >
    > 'Delete the key and all valuenames in it...
    > RetVal = RegDeleteKey(Result, "")
    >
    > Select Case RetVal
    > Case ERROR_SUCCESS
    > 'ValueName was found and deleted...
    > 'With Win9X all subkeys are deleted as well...
    > DeleteRegistryKey = True
    > Case ERROR_ACCESS_DENIED
    > 'Happens with NT/W2000 if there are any subkeys attached...
    > 'If so each of them has to be deleted individually from bottom
    > and up.
    > 'There is a newer API-function, SHDeleteKey in Shlwapi.dll,

    which
    > should
    > 'delete each and every subkey as this one does in Win9X, but
    > I haven't tried
    > 'it out yet...
    > GoTo DeleteRegistryKeyError
    > Case Else
    > '????...
    > GoTo DeleteRegistryKeyError
    > End Select
    >
    > DeleteRegistryKeyExit:
    >
    > On Error Resume Next
    >
    > 'Close the keys...
    > RegCloseKey hKey
    > RegCloseKey Result
    >
    > Exit Function
    >
    >
    > DeleteRegistryKeyError:
    >
    > DeleteRegistryKey = False
    > GoTo DeleteRegistryKeyExit
    >
    > End Function
    >
    > Public Function GetComputerName() As String
    >
    > 'Yeah, there is an API for this, but why not like this when it only
    > 'takes a single row of code to do it?
    >
    > GetComputerName =

    GetRegistryValue("HKEY_LOCAL_MACHINE\System\CurrentControlSet\Control\Comput
    erName\ComputerName",
    > "ComputerName")
    >
    > End Function
    >
    >




  3. #18
    Bernie Guest

    Re: Writing in HKEY_LOCAL_MACHINE...Access is denied


    Hi Michael,

    This piece of code is extracted from a multiuser enterprise system I've developed
    and later on completed with lots of comments for educational purpose. Running
    the enterprise app from the guest account was never the case and I honestly
    have to tell I've never tried this code on that account. Anyway it works
    with any of the created useraccount granted rights to the LAN (but not to
    the admin group).

    I guess the possibilities for the guest account by nature must be quite limited
    when it comes to making changes to the system. When I put this code together
    I recall I was trying those rights flags from 'bottom to top' to see what
    happened. When it worked as desired I didn't put any more efforts to it (!).

    About the messagebox, -Feel free to modify the code to suit your needs. My
    ordinary module has the optional boolean argument 'NoErrMsg' in some functions
    to control the appearance of error messages.


    Regards
    Bernie

    "Michael Culley" <mike@vbdotcom.com> wrote:
    >Bernie,
    >
    >I tried you code and could not get it to work in win2000. I was using the
    >guest account and kept getting an message saying I did not have access.

    Am I
    >doing something wrong?
    >
    >--
    >Michael Culley
    >www.vbdotcom.com
    >
    >
    >"Bernie" <magnus.bernroth@rejlers.se> wrote in message
    >news:3c04cbb3$1@147.208.176.211...
    >>
    >> "Bernie" <magnus.bernroth@rejlers.se> wrote:
    >> >
    >> >Hi,
    >> >
    >> >You should run the API RegCreateKeyEx with the flags

    >REG_OPTION_NON_VOLATILE
    >> >and (KEY_CREATE_SUB_KEY Or KEY_SET_VALUE) to let users without admin

    >rights
    >> >be able to create/write in the registry.
    >> >
    >> >Most samples on how RegCreateKeyEx works requests the highest possible

    >rights
    >> >wich works great on Win9X but returns Errcode 5 on NT-systems. By doing

    >> so
    >> >the user can write virtually everywhere in the registry, at least those

    >> ordinary
    >> >places like hkey\local machine\Software... or hkey\current

    >user\software...
    >> >
    >> >Bu no means start juggeling with the user's rights...
    >> >
    >> >Bernie

    >>
    >> Well, what the heck. Try this code. It's on the house!!
    >>
    >> Put it in a module and call it's varoius functions. There is a lot of

    >comments
    >> in it, especially concerning the aspect of rights!! Most of it works on

    >9X,
    >> NT, 2K and XP though some parts haven't been fully tested on all OS's

    yet
    >> (see the notes inside). I guess the last function GetComputerName()

    >explains
    >> how to simply name the keys as strings...
    >>
    >>
    >> Option Explicit
    >>
    >> 'Registry classes....
    >> Private Const HKEY_CLASSES_ROOT = &H80000000
    >> Private Const HKEY_CURRENT_USER = &H80000001
    >> Private Const HKEY_LOCAL_MACHINE = &H80000002
    >> Private Const HKEY_USERS = &H80000003
    >>
    >> 'Predefined value types (just a few of them used here)...
    >> Private Const REG_NONE = (0) 'No value type
    >> Private Const REG_SZ = (1) 'Unicode null

    >terminated
    >> string
    >> Private Const REG_EXPAND_SZ = (2) 'Unicode null

    >terminated
    >> string with environment variable
    >> Private Const REG_BINARY = (3) 'Binary format
    >> Private Const REG_DWORD = (4) '32-bit number
    >> Private Const REG_DWORD_LITTLE_ENDIAN = (4) '32-bit number (same
    >> as REG_DWORD)
    >> Private Const REG_DWORD_BIG_ENDIAN = (5) '32-bit number
    >> Private Const REG_LINK = (6) 'Symbolic Link

    >(unicode)
    >> Private Const REG_MULTI_SZ = (7) 'Multiple Unicode

    >strings
    >> Private Const REG_RESOURCE_LIST = (8) 'Resource list in

    >resource
    >> map
    >> Private Const REG_FULL_RESOURCE_DESCRIPTOR = (9) 'Resource list in

    >hardware
    >> description
    >> Private Const REG_RESOURCE_REQUIREMENTS_LIST = (10) '??????
    >>
    >> Private Const REG_OPTION_NON_VOLATILE = 0
    >>
    >> 'This is a tricky part when i comes to NT/W2000 to
    >> 'handle the security nicely. You should not need to
    >> 'be an Admin to make use of the registry when running
    >> 'an application. It is the programmers responsibility
    >> 'to make these routines work properly...
    >> Private Type SECURITY_ATTRIBUTES
    >> nLength As Long
    >> lpSecurityDescriptor As Long
    >> bInheritHandle As Long
    >> End Type
    >>
    >> Private Const KEY_QUERY_VALUE = &H1
    >> Private Const KEY_SET_VALUE = &H2
    >> Private Const KEY_CREATE_SUB_KEY = &H4
    >>
    >> 'Return values from API:s
    >> Private Const ERROR_SUCCESS = 0&
    >> Private Const ERROR_ACCESS_DENIED = 5&
    >> Private Const ERROR_KEY_DOES_NOT_EXIST = 2&
    >>
    >> 'Predeclared API:s....
    >> 'Creates a new key...
    >> 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
    >>
    >> 'Opens the specific key for further action...
    >> 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
    >>
    >> 'Gets type and data to from a value name associted with the open key...
    >> Declare Function RegQueryValueEx 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
    >>
    >> 'Sets a new value to an open key...
    >> Declare Function RegSetValueEx 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
    >>
    >> 'Closes the specified key...
    >> Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As

    >Long
    >>
    >> 'Deletes a value...
    >> Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias

    >"RegDeleteValueA"
    >> (ByVal hKey As Long, ByVal lpValueName As String) As Long
    >>
    >> 'Deletes a key if no subkeys exist...
    >> Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias

    >"RegDeleteKeyA"
    >> (ByVal hKey As Long, ByVal lpSubKey As String) As Long
    >> '
    >>
    >> Private Function StripNullTerminator(KeyValue As String) As String
    >>
    >> 'KeyValue returned is a fixlength string (usually 255 spaces) which has

    >been
    >> populated
    >> 'with the value returned from the API. It is populated from left to right
    >> and the returned
    >> 'value is terminated with chr(0). After that position only garbage exists.
    >> So we search for
    >> 'the first chr(0) and cut off everything from that position.
    >>
    >> Dim FirstNullPosition As Integer
    >>
    >> FirstNullPosition = InStr(1, KeyValue, vbNullChar)
    >> StripNullTerminator = Left(KeyValue, FirstNullPosition - 1)
    >>
    >> End Function
    >>
    >> Public Function GetRegistryValue(ByVal KeyName As String, ByVal ValueName
    >> As String, Optional BufferSize As Long) As Variant
    >>
    >> 'Gets the value in ValueName from the registrybranch KeyName...
    >> 'Returns a string with the value. If an error occures Null is returned...
    >> 'If a large value is expected the buffer can be increased from its default
    >> 255 bytes...
    >>
    >> Dim hKey As Long
    >> Dim SubKey As String
    >> Dim dataBuffer As String
    >> Dim Result As Long
    >> Dim RetVal As Long
    >> Dim Value As String
    >>
    >>
    >> 'Determine main key (hKey) and sub key (SubKey) from KeyName...
    >> If InStr(1, KeyName, "HKEY_CLASSES_ROOT\", vbTextCompare) = 1 Then
    >> hKey = HKEY_CLASSES_ROOT
    >> SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_CLASSES_ROOT\"))
    >> ElseIf InStr(1, KeyName, "HKEY_CURRENT_USER\", vbTextCompare) = 1

    Then
    >> hKey = HKEY_CURRENT_USER
    >> SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_CURRENT_USER\"))
    >> ElseIf InStr(1, KeyName, "HKEY_LOCAL_MACHINE\", vbTextCompare) = 1

    >Then
    >> hKey = HKEY_LOCAL_MACHINE
    >> SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_LOCAL_MACHINE\"))
    >> ElseIf InStr(1, KeyName, "HKEY_USERS\", vbTextCompare) = 1 Then
    >> hKey = HKEY_USERS
    >> SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_USERS\"))
    >> Else
    >> 'Invalid KeyName...
    >> GoTo GetRegistryValueError
    >> End If
    >>
    >> 'Create string with spaces as a buffer to be filled by the API...
    >> If BufferSize < 255 Then BufferSize = 255
    >> dataBuffer = Space(BufferSize)
    >>
    >>
    >> 'Open the key for reading only...
    >> RetVal = RegOpenKeyEx(hKey, SubKey, 0, KEY_QUERY_VALUE, Result)
    >>
    >>
    >> If RetVal = ERROR_ACCESS_DENIED Then
    >> MsgBox "ERROR: Unauthorized attempt to read in registry!",

    >vbCritical,
    >> "ACCESSVIOLATION"
    >> GoTo GetRegistryValueError
    >> ElseIf RetVal = ERROR_SUCCESS Then
    >> 'Try to fill up dataBuffer with the value in ValueName...
    >> 'It doesn't matter if it was stored as a string or as binary,

    it
    >> is copied
    >> 'into the spacestring in dataBuffer as a binarystring ended with
    >> chr(0) anyway...
    >> RetVal = RegQueryValueEx(Result, ValueName, 0, 0, dataBuffer,

    >BufferSize)
    >> If RetVal = ERROR_SUCCESS Then
    >> 'ValueName was found and the value in it is now in the

    >beginning
    >> of dataBuffer...
    >> 'Se StripNullTerminator on how to extract it...
    >> GetRegistryValue = StripNullTerminator(dataBuffer)
    >> Else
    >> 'ValueName was not found...
    >> GoTo GetRegistryValueError
    >> End If
    >> Else
    >> GoTo GetRegistryValueError
    >> End If
    >>
    >>
    >>
    >> GetRegistryValueExit:
    >>
    >> On Error Resume Next
    >>
    >> RegCloseKey hKey
    >> RegCloseKey Result
    >>
    >> Exit Function
    >>
    >> GetRegistryValueError:
    >>
    >> GetRegistryValue = Null
    >> GoTo GetRegistryValueExit
    >>
    >> End Function
    >>
    >> Public Function SetRegistryValue(ByVal KeyName As String, ByVal ValueName
    >> As String, ByVal Value As String, Optional BinaryValue As Boolean) As

    >Boolean
    >>
    >> 'Sets ValueName in branch KeyName to Value. If it does not exist it is

    >created...
    >> 'Returns True if success, otherwise False...
    >>
    >> 'If BinaryValue = False, Value sets as a string, otherwise as binary...
    >> 'The binary value has to be supplied in a string though...
    >>
    >> Dim hKey As Long
    >> Dim SubKey As String
    >> Dim Result As Long
    >> Dim RetVal As Long
    >> Dim RegType As Long
    >> Dim SecAttrib As SECURITY_ATTRIBUTES
    >> Dim Disp As Long
    >>
    >> 'ATTENTION: To remove the value a zerolength string can be passed

    for
    >> 'Win9X. But if that is done with NT4/W2000 the system goes bezerk.

    >Putting
    >> 'a chr(0) in the empty string makes it work in all systems. Don't

    ask
    >> me why,
    >> '-When it works I don't spend any more time thinking of why...
    >> If Len(Value) = 0 Then Value = Chr(0)
    >>
    >>
    >> 'Determine main key (hKey) and sub key (SubKey) from KeyName...
    >> If InStr(1, KeyName, "HKEY_CLASSES_ROOT\", vbTextCompare) = 1 Then
    >> hKey = HKEY_CLASSES_ROOT
    >> SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_CLASSES_ROOT\"))
    >> ElseIf InStr(1, KeyName, "HKEY_CURRENT_USER\", vbTextCompare) = 1

    Then
    >> hKey = HKEY_CURRENT_USER
    >> SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_CURRENT_USER\"))
    >> ElseIf InStr(1, KeyName, "HKEY_LOCAL_MACHINE\", vbTextCompare) = 1

    >Then
    >> hKey = HKEY_LOCAL_MACHINE
    >> SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_LOCAL_MACHINE\"))
    >> ElseIf InStr(1, KeyName, "HKEY_USERS\", vbTextCompare) = 1 Then
    >> hKey = HKEY_USERS
    >> SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_USERS\"))
    >> Else
    >> 'Invalid KeyName...
    >> GoTo SetRegistryValueError
    >> End If
    >>
    >>
    >> 'Open the key (creates it if it does not exist)...
    >> 'Note that authority asked for is a mix of flags (KEY_CREATE_SUB_KEY
    >> Or KEY_SET_VALUE)
    >> 'which is no more than you need for creating and writing in the

    >registry.
    >> All samples I
    >> 'have seen used KEY_ALL_ACCESS but in NT4/W2000 you must be Admin

    to
    >> get it. In Win9X it
    >> 'does not matter though...
    >> RetVal = RegCreateKeyEx(hKey, SubKey, 0, "REG_DWORD",

    >REG_OPTION_NON_VOLATILE,
    >> (KEY_CREATE_SUB_KEY Or KEY_SET_VALUE), SecAttrib, Result, Disp)
    >>
    >> Select Case RetVal
    >> Case ERROR_ACCESS_DENIED
    >> 'Probably NT and somewhere you should not be messing around...
    >> MsgBox "ERROR: Unauthorized attempt to write in registry!",

    >vbCritical,
    >> "ACCESSVIOLATION"
    >> GoTo SetRegistryValueError
    >> Case ERROR_SUCCESS
    >> Case Else
    >> 'Unknown error...
    >> MsgBox "ERROR: Unknown error when writing in registry!",

    >vbCritical,
    >> "REGISTRY ERROR"
    >> GoTo SetRegistryValueError
    >> End Select
    >>
    >> If BinaryValue = True Then
    >> RegType = REG_BINARY
    >> Else
    >> RegType = REG_SZ
    >> End If
    >>
    >> 'Put in the data...
    >> RetVal = RegSetValueEx(Result, ValueName, 0, RegType, Value,

    >CLng(Len(Value)
    >> + 1))
    >>
    >> Select Case RetVal
    >> Case ERROR_ACCESS_DENIED
    >> MsgBox "ERROR: Unauthorized attempt to write in registry!",

    >vbCritical,
    >> "ACCESSVIOLATION"
    >> GoTo SetRegistryValueError
    >> Case ERROR_SUCCESS
    >> Case Else
    >> 'Unknown error...
    >> MsgBox "ERROR: Unknown error when writing in registry!",

    >vbCritical,
    >> "REGISTRY ERROR"
    >> GoTo SetRegistryValueError
    >> End Select
    >>
    >> SetRegistryValue = True
    >>
    >> SetRegistryValueExit:
    >>
    >> On Error Resume Next
    >>
    >> 'Close the keys...
    >> RegCloseKey hKey
    >> RegCloseKey Result
    >>
    >> Exit Function
    >>
    >> SetRegistryValueError:
    >>
    >> SetRegistryValue = False
    >> GoTo SetRegistryValueExit
    >>
    >> End Function
    >>
    >> Public Function DeleteRegistryValue(ByVal KeyName As String, ByVal

    >ValueName
    >> As String) As Boolean
    >>
    >> 'Deletes a complete ValueName and the value associated with it...
    >> 'Returns True if succeded, otherwise False...
    >>
    >>
    >> Dim hKey As Long
    >> Dim SubKey As String
    >> Dim Result As Long
    >> Dim RetVal As Long
    >>
    >> 'Determine main key (hKey) and sub key (SubKey) from KeyName...
    >> If InStr(1, KeyName, "HKEY_CLASSES_ROOT\", vbTextCompare) = 1 Then
    >> hKey = HKEY_CLASSES_ROOT
    >> SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_CLASSES_ROOT\"))
    >> ElseIf InStr(1, KeyName, "HKEY_CURRENT_USER\", vbTextCompare) = 1

    Then
    >> hKey = HKEY_CURRENT_USER
    >> SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_CURRENT_USER\"))
    >> ElseIf InStr(1, KeyName, "HKEY_LOCAL_MACHINE\", vbTextCompare) = 1

    >Then
    >> hKey = HKEY_LOCAL_MACHINE
    >> SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_LOCAL_MACHINE\"))
    >> ElseIf InStr(1, KeyName, "HKEY_USERS\", vbTextCompare) = 1 Then
    >> hKey = HKEY_USERS
    >> SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_USERS\"))
    >> Else
    >> 'Invalid KeyName...
    >> GoTo DeleteRegistryValueError
    >> End If
    >>
    >> 'Open the key with Set_Value access...
    >> 'Try this on NT/W2000!!! KEY_SET_VALUE should be sufficient according
    >> to SDK documentation
    >> 'but who knows that is true...
    >> RetVal = RegOpenKeyEx(hKey, SubKey, 0, KEY_SET_VALUE, Result)
    >>
    >> Select Case RetVal
    >> Case ERROR_ACCESS_DENIED
    >> 'Probably NT and somewhere you should not be messing around...
    >> MsgBox "ERROR: Unauthorized attempt to write in registry!",

    >vbCritical,
    >> "ACCESSVIOLATION"
    >> GoTo DeleteRegistryValueError
    >> Case ERROR_KEY_DOES_NOT_EXIST
    >> 'Key does not exist...
    >> GoTo DeleteRegistryValueError
    >> Case ERROR_SUCCESS
    >> Case Else
    >> 'Unknown error...
    >> MsgBox "ERROR: Unknown error when writing in registry!",

    >vbCritical,
    >> "REGISTRY ERROR"
    >> GoTo DeleteRegistryValueError
    >> End Select
    >>
    >> 'Delete the key's value
    >> RetVal = RegDeleteValue(Result, ValueName)
    >>
    >> Select Case RetVal
    >> Case ERROR_SUCCESS
    >> 'ValueName was found and deleted...
    >> DeleteRegistryValue = True
    >> Case ERROR_KEY_DOES_NOT_EXIST
    >> 'ValueName did not exist...
    >> GoTo DeleteRegistryValueError
    >> Case Else
    >> 'Unknown error...
    >> MsgBox "ERROR: Unknown error when writing in registry!",

    >vbCritical,
    >> "REGISTRY ERROR"
    >> GoTo DeleteRegistryValueError
    >> End Select
    >>
    >> DeleteRegistryValueExit:
    >>
    >> On Error Resume Next
    >>
    >> 'Close the keys...
    >> RegCloseKey hKey
    >> RegCloseKey Result
    >>
    >> Exit Function
    >>
    >>
    >> DeleteRegistryValueError:
    >>
    >> DeleteRegistryValue = False
    >> GoTo DeleteRegistryValueExit
    >>
    >> End Function
    >>
    >> Public Function DeleteRegistryKey(ByVal KeyName As String) As Boolean
    >>
    >> 'Deletes a key and all values associated with it.
    >> 'Returns True if succeded, otherwise False...
    >>
    >> 'OS differences:
    >> 'Win 9X Deletes each and every subkey as well...
    >> 'Win NT/2000 Subkeys must not exist. These must first be handled
    >> ' individually from bottom and up...
    >>
    >>
    >> Dim hKey As Long
    >> Dim SubKey As String
    >> Dim Result As Long
    >> Dim RetVal As Long
    >>
    >> 'Determine main key (hKey) and sub key (SubKey) from KeyName...
    >> If InStr(1, KeyName, "HKEY_CLASSES_ROOT\", vbTextCompare) = 1 Then
    >> hKey = HKEY_CLASSES_ROOT
    >> SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_CLASSES_ROOT\"))
    >> ElseIf InStr(1, KeyName, "HKEY_CURRENT_USER\", vbTextCompare) = 1

    Then
    >> hKey = HKEY_CURRENT_USER
    >> SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_CURRENT_USER\"))
    >> ElseIf InStr(1, KeyName, "HKEY_LOCAL_MACHINE\", vbTextCompare) = 1

    >Then
    >> hKey = HKEY_LOCAL_MACHINE
    >> SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_LOCAL_MACHINE\"))
    >> ElseIf InStr(1, KeyName, "HKEY_USERS\", vbTextCompare) = 1 Then
    >> hKey = HKEY_USERS
    >> SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_USERS\"))
    >> Else
    >> 'Invalid KeyName...
    >> GoTo DeleteRegistryKeyError
    >> End If
    >>
    >> 'Open the key...
    >> 'Try this on NT/W2000!!! KEY_SET_VALUE may not be sufficient to delete
    >> the key...
    >> RetVal = RegOpenKeyEx(hKey, SubKey, 0, KEY_SET_VALUE, Result)
    >>
    >> Select Case RetVal
    >> Case ERROR_ACCESS_DENIED
    >> 'Probably NT and somewhere you should not be messing around...
    >> MsgBox "ERROR: Unauthorized attempt to write in registry!",

    >vbCritical,
    >> "ACCESSVIOLATION"
    >> GoTo DeleteRegistryKeyError
    >> Case ERROR_KEY_DOES_NOT_EXIST
    >> 'Specified key did not exist...
    >> GoTo DeleteRegistryKeyError
    >> Case ERROR_SUCCESS
    >> Case Else
    >> 'Unknown error...
    >> MsgBox "ERROR: Unknown error when writing in registry!",

    >vbCritical,
    >> "REGISTRY ERROR"
    >> GoTo DeleteRegistryKeyError
    >> End Select
    >>
    >> 'Delete the key and all valuenames in it...
    >> RetVal = RegDeleteKey(Result, "")
    >>
    >> Select Case RetVal
    >> Case ERROR_SUCCESS
    >> 'ValueName was found and deleted...
    >> 'With Win9X all subkeys are deleted as well...
    >> DeleteRegistryKey = True
    >> Case ERROR_ACCESS_DENIED
    >> 'Happens with NT/W2000 if there are any subkeys attached...
    >> 'If so each of them has to be deleted individually from bottom
    >> and up.
    >> 'There is a newer API-function, SHDeleteKey in Shlwapi.dll,

    >which
    >> should
    >> 'delete each and every subkey as this one does in Win9X, but
    >> I haven't tried
    >> 'it out yet...
    >> GoTo DeleteRegistryKeyError
    >> Case Else
    >> '????...
    >> GoTo DeleteRegistryKeyError
    >> End Select
    >>
    >> DeleteRegistryKeyExit:
    >>
    >> On Error Resume Next
    >>
    >> 'Close the keys...
    >> RegCloseKey hKey
    >> RegCloseKey Result
    >>
    >> Exit Function
    >>
    >>
    >> DeleteRegistryKeyError:
    >>
    >> DeleteRegistryKey = False
    >> GoTo DeleteRegistryKeyExit
    >>
    >> End Function
    >>
    >> Public Function GetComputerName() As String
    >>
    >> 'Yeah, there is an API for this, but why not like this when it only
    >> 'takes a single row of code to do it?
    >>
    >> GetComputerName =

    >GetRegistryValue("HKEY_LOCAL_MACHINE\System\CurrentControlSet\Control\Comput
    >erName\ComputerName",
    >> "ComputerName")
    >>
    >> End Function
    >>
    >>

    >
    >



  4. #19
    Bernie Guest

    Re: Writing in HKEY_LOCAL_MACHINE...Access is denied


    Hi Michael,

    This piece of code is extracted from a multiuser enterprise system I've developed
    and later on completed with lots of comments for educational purpose. Running
    the enterprise app from the guest account was never the case and I honestly
    have to tell I've never tried this code on that account. Anyway it works
    with any of the created useraccount granted rights to the LAN (but not to
    the admin group).

    I guess the possibilities for the guest account by nature must be quite limited
    when it comes to making changes to the system. When I put this code together
    I recall I was trying those rights flags from 'bottom to top' to see what
    happened. When it worked as desired I didn't put any more efforts to it (!).

    About the messagebox, -Feel free to modify the code to suit your needs. My
    ordinary module has the optional boolean argument 'NoErrMsg' in some functions
    to control the appearance of error messages.


    Regards
    Bernie

    "Michael Culley" <mike@vbdotcom.com> wrote:
    >Bernie,
    >
    >I tried you code and could not get it to work in win2000. I was using the
    >guest account and kept getting an message saying I did not have access.

    Am I
    >doing something wrong?
    >
    >--
    >Michael Culley
    >www.vbdotcom.com
    >
    >
    >"Bernie" <magnus.bernroth@rejlers.se> wrote in message
    >news:3c04cbb3$1@147.208.176.211...
    >>
    >> "Bernie" <magnus.bernroth@rejlers.se> wrote:
    >> >
    >> >Hi,
    >> >
    >> >You should run the API RegCreateKeyEx with the flags

    >REG_OPTION_NON_VOLATILE
    >> >and (KEY_CREATE_SUB_KEY Or KEY_SET_VALUE) to let users without admin

    >rights
    >> >be able to create/write in the registry.
    >> >
    >> >Most samples on how RegCreateKeyEx works requests the highest possible

    >rights
    >> >wich works great on Win9X but returns Errcode 5 on NT-systems. By doing

    >> so
    >> >the user can write virtually everywhere in the registry, at least those

    >> ordinary
    >> >places like hkey\local machine\Software... or hkey\current

    >user\software...
    >> >
    >> >Bu no means start juggeling with the user's rights...
    >> >
    >> >Bernie

    >>
    >> Well, what the heck. Try this code. It's on the house!!
    >>
    >> Put it in a module and call it's varoius functions. There is a lot of

    >comments
    >> in it, especially concerning the aspect of rights!! Most of it works on

    >9X,
    >> NT, 2K and XP though some parts haven't been fully tested on all OS's

    yet
    >> (see the notes inside). I guess the last function GetComputerName()

    >explains
    >> how to simply name the keys as strings...
    >>
    >>
    >> Option Explicit
    >>
    >> 'Registry classes....
    >> Private Const HKEY_CLASSES_ROOT = &H80000000
    >> Private Const HKEY_CURRENT_USER = &H80000001
    >> Private Const HKEY_LOCAL_MACHINE = &H80000002
    >> Private Const HKEY_USERS = &H80000003
    >>
    >> 'Predefined value types (just a few of them used here)...
    >> Private Const REG_NONE = (0) 'No value type
    >> Private Const REG_SZ = (1) 'Unicode null

    >terminated
    >> string
    >> Private Const REG_EXPAND_SZ = (2) 'Unicode null

    >terminated
    >> string with environment variable
    >> Private Const REG_BINARY = (3) 'Binary format
    >> Private Const REG_DWORD = (4) '32-bit number
    >> Private Const REG_DWORD_LITTLE_ENDIAN = (4) '32-bit number (same
    >> as REG_DWORD)
    >> Private Const REG_DWORD_BIG_ENDIAN = (5) '32-bit number
    >> Private Const REG_LINK = (6) 'Symbolic Link

    >(unicode)
    >> Private Const REG_MULTI_SZ = (7) 'Multiple Unicode

    >strings
    >> Private Const REG_RESOURCE_LIST = (8) 'Resource list in

    >resource
    >> map
    >> Private Const REG_FULL_RESOURCE_DESCRIPTOR = (9) 'Resource list in

    >hardware
    >> description
    >> Private Const REG_RESOURCE_REQUIREMENTS_LIST = (10) '??????
    >>
    >> Private Const REG_OPTION_NON_VOLATILE = 0
    >>
    >> 'This is a tricky part when i comes to NT/W2000 to
    >> 'handle the security nicely. You should not need to
    >> 'be an Admin to make use of the registry when running
    >> 'an application. It is the programmers responsibility
    >> 'to make these routines work properly...
    >> Private Type SECURITY_ATTRIBUTES
    >> nLength As Long
    >> lpSecurityDescriptor As Long
    >> bInheritHandle As Long
    >> End Type
    >>
    >> Private Const KEY_QUERY_VALUE = &H1
    >> Private Const KEY_SET_VALUE = &H2
    >> Private Const KEY_CREATE_SUB_KEY = &H4
    >>
    >> 'Return values from API:s
    >> Private Const ERROR_SUCCESS = 0&
    >> Private Const ERROR_ACCESS_DENIED = 5&
    >> Private Const ERROR_KEY_DOES_NOT_EXIST = 2&
    >>
    >> 'Predeclared API:s....
    >> 'Creates a new key...
    >> 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
    >>
    >> 'Opens the specific key for further action...
    >> 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
    >>
    >> 'Gets type and data to from a value name associted with the open key...
    >> Declare Function RegQueryValueEx 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
    >>
    >> 'Sets a new value to an open key...
    >> Declare Function RegSetValueEx 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
    >>
    >> 'Closes the specified key...
    >> Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As

    >Long
    >>
    >> 'Deletes a value...
    >> Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias

    >"RegDeleteValueA"
    >> (ByVal hKey As Long, ByVal lpValueName As String) As Long
    >>
    >> 'Deletes a key if no subkeys exist...
    >> Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias

    >"RegDeleteKeyA"
    >> (ByVal hKey As Long, ByVal lpSubKey As String) As Long
    >> '
    >>
    >> Private Function StripNullTerminator(KeyValue As String) As String
    >>
    >> 'KeyValue returned is a fixlength string (usually 255 spaces) which has

    >been
    >> populated
    >> 'with the value returned from the API. It is populated from left to right
    >> and the returned
    >> 'value is terminated with chr(0). After that position only garbage exists.
    >> So we search for
    >> 'the first chr(0) and cut off everything from that position.
    >>
    >> Dim FirstNullPosition As Integer
    >>
    >> FirstNullPosition = InStr(1, KeyValue, vbNullChar)
    >> StripNullTerminator = Left(KeyValue, FirstNullPosition - 1)
    >>
    >> End Function
    >>
    >> Public Function GetRegistryValue(ByVal KeyName As String, ByVal ValueName
    >> As String, Optional BufferSize As Long) As Variant
    >>
    >> 'Gets the value in ValueName from the registrybranch KeyName...
    >> 'Returns a string with the value. If an error occures Null is returned...
    >> 'If a large value is expected the buffer can be increased from its default
    >> 255 bytes...
    >>
    >> Dim hKey As Long
    >> Dim SubKey As String
    >> Dim dataBuffer As String
    >> Dim Result As Long
    >> Dim RetVal As Long
    >> Dim Value As String
    >>
    >>
    >> 'Determine main key (hKey) and sub key (SubKey) from KeyName...
    >> If InStr(1, KeyName, "HKEY_CLASSES_ROOT\", vbTextCompare) = 1 Then
    >> hKey = HKEY_CLASSES_ROOT
    >> SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_CLASSES_ROOT\"))
    >> ElseIf InStr(1, KeyName, "HKEY_CURRENT_USER\", vbTextCompare) = 1

    Then
    >> hKey = HKEY_CURRENT_USER
    >> SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_CURRENT_USER\"))
    >> ElseIf InStr(1, KeyName, "HKEY_LOCAL_MACHINE\", vbTextCompare) = 1

    >Then
    >> hKey = HKEY_LOCAL_MACHINE
    >> SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_LOCAL_MACHINE\"))
    >> ElseIf InStr(1, KeyName, "HKEY_USERS\", vbTextCompare) = 1 Then
    >> hKey = HKEY_USERS
    >> SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_USERS\"))
    >> Else
    >> 'Invalid KeyName...
    >> GoTo GetRegistryValueError
    >> End If
    >>
    >> 'Create string with spaces as a buffer to be filled by the API...
    >> If BufferSize < 255 Then BufferSize = 255
    >> dataBuffer = Space(BufferSize)
    >>
    >>
    >> 'Open the key for reading only...
    >> RetVal = RegOpenKeyEx(hKey, SubKey, 0, KEY_QUERY_VALUE, Result)
    >>
    >>
    >> If RetVal = ERROR_ACCESS_DENIED Then
    >> MsgBox "ERROR: Unauthorized attempt to read in registry!",

    >vbCritical,
    >> "ACCESSVIOLATION"
    >> GoTo GetRegistryValueError
    >> ElseIf RetVal = ERROR_SUCCESS Then
    >> 'Try to fill up dataBuffer with the value in ValueName...
    >> 'It doesn't matter if it was stored as a string or as binary,

    it
    >> is copied
    >> 'into the spacestring in dataBuffer as a binarystring ended with
    >> chr(0) anyway...
    >> RetVal = RegQueryValueEx(Result, ValueName, 0, 0, dataBuffer,

    >BufferSize)
    >> If RetVal = ERROR_SUCCESS Then
    >> 'ValueName was found and the value in it is now in the

    >beginning
    >> of dataBuffer...
    >> 'Se StripNullTerminator on how to extract it...
    >> GetRegistryValue = StripNullTerminator(dataBuffer)
    >> Else
    >> 'ValueName was not found...
    >> GoTo GetRegistryValueError
    >> End If
    >> Else
    >> GoTo GetRegistryValueError
    >> End If
    >>
    >>
    >>
    >> GetRegistryValueExit:
    >>
    >> On Error Resume Next
    >>
    >> RegCloseKey hKey
    >> RegCloseKey Result
    >>
    >> Exit Function
    >>
    >> GetRegistryValueError:
    >>
    >> GetRegistryValue = Null
    >> GoTo GetRegistryValueExit
    >>
    >> End Function
    >>
    >> Public Function SetRegistryValue(ByVal KeyName As String, ByVal ValueName
    >> As String, ByVal Value As String, Optional BinaryValue As Boolean) As

    >Boolean
    >>
    >> 'Sets ValueName in branch KeyName to Value. If it does not exist it is

    >created...
    >> 'Returns True if success, otherwise False...
    >>
    >> 'If BinaryValue = False, Value sets as a string, otherwise as binary...
    >> 'The binary value has to be supplied in a string though...
    >>
    >> Dim hKey As Long
    >> Dim SubKey As String
    >> Dim Result As Long
    >> Dim RetVal As Long
    >> Dim RegType As Long
    >> Dim SecAttrib As SECURITY_ATTRIBUTES
    >> Dim Disp As Long
    >>
    >> 'ATTENTION: To remove the value a zerolength string can be passed

    for
    >> 'Win9X. But if that is done with NT4/W2000 the system goes bezerk.

    >Putting
    >> 'a chr(0) in the empty string makes it work in all systems. Don't

    ask
    >> me why,
    >> '-When it works I don't spend any more time thinking of why...
    >> If Len(Value) = 0 Then Value = Chr(0)
    >>
    >>
    >> 'Determine main key (hKey) and sub key (SubKey) from KeyName...
    >> If InStr(1, KeyName, "HKEY_CLASSES_ROOT\", vbTextCompare) = 1 Then
    >> hKey = HKEY_CLASSES_ROOT
    >> SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_CLASSES_ROOT\"))
    >> ElseIf InStr(1, KeyName, "HKEY_CURRENT_USER\", vbTextCompare) = 1

    Then
    >> hKey = HKEY_CURRENT_USER
    >> SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_CURRENT_USER\"))
    >> ElseIf InStr(1, KeyName, "HKEY_LOCAL_MACHINE\", vbTextCompare) = 1

    >Then
    >> hKey = HKEY_LOCAL_MACHINE
    >> SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_LOCAL_MACHINE\"))
    >> ElseIf InStr(1, KeyName, "HKEY_USERS\", vbTextCompare) = 1 Then
    >> hKey = HKEY_USERS
    >> SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_USERS\"))
    >> Else
    >> 'Invalid KeyName...
    >> GoTo SetRegistryValueError
    >> End If
    >>
    >>
    >> 'Open the key (creates it if it does not exist)...
    >> 'Note that authority asked for is a mix of flags (KEY_CREATE_SUB_KEY
    >> Or KEY_SET_VALUE)
    >> 'which is no more than you need for creating and writing in the

    >registry.
    >> All samples I
    >> 'have seen used KEY_ALL_ACCESS but in NT4/W2000 you must be Admin

    to
    >> get it. In Win9X it
    >> 'does not matter though...
    >> RetVal = RegCreateKeyEx(hKey, SubKey, 0, "REG_DWORD",

    >REG_OPTION_NON_VOLATILE,
    >> (KEY_CREATE_SUB_KEY Or KEY_SET_VALUE), SecAttrib, Result, Disp)
    >>
    >> Select Case RetVal
    >> Case ERROR_ACCESS_DENIED
    >> 'Probably NT and somewhere you should not be messing around...
    >> MsgBox "ERROR: Unauthorized attempt to write in registry!",

    >vbCritical,
    >> "ACCESSVIOLATION"
    >> GoTo SetRegistryValueError
    >> Case ERROR_SUCCESS
    >> Case Else
    >> 'Unknown error...
    >> MsgBox "ERROR: Unknown error when writing in registry!",

    >vbCritical,
    >> "REGISTRY ERROR"
    >> GoTo SetRegistryValueError
    >> End Select
    >>
    >> If BinaryValue = True Then
    >> RegType = REG_BINARY
    >> Else
    >> RegType = REG_SZ
    >> End If
    >>
    >> 'Put in the data...
    >> RetVal = RegSetValueEx(Result, ValueName, 0, RegType, Value,

    >CLng(Len(Value)
    >> + 1))
    >>
    >> Select Case RetVal
    >> Case ERROR_ACCESS_DENIED
    >> MsgBox "ERROR: Unauthorized attempt to write in registry!",

    >vbCritical,
    >> "ACCESSVIOLATION"
    >> GoTo SetRegistryValueError
    >> Case ERROR_SUCCESS
    >> Case Else
    >> 'Unknown error...
    >> MsgBox "ERROR: Unknown error when writing in registry!",

    >vbCritical,
    >> "REGISTRY ERROR"
    >> GoTo SetRegistryValueError
    >> End Select
    >>
    >> SetRegistryValue = True
    >>
    >> SetRegistryValueExit:
    >>
    >> On Error Resume Next
    >>
    >> 'Close the keys...
    >> RegCloseKey hKey
    >> RegCloseKey Result
    >>
    >> Exit Function
    >>
    >> SetRegistryValueError:
    >>
    >> SetRegistryValue = False
    >> GoTo SetRegistryValueExit
    >>
    >> End Function
    >>
    >> Public Function DeleteRegistryValue(ByVal KeyName As String, ByVal

    >ValueName
    >> As String) As Boolean
    >>
    >> 'Deletes a complete ValueName and the value associated with it...
    >> 'Returns True if succeded, otherwise False...
    >>
    >>
    >> Dim hKey As Long
    >> Dim SubKey As String
    >> Dim Result As Long
    >> Dim RetVal As Long
    >>
    >> 'Determine main key (hKey) and sub key (SubKey) from KeyName...
    >> If InStr(1, KeyName, "HKEY_CLASSES_ROOT\", vbTextCompare) = 1 Then
    >> hKey = HKEY_CLASSES_ROOT
    >> SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_CLASSES_ROOT\"))
    >> ElseIf InStr(1, KeyName, "HKEY_CURRENT_USER\", vbTextCompare) = 1

    Then
    >> hKey = HKEY_CURRENT_USER
    >> SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_CURRENT_USER\"))
    >> ElseIf InStr(1, KeyName, "HKEY_LOCAL_MACHINE\", vbTextCompare) = 1

    >Then
    >> hKey = HKEY_LOCAL_MACHINE
    >> SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_LOCAL_MACHINE\"))
    >> ElseIf InStr(1, KeyName, "HKEY_USERS\", vbTextCompare) = 1 Then
    >> hKey = HKEY_USERS
    >> SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_USERS\"))
    >> Else
    >> 'Invalid KeyName...
    >> GoTo DeleteRegistryValueError
    >> End If
    >>
    >> 'Open the key with Set_Value access...
    >> 'Try this on NT/W2000!!! KEY_SET_VALUE should be sufficient according
    >> to SDK documentation
    >> 'but who knows that is true...
    >> RetVal = RegOpenKeyEx(hKey, SubKey, 0, KEY_SET_VALUE, Result)
    >>
    >> Select Case RetVal
    >> Case ERROR_ACCESS_DENIED
    >> 'Probably NT and somewhere you should not be messing around...
    >> MsgBox "ERROR: Unauthorized attempt to write in registry!",

    >vbCritical,
    >> "ACCESSVIOLATION"
    >> GoTo DeleteRegistryValueError
    >> Case ERROR_KEY_DOES_NOT_EXIST
    >> 'Key does not exist...
    >> GoTo DeleteRegistryValueError
    >> Case ERROR_SUCCESS
    >> Case Else
    >> 'Unknown error...
    >> MsgBox "ERROR: Unknown error when writing in registry!",

    >vbCritical,
    >> "REGISTRY ERROR"
    >> GoTo DeleteRegistryValueError
    >> End Select
    >>
    >> 'Delete the key's value
    >> RetVal = RegDeleteValue(Result, ValueName)
    >>
    >> Select Case RetVal
    >> Case ERROR_SUCCESS
    >> 'ValueName was found and deleted...
    >> DeleteRegistryValue = True
    >> Case ERROR_KEY_DOES_NOT_EXIST
    >> 'ValueName did not exist...
    >> GoTo DeleteRegistryValueError
    >> Case Else
    >> 'Unknown error...
    >> MsgBox "ERROR: Unknown error when writing in registry!",

    >vbCritical,
    >> "REGISTRY ERROR"
    >> GoTo DeleteRegistryValueError
    >> End Select
    >>
    >> DeleteRegistryValueExit:
    >>
    >> On Error Resume Next
    >>
    >> 'Close the keys...
    >> RegCloseKey hKey
    >> RegCloseKey Result
    >>
    >> Exit Function
    >>
    >>
    >> DeleteRegistryValueError:
    >>
    >> DeleteRegistryValue = False
    >> GoTo DeleteRegistryValueExit
    >>
    >> End Function
    >>
    >> Public Function DeleteRegistryKey(ByVal KeyName As String) As Boolean
    >>
    >> 'Deletes a key and all values associated with it.
    >> 'Returns True if succeded, otherwise False...
    >>
    >> 'OS differences:
    >> 'Win 9X Deletes each and every subkey as well...
    >> 'Win NT/2000 Subkeys must not exist. These must first be handled
    >> ' individually from bottom and up...
    >>
    >>
    >> Dim hKey As Long
    >> Dim SubKey As String
    >> Dim Result As Long
    >> Dim RetVal As Long
    >>
    >> 'Determine main key (hKey) and sub key (SubKey) from KeyName...
    >> If InStr(1, KeyName, "HKEY_CLASSES_ROOT\", vbTextCompare) = 1 Then
    >> hKey = HKEY_CLASSES_ROOT
    >> SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_CLASSES_ROOT\"))
    >> ElseIf InStr(1, KeyName, "HKEY_CURRENT_USER\", vbTextCompare) = 1

    Then
    >> hKey = HKEY_CURRENT_USER
    >> SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_CURRENT_USER\"))
    >> ElseIf InStr(1, KeyName, "HKEY_LOCAL_MACHINE\", vbTextCompare) = 1

    >Then
    >> hKey = HKEY_LOCAL_MACHINE
    >> SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_LOCAL_MACHINE\"))
    >> ElseIf InStr(1, KeyName, "HKEY_USERS\", vbTextCompare) = 1 Then
    >> hKey = HKEY_USERS
    >> SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_USERS\"))
    >> Else
    >> 'Invalid KeyName...
    >> GoTo DeleteRegistryKeyError
    >> End If
    >>
    >> 'Open the key...
    >> 'Try this on NT/W2000!!! KEY_SET_VALUE may not be sufficient to delete
    >> the key...
    >> RetVal = RegOpenKeyEx(hKey, SubKey, 0, KEY_SET_VALUE, Result)
    >>
    >> Select Case RetVal
    >> Case ERROR_ACCESS_DENIED
    >> 'Probably NT and somewhere you should not be messing around...
    >> MsgBox "ERROR: Unauthorized attempt to write in registry!",

    >vbCritical,
    >> "ACCESSVIOLATION"
    >> GoTo DeleteRegistryKeyError
    >> Case ERROR_KEY_DOES_NOT_EXIST
    >> 'Specified key did not exist...
    >> GoTo DeleteRegistryKeyError
    >> Case ERROR_SUCCESS
    >> Case Else
    >> 'Unknown error...
    >> MsgBox "ERROR: Unknown error when writing in registry!",

    >vbCritical,
    >> "REGISTRY ERROR"
    >> GoTo DeleteRegistryKeyError
    >> End Select
    >>
    >> 'Delete the key and all valuenames in it...
    >> RetVal = RegDeleteKey(Result, "")
    >>
    >> Select Case RetVal
    >> Case ERROR_SUCCESS
    >> 'ValueName was found and deleted...
    >> 'With Win9X all subkeys are deleted as well...
    >> DeleteRegistryKey = True
    >> Case ERROR_ACCESS_DENIED
    >> 'Happens with NT/W2000 if there are any subkeys attached...
    >> 'If so each of them has to be deleted individually from bottom
    >> and up.
    >> 'There is a newer API-function, SHDeleteKey in Shlwapi.dll,

    >which
    >> should
    >> 'delete each and every subkey as this one does in Win9X, but
    >> I haven't tried
    >> 'it out yet...
    >> GoTo DeleteRegistryKeyError
    >> Case Else
    >> '????...
    >> GoTo DeleteRegistryKeyError
    >> End Select
    >>
    >> DeleteRegistryKeyExit:
    >>
    >> On Error Resume Next
    >>
    >> 'Close the keys...
    >> RegCloseKey hKey
    >> RegCloseKey Result
    >>
    >> Exit Function
    >>
    >>
    >> DeleteRegistryKeyError:
    >>
    >> DeleteRegistryKey = False
    >> GoTo DeleteRegistryKeyExit
    >>
    >> End Function
    >>
    >> Public Function GetComputerName() As String
    >>
    >> 'Yeah, there is an API for this, but why not like this when it only
    >> 'takes a single row of code to do it?
    >>
    >> GetComputerName =

    >GetRegistryValue("HKEY_LOCAL_MACHINE\System\CurrentControlSet\Control\Comput
    >erName\ComputerName",
    >> "ComputerName")
    >>
    >> End Function
    >>
    >>

    >
    >



  5. #20
    Michael Culley Guest

    Re: Writing in HKEY_LOCAL_MACHINE...Access is denied

    Bernie,

    OK, i'll try it again on a user account.

    > About the messagebox, -Feel free to modify the code to suit your needs. My
    > ordinary module has the optional boolean argument 'NoErrMsg' in some

    functions
    > to control the appearance of error messages.


    I can change the code easily to suit my needs, but that was not the point.
    The messageboxes should be changed to err.raise. This gives several
    advantages

    -It's the default VB behaviour (if a registry dll was released with VB it
    would raise errors)
    -It gives the programmer using your class the ability to do what they want
    with the error, either ignore it, show a message or take some other action
    -If the current code is used in ASP it will cause huge problems.

    --
    Michael Culley
    www.vbdotcom.com


    "Bernie" <magnus.bernroth@rejlers.se> wrote in message
    news:3c077269$1@147.208.176.211...
    >
    > Hi Michael,
    >
    > This piece of code is extracted from a multiuser enterprise system I've

    developed
    > and later on completed with lots of comments for educational purpose.

    Running
    > the enterprise app from the guest account was never the case and I

    honestly
    > have to tell I've never tried this code on that account. Anyway it works
    > with any of the created useraccount granted rights to the LAN (but not to
    > the admin group).
    >
    > I guess the possibilities for the guest account by nature must be quite

    limited
    > when it comes to making changes to the system. When I put this code

    together
    > I recall I was trying those rights flags from 'bottom to top' to see what
    > happened. When it worked as desired I didn't put any more efforts to it

    (!).
    >
    > About the messagebox, -Feel free to modify the code to suit your needs. My
    > ordinary module has the optional boolean argument 'NoErrMsg' in some

    functions
    > to control the appearance of error messages.
    >
    >
    > Regards
    > Bernie
    >
    > "Michael Culley" <mike@vbdotcom.com> wrote:
    > >Bernie,
    > >
    > >I tried you code and could not get it to work in win2000. I was using the
    > >guest account and kept getting an message saying I did not have access.

    > Am I
    > >doing something wrong?
    > >
    > >--
    > >Michael Culley
    > >www.vbdotcom.com
    > >
    > >
    > >"Bernie" <magnus.bernroth@rejlers.se> wrote in message
    > >news:3c04cbb3$1@147.208.176.211...
    > >>
    > >> "Bernie" <magnus.bernroth@rejlers.se> wrote:
    > >> >
    > >> >Hi,
    > >> >
    > >> >You should run the API RegCreateKeyEx with the flags

    > >REG_OPTION_NON_VOLATILE
    > >> >and (KEY_CREATE_SUB_KEY Or KEY_SET_VALUE) to let users without admin

    > >rights
    > >> >be able to create/write in the registry.
    > >> >
    > >> >Most samples on how RegCreateKeyEx works requests the highest possible

    > >rights
    > >> >wich works great on Win9X but returns Errcode 5 on NT-systems. By

    doing
    > >> so
    > >> >the user can write virtually everywhere in the registry, at least

    those
    > >> ordinary
    > >> >places like hkey\local machine\Software... or hkey\current

    > >user\software...
    > >> >
    > >> >Bu no means start juggeling with the user's rights...
    > >> >
    > >> >Bernie
    > >>
    > >> Well, what the heck. Try this code. It's on the house!!
    > >>
    > >> Put it in a module and call it's varoius functions. There is a lot of

    > >comments
    > >> in it, especially concerning the aspect of rights!! Most of it works on

    > >9X,
    > >> NT, 2K and XP though some parts haven't been fully tested on all OS's

    > yet
    > >> (see the notes inside). I guess the last function GetComputerName()

    > >explains
    > >> how to simply name the keys as strings...
    > >>
    > >>
    > >> Option Explicit
    > >>
    > >> 'Registry classes....
    > >> Private Const HKEY_CLASSES_ROOT = &H80000000
    > >> Private Const HKEY_CURRENT_USER = &H80000001
    > >> Private Const HKEY_LOCAL_MACHINE = &H80000002
    > >> Private Const HKEY_USERS = &H80000003
    > >>
    > >> 'Predefined value types (just a few of them used here)...
    > >> Private Const REG_NONE = (0) 'No value type
    > >> Private Const REG_SZ = (1) 'Unicode null

    > >terminated
    > >> string
    > >> Private Const REG_EXPAND_SZ = (2) 'Unicode null

    > >terminated
    > >> string with environment variable
    > >> Private Const REG_BINARY = (3) 'Binary format
    > >> Private Const REG_DWORD = (4) '32-bit number
    > >> Private Const REG_DWORD_LITTLE_ENDIAN = (4) '32-bit number

    (same
    > >> as REG_DWORD)
    > >> Private Const REG_DWORD_BIG_ENDIAN = (5) '32-bit number
    > >> Private Const REG_LINK = (6) 'Symbolic Link

    > >(unicode)
    > >> Private Const REG_MULTI_SZ = (7) 'Multiple Unicode

    > >strings
    > >> Private Const REG_RESOURCE_LIST = (8) 'Resource list in

    > >resource
    > >> map
    > >> Private Const REG_FULL_RESOURCE_DESCRIPTOR = (9) 'Resource list in

    > >hardware
    > >> description
    > >> Private Const REG_RESOURCE_REQUIREMENTS_LIST = (10) '??????
    > >>
    > >> Private Const REG_OPTION_NON_VOLATILE = 0
    > >>
    > >> 'This is a tricky part when i comes to NT/W2000 to
    > >> 'handle the security nicely. You should not need to
    > >> 'be an Admin to make use of the registry when running
    > >> 'an application. It is the programmers responsibility
    > >> 'to make these routines work properly...
    > >> Private Type SECURITY_ATTRIBUTES
    > >> nLength As Long
    > >> lpSecurityDescriptor As Long
    > >> bInheritHandle As Long
    > >> End Type
    > >>
    > >> Private Const KEY_QUERY_VALUE = &H1
    > >> Private Const KEY_SET_VALUE = &H2
    > >> Private Const KEY_CREATE_SUB_KEY = &H4
    > >>
    > >> 'Return values from API:s
    > >> Private Const ERROR_SUCCESS = 0&
    > >> Private Const ERROR_ACCESS_DENIED = 5&
    > >> Private Const ERROR_KEY_DOES_NOT_EXIST = 2&
    > >>
    > >> 'Predeclared API:s....
    > >> 'Creates a new key...
    > >> 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
    > >>
    > >> 'Opens the specific key for further action...
    > >> 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
    > >>
    > >> 'Gets type and data to from a value name associted with the open key...
    > >> Declare Function RegQueryValueEx 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
    > >>
    > >> 'Sets a new value to an open key...
    > >> Declare Function RegSetValueEx 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
    > >>
    > >> 'Closes the specified key...
    > >> Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As

    > >Long
    > >>
    > >> 'Deletes a value...
    > >> Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias

    > >"RegDeleteValueA"
    > >> (ByVal hKey As Long, ByVal lpValueName As String) As Long
    > >>
    > >> 'Deletes a key if no subkeys exist...
    > >> Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias

    > >"RegDeleteKeyA"
    > >> (ByVal hKey As Long, ByVal lpSubKey As String) As Long
    > >> '
    > >>
    > >> Private Function StripNullTerminator(KeyValue As String) As String
    > >>
    > >> 'KeyValue returned is a fixlength string (usually 255 spaces) which has

    > >been
    > >> populated
    > >> 'with the value returned from the API. It is populated from left to

    right
    > >> and the returned
    > >> 'value is terminated with chr(0). After that position only garbage

    exists.
    > >> So we search for
    > >> 'the first chr(0) and cut off everything from that position.
    > >>
    > >> Dim FirstNullPosition As Integer
    > >>
    > >> FirstNullPosition = InStr(1, KeyValue, vbNullChar)
    > >> StripNullTerminator = Left(KeyValue, FirstNullPosition - 1)
    > >>
    > >> End Function
    > >>
    > >> Public Function GetRegistryValue(ByVal KeyName As String, ByVal

    ValueName
    > >> As String, Optional BufferSize As Long) As Variant
    > >>
    > >> 'Gets the value in ValueName from the registrybranch KeyName...
    > >> 'Returns a string with the value. If an error occures Null is

    returned...
    > >> 'If a large value is expected the buffer can be increased from its

    default
    > >> 255 bytes...
    > >>
    > >> Dim hKey As Long
    > >> Dim SubKey As String
    > >> Dim dataBuffer As String
    > >> Dim Result As Long
    > >> Dim RetVal As Long
    > >> Dim Value As String
    > >>
    > >>
    > >> 'Determine main key (hKey) and sub key (SubKey) from KeyName...
    > >> If InStr(1, KeyName, "HKEY_CLASSES_ROOT\", vbTextCompare) = 1 Then
    > >> hKey = HKEY_CLASSES_ROOT
    > >> SubKey = Right(KeyName, Len(KeyName) -

    Len("HKEY_CLASSES_ROOT\"))
    > >> ElseIf InStr(1, KeyName, "HKEY_CURRENT_USER\", vbTextCompare) = 1

    > Then
    > >> hKey = HKEY_CURRENT_USER
    > >> SubKey = Right(KeyName, Len(KeyName) -

    Len("HKEY_CURRENT_USER\"))
    > >> ElseIf InStr(1, KeyName, "HKEY_LOCAL_MACHINE\", vbTextCompare) = 1

    > >Then
    > >> hKey = HKEY_LOCAL_MACHINE
    > >> SubKey = Right(KeyName, Len(KeyName) -

    Len("HKEY_LOCAL_MACHINE\"))
    > >> ElseIf InStr(1, KeyName, "HKEY_USERS\", vbTextCompare) = 1 Then
    > >> hKey = HKEY_USERS
    > >> SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_USERS\"))
    > >> Else
    > >> 'Invalid KeyName...
    > >> GoTo GetRegistryValueError
    > >> End If
    > >>
    > >> 'Create string with spaces as a buffer to be filled by the API...
    > >> If BufferSize < 255 Then BufferSize = 255
    > >> dataBuffer = Space(BufferSize)
    > >>
    > >>
    > >> 'Open the key for reading only...
    > >> RetVal = RegOpenKeyEx(hKey, SubKey, 0, KEY_QUERY_VALUE, Result)
    > >>
    > >>
    > >> If RetVal = ERROR_ACCESS_DENIED Then
    > >> MsgBox "ERROR: Unauthorized attempt to read in registry!",

    > >vbCritical,
    > >> "ACCESSVIOLATION"
    > >> GoTo GetRegistryValueError
    > >> ElseIf RetVal = ERROR_SUCCESS Then
    > >> 'Try to fill up dataBuffer with the value in ValueName...
    > >> 'It doesn't matter if it was stored as a string or as binary,

    > it
    > >> is copied
    > >> 'into the spacestring in dataBuffer as a binarystring ended

    with
    > >> chr(0) anyway...
    > >> RetVal = RegQueryValueEx(Result, ValueName, 0, 0, dataBuffer,

    > >BufferSize)
    > >> If RetVal = ERROR_SUCCESS Then
    > >> 'ValueName was found and the value in it is now in the

    > >beginning
    > >> of dataBuffer...
    > >> 'Se StripNullTerminator on how to extract it...
    > >> GetRegistryValue = StripNullTerminator(dataBuffer)
    > >> Else
    > >> 'ValueName was not found...
    > >> GoTo GetRegistryValueError
    > >> End If
    > >> Else
    > >> GoTo GetRegistryValueError
    > >> End If
    > >>
    > >>
    > >>
    > >> GetRegistryValueExit:
    > >>
    > >> On Error Resume Next
    > >>
    > >> RegCloseKey hKey
    > >> RegCloseKey Result
    > >>
    > >> Exit Function
    > >>
    > >> GetRegistryValueError:
    > >>
    > >> GetRegistryValue = Null
    > >> GoTo GetRegistryValueExit
    > >>
    > >> End Function
    > >>
    > >> Public Function SetRegistryValue(ByVal KeyName As String, ByVal

    ValueName
    > >> As String, ByVal Value As String, Optional BinaryValue As Boolean) As

    > >Boolean
    > >>
    > >> 'Sets ValueName in branch KeyName to Value. If it does not exist it is

    > >created...
    > >> 'Returns True if success, otherwise False...
    > >>
    > >> 'If BinaryValue = False, Value sets as a string, otherwise as binary...
    > >> 'The binary value has to be supplied in a string though...
    > >>
    > >> Dim hKey As Long
    > >> Dim SubKey As String
    > >> Dim Result As Long
    > >> Dim RetVal As Long
    > >> Dim RegType As Long
    > >> Dim SecAttrib As SECURITY_ATTRIBUTES
    > >> Dim Disp As Long
    > >>
    > >> 'ATTENTION: To remove the value a zerolength string can be passed

    > for
    > >> 'Win9X. But if that is done with NT4/W2000 the system goes bezerk.

    > >Putting
    > >> 'a chr(0) in the empty string makes it work in all systems. Don't

    > ask
    > >> me why,
    > >> '-When it works I don't spend any more time thinking of why...
    > >> If Len(Value) = 0 Then Value = Chr(0)
    > >>
    > >>
    > >> 'Determine main key (hKey) and sub key (SubKey) from KeyName...
    > >> If InStr(1, KeyName, "HKEY_CLASSES_ROOT\", vbTextCompare) = 1 Then
    > >> hKey = HKEY_CLASSES_ROOT
    > >> SubKey = Right(KeyName, Len(KeyName) -

    Len("HKEY_CLASSES_ROOT\"))
    > >> ElseIf InStr(1, KeyName, "HKEY_CURRENT_USER\", vbTextCompare) = 1

    > Then
    > >> hKey = HKEY_CURRENT_USER
    > >> SubKey = Right(KeyName, Len(KeyName) -

    Len("HKEY_CURRENT_USER\"))
    > >> ElseIf InStr(1, KeyName, "HKEY_LOCAL_MACHINE\", vbTextCompare) = 1

    > >Then
    > >> hKey = HKEY_LOCAL_MACHINE
    > >> SubKey = Right(KeyName, Len(KeyName) -

    Len("HKEY_LOCAL_MACHINE\"))
    > >> ElseIf InStr(1, KeyName, "HKEY_USERS\", vbTextCompare) = 1 Then
    > >> hKey = HKEY_USERS
    > >> SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_USERS\"))
    > >> Else
    > >> 'Invalid KeyName...
    > >> GoTo SetRegistryValueError
    > >> End If
    > >>
    > >>
    > >> 'Open the key (creates it if it does not exist)...
    > >> 'Note that authority asked for is a mix of flags

    (KEY_CREATE_SUB_KEY
    > >> Or KEY_SET_VALUE)
    > >> 'which is no more than you need for creating and writing in the

    > >registry.
    > >> All samples I
    > >> 'have seen used KEY_ALL_ACCESS but in NT4/W2000 you must be Admin

    > to
    > >> get it. In Win9X it
    > >> 'does not matter though...
    > >> RetVal = RegCreateKeyEx(hKey, SubKey, 0, "REG_DWORD",

    > >REG_OPTION_NON_VOLATILE,
    > >> (KEY_CREATE_SUB_KEY Or KEY_SET_VALUE), SecAttrib, Result, Disp)
    > >>
    > >> Select Case RetVal
    > >> Case ERROR_ACCESS_DENIED
    > >> 'Probably NT and somewhere you should not be messing

    around...
    > >> MsgBox "ERROR: Unauthorized attempt to write in registry!",

    > >vbCritical,
    > >> "ACCESSVIOLATION"
    > >> GoTo SetRegistryValueError
    > >> Case ERROR_SUCCESS
    > >> Case Else
    > >> 'Unknown error...
    > >> MsgBox "ERROR: Unknown error when writing in registry!",

    > >vbCritical,
    > >> "REGISTRY ERROR"
    > >> GoTo SetRegistryValueError
    > >> End Select
    > >>
    > >> If BinaryValue = True Then
    > >> RegType = REG_BINARY
    > >> Else
    > >> RegType = REG_SZ
    > >> End If
    > >>
    > >> 'Put in the data...
    > >> RetVal = RegSetValueEx(Result, ValueName, 0, RegType, Value,

    > >CLng(Len(Value)
    > >> + 1))
    > >>
    > >> Select Case RetVal
    > >> Case ERROR_ACCESS_DENIED
    > >> MsgBox "ERROR: Unauthorized attempt to write in registry!",

    > >vbCritical,
    > >> "ACCESSVIOLATION"
    > >> GoTo SetRegistryValueError
    > >> Case ERROR_SUCCESS
    > >> Case Else
    > >> 'Unknown error...
    > >> MsgBox "ERROR: Unknown error when writing in registry!",

    > >vbCritical,
    > >> "REGISTRY ERROR"
    > >> GoTo SetRegistryValueError
    > >> End Select
    > >>
    > >> SetRegistryValue = True
    > >>
    > >> SetRegistryValueExit:
    > >>
    > >> On Error Resume Next
    > >>
    > >> 'Close the keys...
    > >> RegCloseKey hKey
    > >> RegCloseKey Result
    > >>
    > >> Exit Function
    > >>
    > >> SetRegistryValueError:
    > >>
    > >> SetRegistryValue = False
    > >> GoTo SetRegistryValueExit
    > >>
    > >> End Function
    > >>
    > >> Public Function DeleteRegistryValue(ByVal KeyName As String, ByVal

    > >ValueName
    > >> As String) As Boolean
    > >>
    > >> 'Deletes a complete ValueName and the value associated with it...
    > >> 'Returns True if succeded, otherwise False...
    > >>
    > >>
    > >> Dim hKey As Long
    > >> Dim SubKey As String
    > >> Dim Result As Long
    > >> Dim RetVal As Long
    > >>
    > >> 'Determine main key (hKey) and sub key (SubKey) from KeyName...
    > >> If InStr(1, KeyName, "HKEY_CLASSES_ROOT\", vbTextCompare) = 1 Then
    > >> hKey = HKEY_CLASSES_ROOT
    > >> SubKey = Right(KeyName, Len(KeyName) -

    Len("HKEY_CLASSES_ROOT\"))
    > >> ElseIf InStr(1, KeyName, "HKEY_CURRENT_USER\", vbTextCompare) = 1

    > Then
    > >> hKey = HKEY_CURRENT_USER
    > >> SubKey = Right(KeyName, Len(KeyName) -

    Len("HKEY_CURRENT_USER\"))
    > >> ElseIf InStr(1, KeyName, "HKEY_LOCAL_MACHINE\", vbTextCompare) = 1

    > >Then
    > >> hKey = HKEY_LOCAL_MACHINE
    > >> SubKey = Right(KeyName, Len(KeyName) -

    Len("HKEY_LOCAL_MACHINE\"))
    > >> ElseIf InStr(1, KeyName, "HKEY_USERS\", vbTextCompare) = 1 Then
    > >> hKey = HKEY_USERS
    > >> SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_USERS\"))
    > >> Else
    > >> 'Invalid KeyName...
    > >> GoTo DeleteRegistryValueError
    > >> End If
    > >>
    > >> 'Open the key with Set_Value access...
    > >> 'Try this on NT/W2000!!! KEY_SET_VALUE should be sufficient

    according
    > >> to SDK documentation
    > >> 'but who knows that is true...
    > >> RetVal = RegOpenKeyEx(hKey, SubKey, 0, KEY_SET_VALUE, Result)
    > >>
    > >> Select Case RetVal
    > >> Case ERROR_ACCESS_DENIED
    > >> 'Probably NT and somewhere you should not be messing

    around...
    > >> MsgBox "ERROR: Unauthorized attempt to write in registry!",

    > >vbCritical,
    > >> "ACCESSVIOLATION"
    > >> GoTo DeleteRegistryValueError
    > >> Case ERROR_KEY_DOES_NOT_EXIST
    > >> 'Key does not exist...
    > >> GoTo DeleteRegistryValueError
    > >> Case ERROR_SUCCESS
    > >> Case Else
    > >> 'Unknown error...
    > >> MsgBox "ERROR: Unknown error when writing in registry!",

    > >vbCritical,
    > >> "REGISTRY ERROR"
    > >> GoTo DeleteRegistryValueError
    > >> End Select
    > >>
    > >> 'Delete the key's value
    > >> RetVal = RegDeleteValue(Result, ValueName)
    > >>
    > >> Select Case RetVal
    > >> Case ERROR_SUCCESS
    > >> 'ValueName was found and deleted...
    > >> DeleteRegistryValue = True
    > >> Case ERROR_KEY_DOES_NOT_EXIST
    > >> 'ValueName did not exist...
    > >> GoTo DeleteRegistryValueError
    > >> Case Else
    > >> 'Unknown error...
    > >> MsgBox "ERROR: Unknown error when writing in registry!",

    > >vbCritical,
    > >> "REGISTRY ERROR"
    > >> GoTo DeleteRegistryValueError
    > >> End Select
    > >>
    > >> DeleteRegistryValueExit:
    > >>
    > >> On Error Resume Next
    > >>
    > >> 'Close the keys...
    > >> RegCloseKey hKey
    > >> RegCloseKey Result
    > >>
    > >> Exit Function
    > >>
    > >>
    > >> DeleteRegistryValueError:
    > >>
    > >> DeleteRegistryValue = False
    > >> GoTo DeleteRegistryValueExit
    > >>
    > >> End Function
    > >>
    > >> Public Function DeleteRegistryKey(ByVal KeyName As String) As Boolean
    > >>
    > >> 'Deletes a key and all values associated with it.
    > >> 'Returns True if succeded, otherwise False...
    > >>
    > >> 'OS differences:
    > >> 'Win 9X Deletes each and every subkey as well...
    > >> 'Win NT/2000 Subkeys must not exist. These must first be handled
    > >> ' individually from bottom and up...
    > >>
    > >>
    > >> Dim hKey As Long
    > >> Dim SubKey As String
    > >> Dim Result As Long
    > >> Dim RetVal As Long
    > >>
    > >> 'Determine main key (hKey) and sub key (SubKey) from KeyName...
    > >> If InStr(1, KeyName, "HKEY_CLASSES_ROOT\", vbTextCompare) = 1 Then
    > >> hKey = HKEY_CLASSES_ROOT
    > >> SubKey = Right(KeyName, Len(KeyName) -

    Len("HKEY_CLASSES_ROOT\"))
    > >> ElseIf InStr(1, KeyName, "HKEY_CURRENT_USER\", vbTextCompare) = 1

    > Then
    > >> hKey = HKEY_CURRENT_USER
    > >> SubKey = Right(KeyName, Len(KeyName) -

    Len("HKEY_CURRENT_USER\"))
    > >> ElseIf InStr(1, KeyName, "HKEY_LOCAL_MACHINE\", vbTextCompare) = 1

    > >Then
    > >> hKey = HKEY_LOCAL_MACHINE
    > >> SubKey = Right(KeyName, Len(KeyName) -

    Len("HKEY_LOCAL_MACHINE\"))
    > >> ElseIf InStr(1, KeyName, "HKEY_USERS\", vbTextCompare) = 1 Then
    > >> hKey = HKEY_USERS
    > >> SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_USERS\"))
    > >> Else
    > >> 'Invalid KeyName...
    > >> GoTo DeleteRegistryKeyError
    > >> End If
    > >>
    > >> 'Open the key...
    > >> 'Try this on NT/W2000!!! KEY_SET_VALUE may not be sufficient to

    delete
    > >> the key...
    > >> RetVal = RegOpenKeyEx(hKey, SubKey, 0, KEY_SET_VALUE, Result)
    > >>
    > >> Select Case RetVal
    > >> Case ERROR_ACCESS_DENIED
    > >> 'Probably NT and somewhere you should not be messing

    around...
    > >> MsgBox "ERROR: Unauthorized attempt to write in registry!",

    > >vbCritical,
    > >> "ACCESSVIOLATION"
    > >> GoTo DeleteRegistryKeyError
    > >> Case ERROR_KEY_DOES_NOT_EXIST
    > >> 'Specified key did not exist...
    > >> GoTo DeleteRegistryKeyError
    > >> Case ERROR_SUCCESS
    > >> Case Else
    > >> 'Unknown error...
    > >> MsgBox "ERROR: Unknown error when writing in registry!",

    > >vbCritical,
    > >> "REGISTRY ERROR"
    > >> GoTo DeleteRegistryKeyError
    > >> End Select
    > >>
    > >> 'Delete the key and all valuenames in it...
    > >> RetVal = RegDeleteKey(Result, "")
    > >>
    > >> Select Case RetVal
    > >> Case ERROR_SUCCESS
    > >> 'ValueName was found and deleted...
    > >> 'With Win9X all subkeys are deleted as well...
    > >> DeleteRegistryKey = True
    > >> Case ERROR_ACCESS_DENIED
    > >> 'Happens with NT/W2000 if there are any subkeys attached...
    > >> 'If so each of them has to be deleted individually from

    bottom
    > >> and up.
    > >> 'There is a newer API-function, SHDeleteKey in Shlwapi.dll,

    > >which
    > >> should
    > >> 'delete each and every subkey as this one does in Win9X,

    but
    > >> I haven't tried
    > >> 'it out yet...
    > >> GoTo DeleteRegistryKeyError
    > >> Case Else
    > >> '????...
    > >> GoTo DeleteRegistryKeyError
    > >> End Select
    > >>
    > >> DeleteRegistryKeyExit:
    > >>
    > >> On Error Resume Next
    > >>
    > >> 'Close the keys...
    > >> RegCloseKey hKey
    > >> RegCloseKey Result
    > >>
    > >> Exit Function
    > >>
    > >>
    > >> DeleteRegistryKeyError:
    > >>
    > >> DeleteRegistryKey = False
    > >> GoTo DeleteRegistryKeyExit
    > >>
    > >> End Function
    > >>
    > >> Public Function GetComputerName() As String
    > >>
    > >> 'Yeah, there is an API for this, but why not like this when it only
    > >> 'takes a single row of code to do it?
    > >>
    > >> GetComputerName =

    >
    >GetRegistryValue("HKEY_LOCAL_MACHINE\System\CurrentControlSet\Control\Compu

    t
    > >erName\ComputerName",
    > >> "ComputerName")
    > >>
    > >> End Function
    > >>
    > >>

    > >
    > >

    >




  6. #21
    Michael Culley Guest

    Re: Writing in HKEY_LOCAL_MACHINE...Access is denied

    Bernie,

    OK, i'll try it again on a user account.

    > About the messagebox, -Feel free to modify the code to suit your needs. My
    > ordinary module has the optional boolean argument 'NoErrMsg' in some

    functions
    > to control the appearance of error messages.


    I can change the code easily to suit my needs, but that was not the point.
    The messageboxes should be changed to err.raise. This gives several
    advantages

    -It's the default VB behaviour (if a registry dll was released with VB it
    would raise errors)
    -It gives the programmer using your class the ability to do what they want
    with the error, either ignore it, show a message or take some other action
    -If the current code is used in ASP it will cause huge problems.

    --
    Michael Culley
    www.vbdotcom.com


    "Bernie" <magnus.bernroth@rejlers.se> wrote in message
    news:3c077269$1@147.208.176.211...
    >
    > Hi Michael,
    >
    > This piece of code is extracted from a multiuser enterprise system I've

    developed
    > and later on completed with lots of comments for educational purpose.

    Running
    > the enterprise app from the guest account was never the case and I

    honestly
    > have to tell I've never tried this code on that account. Anyway it works
    > with any of the created useraccount granted rights to the LAN (but not to
    > the admin group).
    >
    > I guess the possibilities for the guest account by nature must be quite

    limited
    > when it comes to making changes to the system. When I put this code

    together
    > I recall I was trying those rights flags from 'bottom to top' to see what
    > happened. When it worked as desired I didn't put any more efforts to it

    (!).
    >
    > About the messagebox, -Feel free to modify the code to suit your needs. My
    > ordinary module has the optional boolean argument 'NoErrMsg' in some

    functions
    > to control the appearance of error messages.
    >
    >
    > Regards
    > Bernie
    >
    > "Michael Culley" <mike@vbdotcom.com> wrote:
    > >Bernie,
    > >
    > >I tried you code and could not get it to work in win2000. I was using the
    > >guest account and kept getting an message saying I did not have access.

    > Am I
    > >doing something wrong?
    > >
    > >--
    > >Michael Culley
    > >www.vbdotcom.com
    > >
    > >
    > >"Bernie" <magnus.bernroth@rejlers.se> wrote in message
    > >news:3c04cbb3$1@147.208.176.211...
    > >>
    > >> "Bernie" <magnus.bernroth@rejlers.se> wrote:
    > >> >
    > >> >Hi,
    > >> >
    > >> >You should run the API RegCreateKeyEx with the flags

    > >REG_OPTION_NON_VOLATILE
    > >> >and (KEY_CREATE_SUB_KEY Or KEY_SET_VALUE) to let users without admin

    > >rights
    > >> >be able to create/write in the registry.
    > >> >
    > >> >Most samples on how RegCreateKeyEx works requests the highest possible

    > >rights
    > >> >wich works great on Win9X but returns Errcode 5 on NT-systems. By

    doing
    > >> so
    > >> >the user can write virtually everywhere in the registry, at least

    those
    > >> ordinary
    > >> >places like hkey\local machine\Software... or hkey\current

    > >user\software...
    > >> >
    > >> >Bu no means start juggeling with the user's rights...
    > >> >
    > >> >Bernie
    > >>
    > >> Well, what the heck. Try this code. It's on the house!!
    > >>
    > >> Put it in a module and call it's varoius functions. There is a lot of

    > >comments
    > >> in it, especially concerning the aspect of rights!! Most of it works on

    > >9X,
    > >> NT, 2K and XP though some parts haven't been fully tested on all OS's

    > yet
    > >> (see the notes inside). I guess the last function GetComputerName()

    > >explains
    > >> how to simply name the keys as strings...
    > >>
    > >>
    > >> Option Explicit
    > >>
    > >> 'Registry classes....
    > >> Private Const HKEY_CLASSES_ROOT = &H80000000
    > >> Private Const HKEY_CURRENT_USER = &H80000001
    > >> Private Const HKEY_LOCAL_MACHINE = &H80000002
    > >> Private Const HKEY_USERS = &H80000003
    > >>
    > >> 'Predefined value types (just a few of them used here)...
    > >> Private Const REG_NONE = (0) 'No value type
    > >> Private Const REG_SZ = (1) 'Unicode null

    > >terminated
    > >> string
    > >> Private Const REG_EXPAND_SZ = (2) 'Unicode null

    > >terminated
    > >> string with environment variable
    > >> Private Const REG_BINARY = (3) 'Binary format
    > >> Private Const REG_DWORD = (4) '32-bit number
    > >> Private Const REG_DWORD_LITTLE_ENDIAN = (4) '32-bit number

    (same
    > >> as REG_DWORD)
    > >> Private Const REG_DWORD_BIG_ENDIAN = (5) '32-bit number
    > >> Private Const REG_LINK = (6) 'Symbolic Link

    > >(unicode)
    > >> Private Const REG_MULTI_SZ = (7) 'Multiple Unicode

    > >strings
    > >> Private Const REG_RESOURCE_LIST = (8) 'Resource list in

    > >resource
    > >> map
    > >> Private Const REG_FULL_RESOURCE_DESCRIPTOR = (9) 'Resource list in

    > >hardware
    > >> description
    > >> Private Const REG_RESOURCE_REQUIREMENTS_LIST = (10) '??????
    > >>
    > >> Private Const REG_OPTION_NON_VOLATILE = 0
    > >>
    > >> 'This is a tricky part when i comes to NT/W2000 to
    > >> 'handle the security nicely. You should not need to
    > >> 'be an Admin to make use of the registry when running
    > >> 'an application. It is the programmers responsibility
    > >> 'to make these routines work properly...
    > >> Private Type SECURITY_ATTRIBUTES
    > >> nLength As Long
    > >> lpSecurityDescriptor As Long
    > >> bInheritHandle As Long
    > >> End Type
    > >>
    > >> Private Const KEY_QUERY_VALUE = &H1
    > >> Private Const KEY_SET_VALUE = &H2
    > >> Private Const KEY_CREATE_SUB_KEY = &H4
    > >>
    > >> 'Return values from API:s
    > >> Private Const ERROR_SUCCESS = 0&
    > >> Private Const ERROR_ACCESS_DENIED = 5&
    > >> Private Const ERROR_KEY_DOES_NOT_EXIST = 2&
    > >>
    > >> 'Predeclared API:s....
    > >> 'Creates a new key...
    > >> 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
    > >>
    > >> 'Opens the specific key for further action...
    > >> 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
    > >>
    > >> 'Gets type and data to from a value name associted with the open key...
    > >> Declare Function RegQueryValueEx 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
    > >>
    > >> 'Sets a new value to an open key...
    > >> Declare Function RegSetValueEx 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
    > >>
    > >> 'Closes the specified key...
    > >> Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As

    > >Long
    > >>
    > >> 'Deletes a value...
    > >> Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias

    > >"RegDeleteValueA"
    > >> (ByVal hKey As Long, ByVal lpValueName As String) As Long
    > >>
    > >> 'Deletes a key if no subkeys exist...
    > >> Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias

    > >"RegDeleteKeyA"
    > >> (ByVal hKey As Long, ByVal lpSubKey As String) As Long
    > >> '
    > >>
    > >> Private Function StripNullTerminator(KeyValue As String) As String
    > >>
    > >> 'KeyValue returned is a fixlength string (usually 255 spaces) which has

    > >been
    > >> populated
    > >> 'with the value returned from the API. It is populated from left to

    right
    > >> and the returned
    > >> 'value is terminated with chr(0). After that position only garbage

    exists.
    > >> So we search for
    > >> 'the first chr(0) and cut off everything from that position.
    > >>
    > >> Dim FirstNullPosition As Integer
    > >>
    > >> FirstNullPosition = InStr(1, KeyValue, vbNullChar)
    > >> StripNullTerminator = Left(KeyValue, FirstNullPosition - 1)
    > >>
    > >> End Function
    > >>
    > >> Public Function GetRegistryValue(ByVal KeyName As String, ByVal

    ValueName
    > >> As String, Optional BufferSize As Long) As Variant
    > >>
    > >> 'Gets the value in ValueName from the registrybranch KeyName...
    > >> 'Returns a string with the value. If an error occures Null is

    returned...
    > >> 'If a large value is expected the buffer can be increased from its

    default
    > >> 255 bytes...
    > >>
    > >> Dim hKey As Long
    > >> Dim SubKey As String
    > >> Dim dataBuffer As String
    > >> Dim Result As Long
    > >> Dim RetVal As Long
    > >> Dim Value As String
    > >>
    > >>
    > >> 'Determine main key (hKey) and sub key (SubKey) from KeyName...
    > >> If InStr(1, KeyName, "HKEY_CLASSES_ROOT\", vbTextCompare) = 1 Then
    > >> hKey = HKEY_CLASSES_ROOT
    > >> SubKey = Right(KeyName, Len(KeyName) -

    Len("HKEY_CLASSES_ROOT\"))
    > >> ElseIf InStr(1, KeyName, "HKEY_CURRENT_USER\", vbTextCompare) = 1

    > Then
    > >> hKey = HKEY_CURRENT_USER
    > >> SubKey = Right(KeyName, Len(KeyName) -

    Len("HKEY_CURRENT_USER\"))
    > >> ElseIf InStr(1, KeyName, "HKEY_LOCAL_MACHINE\", vbTextCompare) = 1

    > >Then
    > >> hKey = HKEY_LOCAL_MACHINE
    > >> SubKey = Right(KeyName, Len(KeyName) -

    Len("HKEY_LOCAL_MACHINE\"))
    > >> ElseIf InStr(1, KeyName, "HKEY_USERS\", vbTextCompare) = 1 Then
    > >> hKey = HKEY_USERS
    > >> SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_USERS\"))
    > >> Else
    > >> 'Invalid KeyName...
    > >> GoTo GetRegistryValueError
    > >> End If
    > >>
    > >> 'Create string with spaces as a buffer to be filled by the API...
    > >> If BufferSize < 255 Then BufferSize = 255
    > >> dataBuffer = Space(BufferSize)
    > >>
    > >>
    > >> 'Open the key for reading only...
    > >> RetVal = RegOpenKeyEx(hKey, SubKey, 0, KEY_QUERY_VALUE, Result)
    > >>
    > >>
    > >> If RetVal = ERROR_ACCESS_DENIED Then
    > >> MsgBox "ERROR: Unauthorized attempt to read in registry!",

    > >vbCritical,
    > >> "ACCESSVIOLATION"
    > >> GoTo GetRegistryValueError
    > >> ElseIf RetVal = ERROR_SUCCESS Then
    > >> 'Try to fill up dataBuffer with the value in ValueName...
    > >> 'It doesn't matter if it was stored as a string or as binary,

    > it
    > >> is copied
    > >> 'into the spacestring in dataBuffer as a binarystring ended

    with
    > >> chr(0) anyway...
    > >> RetVal = RegQueryValueEx(Result, ValueName, 0, 0, dataBuffer,

    > >BufferSize)
    > >> If RetVal = ERROR_SUCCESS Then
    > >> 'ValueName was found and the value in it is now in the

    > >beginning
    > >> of dataBuffer...
    > >> 'Se StripNullTerminator on how to extract it...
    > >> GetRegistryValue = StripNullTerminator(dataBuffer)
    > >> Else
    > >> 'ValueName was not found...
    > >> GoTo GetRegistryValueError
    > >> End If
    > >> Else
    > >> GoTo GetRegistryValueError
    > >> End If
    > >>
    > >>
    > >>
    > >> GetRegistryValueExit:
    > >>
    > >> On Error Resume Next
    > >>
    > >> RegCloseKey hKey
    > >> RegCloseKey Result
    > >>
    > >> Exit Function
    > >>
    > >> GetRegistryValueError:
    > >>
    > >> GetRegistryValue = Null
    > >> GoTo GetRegistryValueExit
    > >>
    > >> End Function
    > >>
    > >> Public Function SetRegistryValue(ByVal KeyName As String, ByVal

    ValueName
    > >> As String, ByVal Value As String, Optional BinaryValue As Boolean) As

    > >Boolean
    > >>
    > >> 'Sets ValueName in branch KeyName to Value. If it does not exist it is

    > >created...
    > >> 'Returns True if success, otherwise False...
    > >>
    > >> 'If BinaryValue = False, Value sets as a string, otherwise as binary...
    > >> 'The binary value has to be supplied in a string though...
    > >>
    > >> Dim hKey As Long
    > >> Dim SubKey As String
    > >> Dim Result As Long
    > >> Dim RetVal As Long
    > >> Dim RegType As Long
    > >> Dim SecAttrib As SECURITY_ATTRIBUTES
    > >> Dim Disp As Long
    > >>
    > >> 'ATTENTION: To remove the value a zerolength string can be passed

    > for
    > >> 'Win9X. But if that is done with NT4/W2000 the system goes bezerk.

    > >Putting
    > >> 'a chr(0) in the empty string makes it work in all systems. Don't

    > ask
    > >> me why,
    > >> '-When it works I don't spend any more time thinking of why...
    > >> If Len(Value) = 0 Then Value = Chr(0)
    > >>
    > >>
    > >> 'Determine main key (hKey) and sub key (SubKey) from KeyName...
    > >> If InStr(1, KeyName, "HKEY_CLASSES_ROOT\", vbTextCompare) = 1 Then
    > >> hKey = HKEY_CLASSES_ROOT
    > >> SubKey = Right(KeyName, Len(KeyName) -

    Len("HKEY_CLASSES_ROOT\"))
    > >> ElseIf InStr(1, KeyName, "HKEY_CURRENT_USER\", vbTextCompare) = 1

    > Then
    > >> hKey = HKEY_CURRENT_USER
    > >> SubKey = Right(KeyName, Len(KeyName) -

    Len("HKEY_CURRENT_USER\"))
    > >> ElseIf InStr(1, KeyName, "HKEY_LOCAL_MACHINE\", vbTextCompare) = 1

    > >Then
    > >> hKey = HKEY_LOCAL_MACHINE
    > >> SubKey = Right(KeyName, Len(KeyName) -

    Len("HKEY_LOCAL_MACHINE\"))
    > >> ElseIf InStr(1, KeyName, "HKEY_USERS\", vbTextCompare) = 1 Then
    > >> hKey = HKEY_USERS
    > >> SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_USERS\"))
    > >> Else
    > >> 'Invalid KeyName...
    > >> GoTo SetRegistryValueError
    > >> End If
    > >>
    > >>
    > >> 'Open the key (creates it if it does not exist)...
    > >> 'Note that authority asked for is a mix of flags

    (KEY_CREATE_SUB_KEY
    > >> Or KEY_SET_VALUE)
    > >> 'which is no more than you need for creating and writing in the

    > >registry.
    > >> All samples I
    > >> 'have seen used KEY_ALL_ACCESS but in NT4/W2000 you must be Admin

    > to
    > >> get it. In Win9X it
    > >> 'does not matter though...
    > >> RetVal = RegCreateKeyEx(hKey, SubKey, 0, "REG_DWORD",

    > >REG_OPTION_NON_VOLATILE,
    > >> (KEY_CREATE_SUB_KEY Or KEY_SET_VALUE), SecAttrib, Result, Disp)
    > >>
    > >> Select Case RetVal
    > >> Case ERROR_ACCESS_DENIED
    > >> 'Probably NT and somewhere you should not be messing

    around...
    > >> MsgBox "ERROR: Unauthorized attempt to write in registry!",

    > >vbCritical,
    > >> "ACCESSVIOLATION"
    > >> GoTo SetRegistryValueError
    > >> Case ERROR_SUCCESS
    > >> Case Else
    > >> 'Unknown error...
    > >> MsgBox "ERROR: Unknown error when writing in registry!",

    > >vbCritical,
    > >> "REGISTRY ERROR"
    > >> GoTo SetRegistryValueError
    > >> End Select
    > >>
    > >> If BinaryValue = True Then
    > >> RegType = REG_BINARY
    > >> Else
    > >> RegType = REG_SZ
    > >> End If
    > >>
    > >> 'Put in the data...
    > >> RetVal = RegSetValueEx(Result, ValueName, 0, RegType, Value,

    > >CLng(Len(Value)
    > >> + 1))
    > >>
    > >> Select Case RetVal
    > >> Case ERROR_ACCESS_DENIED
    > >> MsgBox "ERROR: Unauthorized attempt to write in registry!",

    > >vbCritical,
    > >> "ACCESSVIOLATION"
    > >> GoTo SetRegistryValueError
    > >> Case ERROR_SUCCESS
    > >> Case Else
    > >> 'Unknown error...
    > >> MsgBox "ERROR: Unknown error when writing in registry!",

    > >vbCritical,
    > >> "REGISTRY ERROR"
    > >> GoTo SetRegistryValueError
    > >> End Select
    > >>
    > >> SetRegistryValue = True
    > >>
    > >> SetRegistryValueExit:
    > >>
    > >> On Error Resume Next
    > >>
    > >> 'Close the keys...
    > >> RegCloseKey hKey
    > >> RegCloseKey Result
    > >>
    > >> Exit Function
    > >>
    > >> SetRegistryValueError:
    > >>
    > >> SetRegistryValue = False
    > >> GoTo SetRegistryValueExit
    > >>
    > >> End Function
    > >>
    > >> Public Function DeleteRegistryValue(ByVal KeyName As String, ByVal

    > >ValueName
    > >> As String) As Boolean
    > >>
    > >> 'Deletes a complete ValueName and the value associated with it...
    > >> 'Returns True if succeded, otherwise False...
    > >>
    > >>
    > >> Dim hKey As Long
    > >> Dim SubKey As String
    > >> Dim Result As Long
    > >> Dim RetVal As Long
    > >>
    > >> 'Determine main key (hKey) and sub key (SubKey) from KeyName...
    > >> If InStr(1, KeyName, "HKEY_CLASSES_ROOT\", vbTextCompare) = 1 Then
    > >> hKey = HKEY_CLASSES_ROOT
    > >> SubKey = Right(KeyName, Len(KeyName) -

    Len("HKEY_CLASSES_ROOT\"))
    > >> ElseIf InStr(1, KeyName, "HKEY_CURRENT_USER\", vbTextCompare) = 1

    > Then
    > >> hKey = HKEY_CURRENT_USER
    > >> SubKey = Right(KeyName, Len(KeyName) -

    Len("HKEY_CURRENT_USER\"))
    > >> ElseIf InStr(1, KeyName, "HKEY_LOCAL_MACHINE\", vbTextCompare) = 1

    > >Then
    > >> hKey = HKEY_LOCAL_MACHINE
    > >> SubKey = Right(KeyName, Len(KeyName) -

    Len("HKEY_LOCAL_MACHINE\"))
    > >> ElseIf InStr(1, KeyName, "HKEY_USERS\", vbTextCompare) = 1 Then
    > >> hKey = HKEY_USERS
    > >> SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_USERS\"))
    > >> Else
    > >> 'Invalid KeyName...
    > >> GoTo DeleteRegistryValueError
    > >> End If
    > >>
    > >> 'Open the key with Set_Value access...
    > >> 'Try this on NT/W2000!!! KEY_SET_VALUE should be sufficient

    according
    > >> to SDK documentation
    > >> 'but who knows that is true...
    > >> RetVal = RegOpenKeyEx(hKey, SubKey, 0, KEY_SET_VALUE, Result)
    > >>
    > >> Select Case RetVal
    > >> Case ERROR_ACCESS_DENIED
    > >> 'Probably NT and somewhere you should not be messing

    around...
    > >> MsgBox "ERROR: Unauthorized attempt to write in registry!",

    > >vbCritical,
    > >> "ACCESSVIOLATION"
    > >> GoTo DeleteRegistryValueError
    > >> Case ERROR_KEY_DOES_NOT_EXIST
    > >> 'Key does not exist...
    > >> GoTo DeleteRegistryValueError
    > >> Case ERROR_SUCCESS
    > >> Case Else
    > >> 'Unknown error...
    > >> MsgBox "ERROR: Unknown error when writing in registry!",

    > >vbCritical,
    > >> "REGISTRY ERROR"
    > >> GoTo DeleteRegistryValueError
    > >> End Select
    > >>
    > >> 'Delete the key's value
    > >> RetVal = RegDeleteValue(Result, ValueName)
    > >>
    > >> Select Case RetVal
    > >> Case ERROR_SUCCESS
    > >> 'ValueName was found and deleted...
    > >> DeleteRegistryValue = True
    > >> Case ERROR_KEY_DOES_NOT_EXIST
    > >> 'ValueName did not exist...
    > >> GoTo DeleteRegistryValueError
    > >> Case Else
    > >> 'Unknown error...
    > >> MsgBox "ERROR: Unknown error when writing in registry!",

    > >vbCritical,
    > >> "REGISTRY ERROR"
    > >> GoTo DeleteRegistryValueError
    > >> End Select
    > >>
    > >> DeleteRegistryValueExit:
    > >>
    > >> On Error Resume Next
    > >>
    > >> 'Close the keys...
    > >> RegCloseKey hKey
    > >> RegCloseKey Result
    > >>
    > >> Exit Function
    > >>
    > >>
    > >> DeleteRegistryValueError:
    > >>
    > >> DeleteRegistryValue = False
    > >> GoTo DeleteRegistryValueExit
    > >>
    > >> End Function
    > >>
    > >> Public Function DeleteRegistryKey(ByVal KeyName As String) As Boolean
    > >>
    > >> 'Deletes a key and all values associated with it.
    > >> 'Returns True if succeded, otherwise False...
    > >>
    > >> 'OS differences:
    > >> 'Win 9X Deletes each and every subkey as well...
    > >> 'Win NT/2000 Subkeys must not exist. These must first be handled
    > >> ' individually from bottom and up...
    > >>
    > >>
    > >> Dim hKey As Long
    > >> Dim SubKey As String
    > >> Dim Result As Long
    > >> Dim RetVal As Long
    > >>
    > >> 'Determine main key (hKey) and sub key (SubKey) from KeyName...
    > >> If InStr(1, KeyName, "HKEY_CLASSES_ROOT\", vbTextCompare) = 1 Then
    > >> hKey = HKEY_CLASSES_ROOT
    > >> SubKey = Right(KeyName, Len(KeyName) -

    Len("HKEY_CLASSES_ROOT\"))
    > >> ElseIf InStr(1, KeyName, "HKEY_CURRENT_USER\", vbTextCompare) = 1

    > Then
    > >> hKey = HKEY_CURRENT_USER
    > >> SubKey = Right(KeyName, Len(KeyName) -

    Len("HKEY_CURRENT_USER\"))
    > >> ElseIf InStr(1, KeyName, "HKEY_LOCAL_MACHINE\", vbTextCompare) = 1

    > >Then
    > >> hKey = HKEY_LOCAL_MACHINE
    > >> SubKey = Right(KeyName, Len(KeyName) -

    Len("HKEY_LOCAL_MACHINE\"))
    > >> ElseIf InStr(1, KeyName, "HKEY_USERS\", vbTextCompare) = 1 Then
    > >> hKey = HKEY_USERS
    > >> SubKey = Right(KeyName, Len(KeyName) - Len("HKEY_USERS\"))
    > >> Else
    > >> 'Invalid KeyName...
    > >> GoTo DeleteRegistryKeyError
    > >> End If
    > >>
    > >> 'Open the key...
    > >> 'Try this on NT/W2000!!! KEY_SET_VALUE may not be sufficient to

    delete
    > >> the key...
    > >> RetVal = RegOpenKeyEx(hKey, SubKey, 0, KEY_SET_VALUE, Result)
    > >>
    > >> Select Case RetVal
    > >> Case ERROR_ACCESS_DENIED
    > >> 'Probably NT and somewhere you should not be messing

    around...
    > >> MsgBox "ERROR: Unauthorized attempt to write in registry!",

    > >vbCritical,
    > >> "ACCESSVIOLATION"
    > >> GoTo DeleteRegistryKeyError
    > >> Case ERROR_KEY_DOES_NOT_EXIST
    > >> 'Specified key did not exist...
    > >> GoTo DeleteRegistryKeyError
    > >> Case ERROR_SUCCESS
    > >> Case Else
    > >> 'Unknown error...
    > >> MsgBox "ERROR: Unknown error when writing in registry!",

    > >vbCritical,
    > >> "REGISTRY ERROR"
    > >> GoTo DeleteRegistryKeyError
    > >> End Select
    > >>
    > >> 'Delete the key and all valuenames in it...
    > >> RetVal = RegDeleteKey(Result, "")
    > >>
    > >> Select Case RetVal
    > >> Case ERROR_SUCCESS
    > >> 'ValueName was found and deleted...
    > >> 'With Win9X all subkeys are deleted as well...
    > >> DeleteRegistryKey = True
    > >> Case ERROR_ACCESS_DENIED
    > >> 'Happens with NT/W2000 if there are any subkeys attached...
    > >> 'If so each of them has to be deleted individually from

    bottom
    > >> and up.
    > >> 'There is a newer API-function, SHDeleteKey in Shlwapi.dll,

    > >which
    > >> should
    > >> 'delete each and every subkey as this one does in Win9X,

    but
    > >> I haven't tried
    > >> 'it out yet...
    > >> GoTo DeleteRegistryKeyError
    > >> Case Else
    > >> '????...
    > >> GoTo DeleteRegistryKeyError
    > >> End Select
    > >>
    > >> DeleteRegistryKeyExit:
    > >>
    > >> On Error Resume Next
    > >>
    > >> 'Close the keys...
    > >> RegCloseKey hKey
    > >> RegCloseKey Result
    > >>
    > >> Exit Function
    > >>
    > >>
    > >> DeleteRegistryKeyError:
    > >>
    > >> DeleteRegistryKey = False
    > >> GoTo DeleteRegistryKeyExit
    > >>
    > >> End Function
    > >>
    > >> Public Function GetComputerName() As String
    > >>
    > >> 'Yeah, there is an API for this, but why not like this when it only
    > >> 'takes a single row of code to do it?
    > >>
    > >> GetComputerName =

    >
    >GetRegistryValue("HKEY_LOCAL_MACHINE\System\CurrentControlSet\Control\Compu

    t
    > >erName\ComputerName",
    > >> "ComputerName")
    > >>
    > >> End Function
    > >>
    > >>

    > >
    > >

    >




  7. #22
    Bernie Guest

    Re: Writing in HKEY_LOCAL_MACHINE...Access is denied


    Hi Michael,

    Sure you're right about the raise error thing... However there's a reason
    why we did it this way where I extracted this pice of code once. But that's
    another story...

    Merry Christmas

    Bernie

  8. #23
    Bernie Guest

    Re: Writing in HKEY_LOCAL_MACHINE...Access is denied


    Hi Michael,

    Sure you're right about the raise error thing... However there's a reason
    why we did it this way where I extracted this pice of code once. But that's
    another story...

    Merry Christmas

    Bernie

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
HTML5 Development Center
 
 
FAQ
Latest Articles
Java
.NET
XML
Database
Enterprise
Questions? Contact us.
C++
Web Development
Wireless
Latest Tips
Open Source


   Development Centers

   -- Android Development Center
   -- Cloud Development Project Center
   -- HTML5 Development Center
   -- Windows Mobile Development Center