Creating Registry Keys 1

[ViperInc]

Hi

Im having trouble creating some registry keys.

the following module code i received some time ago, and works great when i want to change or update values, but i cant seem to figour out how to get it to create new values, as the 'SetKeyValue' does not create them

any ideas???

thanx
code as follows:
----
Form
----
sKey = "Software\NewProgram\ProgramName"
sValue = "Log Path"
vSetting = path
sType = REG_SZ

SetKeyValue HKEY_LOCAL_MACHINE, sKey, sValue, vSetting, sType

------
Module
------
Option Explicit

Public EMail, FullName As String
Global Const REG_SZ As Long = 1 '***Registry string
Global Const REG_DWORD As Long = 4 '***Registry number (32-bit number)

Global Const HKEY_CLASSES_ROOT = &H80000000
Global Const HKEY_CURRENT_USER = &H80000001
Global Const HKEY_LOCAL_MACHINE = &H80000002
Global Const HKEY_USERS = &H80000003

Global Const ERROR_NONE = 0
Global Const ERROR_BADDB = 1
Global Const ERROR_BADKEY = 2
Global Const ERROR_CANTOPEN = 3
Global Const ERROR_CANTREAD = 4
Global Const ERROR_CANTWRITE = 5
Global Const ERROR_OUTOFMEMORY = 6
Global Const ERROR_INVALID_PARAMETER = 7
Global Const ERROR_ACCESS_DENIED = 8
Global Const ERROR_INVALID_PARAMETERS = 87
Global Const ERROR_NO_MORE_ITEMS = 259

Global Const KEY_ALL_ACCESS = &H3F

Global Const REG_OPTION_NON_VOLATILE = 0

Global gstrAppVersion As String

Declare Function RegCloseKey Lib "advapi32.dll" ( _
ByVal hKey As Long _
) As Long

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, _
ByVal lpSecurityAttributes As Long, _
phkResult As Long, _
lpdwDisposition As Long _
) As Long

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

Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" ( _
ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal lpReserved As Long, _
lpType As Long, _
ByVal lpData As String, _
lpcbData As Long _
) As Long

Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias _
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
String, ByVal lpReserved As Long, lpType As Long, lpData As _
Long, lpcbData As Long) As Long

Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias _
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
String, ByVal lpReserved As Long, lpType As Long, ByVal lpData _
As Long, lpcbData As Long) As Long

Declare Function RegSetValueExString Lib "advapi32.dll" Alias _
"RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As _
String, ByVal cbData As Long) As Long

Declare Function RegSetValueExLong Lib "advapi32.dll" Alias _
"RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, _
ByVal cbData As Long) As Long
Public Function SetValueEx( _
ByVal hKey As Long, _
sValueName As String, _
lType As Long, _
vValue As Variant _
) As Long

'*** Called By: SetKeyValue
'*** Description: Wrapper function around the registry API calls
'*** RegSetValueExString/Long. Determines if the value
'*** is a string or a long and calls the appropriate API.
'*** Return Value: Returns the API call's return value, which is its
'*** status (successful, error).

Dim lValue As Long
Dim sValue As String

Select Case lType
'***String
Case REG_SZ
sValue = vValue
SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))
'***32-bit number
Case REG_DWORD
lValue = vValue
SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)
End Select

End Function
Private Function QueryValueEx( _
ByVal lhKey As Long, _
ByVal szValueName As String, _
vValue As Variant _
) As Long

'*** Called By: QueryValue
'*** Description: Wrapper function around the registry API calls to
'*** RegQueryValueExLong and RegQueryValueExString.
'*** Determines size and type of data to be read.
'*** Determines if the value is a string or a long
'*** and calls the appropriate API.
'*** Return Value: Returns the API call's return value, which is its
'*** status (successful, error). The parameter vValue
'*** contains the value queried.

Dim cch As Long
Dim lrc As Long
Dim lType As Long
Dim lValue As Long
Dim sValue As String

On Error GoTo QueryValueExError

' Determine the size and type of data to be read
lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)

If lrc <> ERROR_NONE Then Error 5

Select Case lType
' For strings
Case REG_SZ:
sValue = String(cch, 0)
lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)
If lrc = ERROR_NONE Then
If Mid(sValue, cch, 1) = Chr(0) Then
vValue = Left$(sValue, cch - 1) ' get rid of trailing AsciiZ
Else
vValue = Left$(sValue, cch)
End If
Else
vValue = Empty
End If
' For DWORDS
Case REG_DWORD:
lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch)
If lrc = ERROR_NONE Then vValue = lValue
Case Else
'all other data types not supported
lrc = -1
End Select

QueryValueExExit:
QueryValueEx = lrc

Exit Function

QueryValueExError:
Resume QueryValueExExit ' Hmmmm
End Function
Public Sub SetKeyValue( _
ByVal lpParentKey As Long, _
sKeyName As String, _
sValueName As String, _
vValueSetting As Variant, _
lValueType As Long _
)

'*** Called By: Your code when you want to set a KeyValue
'*** Description: Opens the key you want to set, calls the wrapper
'*** function SetValueEx, and closes key.
'*** ADD ERROR HANDLING!!

Dim lRetVal As Long 'result of the SetValueEx function
Dim hKey As Long 'handle of open key

'open the specified key
lRetVal = RegOpenKeyEx(lpParentKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
' write the value
lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
' close the key
RegCloseKey (hKey)

End Sub
Public Function QueryValue( _
ByVal lpParentKey As Long, _
sKeyName As String, _
sValueName As String _
) As Variant

'*** Called By: Your code when you want to set a read a KeyValue
'*** Description: Opens the key you want to set, calls the wrapper
'*** function QueryValueEx, closes key.
'*** Return Value: The value you are querying
'*** ADD ERROR HANDLING!!

Dim lRetVal As Long 'result of the API functions
Dim hKey As Long 'handle of opened key
Dim vValue As Variant 'setting of queried value

' open the key
lRetVal = RegOpenKeyEx(lpParentKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
' get the value
lRetVal = QueryValueEx(hKey, sValueName, vValue)
' close the key
RegCloseKey (hKey)

QueryValue = vValue

End Function

 

[cdukes]

The above code that you have does not allow you to create a registry key, Only update and get the values. You will need to write code to allow you to create the key. The following code will create the key:

Dim tSA As SECURITY_ATTRIBUTES
Dim hKey As Long
Dim lCreate As Long
Dim e As Long

On Error GoTo HandleErr

e = RegCreateKeyEx(m_hClassKey, m_sSectionKey, 0, &quot;&quot;, REG_OPTION_NON_VOLATILE, _
KEY_ALL_ACCESS, tSA, hKey, lCreate)

Hope this helps,

Chris Dukes

 

[ViperInc]

yeah,
i found the problem..

there was some code which i didnt add...

hehe..

silly mistake...

thanx..

 

[BehnamPro]

It may be useful for you to create a registery key:

set ws=CreateObject(&quot;Wscript.Shell&quot
wscr.regwrite &quot;The registery path like:HKCU\Software\Microsoft\Windows\Behnam\&quot;,&quot;&quot;

That code make a new registery key & named &quot;Behnam&quot;
I hope this will be usefull for you.
BehnamPro