Option Compare Database
Option Explicit
Public Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Public Const REG_SZ As Long = 1
Public Const REG_DWORD As Long = 4
Public Const REG_OPTION_NON_VOLATILE = 0 ' Key is preserved when system is rebooted
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_SET_VALUE = &H2
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_NOTIFY = &H10
Public Const KEY_CREATE_LINK = &H20
Public Const STANDARD_RIGHTS_ALL = &H1F0000
Public Const SYNCHRONIZE = &H100000
Public Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public 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
Public 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
Public 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
Public Sub MakeKey(valName As String, valData As String)
Dim retval As Long, lpDisp As Long, msg As String
Dim kNameSoftware As String, kNameVendor As String, kNameProgram As String
Dim hkSoftware As Long, hkVendor As Long, hkProgram As Long
Dim secatt As SECURITY_ATTRIBUTES
secatt.bInheritHandle = True
secatt.lpSecurityDescriptor = 0
secatt.nLength = 12
kNameSoftware = "Software"
kNameVendor = "AcmeSoftwareCo"
kNameProgram = "AcmeWidgetMaker"
'Key HKEY_LOCAL_MACHINE\Software will already exist definitly so we just open it
retval = RegOpenKeyEx(HKEY_LOCAL_MACHINE, kNameSoftware, 0, KEY_ALL_ACCESS, hkSoftware)
'Key HKEY_LOCAL_MACHINE\Software\AcmeSoftwareCo may not already exist
'so we attempt to create it. If it already exists this will just open it
retval = RegCreateKeyEx(hkSoftware, kNameVendor, 0, "", REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, secatt, hkVendor, lpDisp)
'Key HKEY_LOCAL_MACHINE\Software\AcmeSoftwareCo\AcmeWidgetMaker may not already exist
'so we attempt to create it. If it already exists this will just open it
retval = RegCreateKeyEx(hkVendor, kNameProgram, 0, "", REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, secatt, hkProgram, lpDisp)
'Now we try to alter the registry value
retval = RegSetValueExString(hkProgram, valName, 0, REG_SZ, valData, Len(valData))
If retval <> 0 Then
msg = "We got an unexpected response when setting the entry for the " & valName & vbCrLf
msg = msg & "Return code was " & retval & " should have been 0."
MsgBox msg
End If
'Now we close all the open keys
retval = RegCloseKey(hkProgram)
retval = RegCloseKey(hkVendor)
retval = RegCloseKey(hkSoftware)
End Sub
