Option Explicit
'Creates the specified registry key if necessary.
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 Long, phkResult As Long, lpdwDisposition As Long) As Long
'Opens the specified registry key.
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _
(ByVal Hkey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
ByVal samDesired As Long, phkResult As Long) As Long
'Sets the data and type of a specified value under a registry key.
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" _
(ByVal Hkey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
'Note that if you declare the lpData parameter as String, you must pass it By Value.
'Closes a handle to the specified registry key.
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal Hkey As Long) As Long
'Error handling.
Private Const ERROR_FAILED = -999& 'Custom.
Private Const ERROR_SUCCESS = 0&
'Registry manipulation
Private Const REG_OPTION_NON_VOLATILE = 0
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_SET_VALUE = &H2
Private Const REG_SZ = 1
'Other stuff.
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const MySubKey = "SYSTEM\CurrentControlSet\Services\SharedAccess\Parameters\FirewallPolicy\DomainProfile\AuthorizedApplications\List"
Private Const MyValueName = "C:\Test\DoesThis\CreateNew\Folders.exe"
Private Const MyValue = "C:\Test\DoesThis\CreateNew\Folders.exe:*:Enabled:Folders"
Private Sub Form_Click()
MsgBox RegWriteSZ(HKEY_LOCAL_MACHINE, MySubKey, MyValueName, MyValue)
End Sub
Private Function RegWriteSZ(lngHKey As Long, strSubKey As String, strValueName As String, strValue As String) As Long
'Create a key and respective REG_SZ value from a simple string
'eg:- "Hello World".
Dim lngRetval As Long
Dim lngKeyHandle As Long
'Set the default return value.
RegWriteSZ = ERROR_FAILED
'Create the key.
If RegCreateKeyEx(lngHKey, strSubKey, 0&, 0&, REG_OPTION_NON_VOLATILE, KEY_CREATE_SUB_KEY, ByVal 0&, lngKeyHandle, lngRetval) = ERROR_SUCCESS Then
'Open the new key.
If RegOpenKeyEx(lngHKey, strSubKey, 0&, KEY_SET_VALUE, lngKeyHandle) = ERROR_SUCCESS Then
'Write it to the registry, and return a code.
RegWriteSZ = RegSetValueEx(lngKeyHandle, strValueName, 0&, REG_SZ, ByVal strValue, Len(strValue))
End If
End If
'Close any key opened with RegCreateKeyEx.
Call RegCloseKey(lngKeyHandle)
End Function