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
>
>