Attribute VB_Name = "WinReg"
Option Explicit

'' The Standard Win32 Registry API
'
' Registry Open Functions
Declare Function RegOpenKey Lib "advapi32.dll" _
      Alias "RegOpenKeyA" _
      (ByVal hKey As Long, ByVal lpctstr As String, _
      phkey 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 RegCreateKey Lib "advapi32.dll" _
      Alias "RegCreateKeyA" _
      (ByVal hKey As Long, ByVal lpctstr As String, _
      phkey 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, _
      lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, _
      lpdwDisposition As Long) As Long

Declare Function RegConnectRegistry Lib "advapi32.dll" _
        Alias "RegConnectRegistryA" _
        (ByVal lpMachineName As String, ByVal hKey As Long, _
        phkResult As Long) As Long

' Information Functions
Declare Function RegQueryInfoKey Lib "advapi32.dll" _
      Alias "RegQueryInfoKeyA" _
      (ByVal hKey As Long, ByVal lpClass As String, lpcbClass As Long, _
      ByVal lpReserved As Long, lpcSubKeys As Long, lpcbMaxSubKeyLen As Long, _
      lpcbMaxClassLen As Long, lpcValues As Long, _
      lpcbMaxValueNameLen As Long, lpcbMaxValueLen As Long, _
      lpcbSecurityDescriptor As Long, lpftLastWriteTime As Any) _
      As Long
' lpReserved modified by adding ByVal
'
' lpftLastWriteTime changed from FILETIME to As Any
' Must be passed by value if Null

' Enumeration Functions
Declare Function RegEnumValue Lib "advapi32.dll" _
      Alias "RegEnumValueA" _
      (ByVal hKey As Long, ByVal dwIndex As Long, _
      ByVal lpValueName As String, lpcbValueName As Long, _
      ByVal lpReserved As Long, lpType As Long, lpData As Byte, _
      lpcbData As Long) As Long
' Definition of lpReserved changed by adding ByVal

Declare Function RegEnumKey Lib "advapi32.dll" _
      Alias "RegEnumKeyA" _
      (ByVal hKey As Long, ByVal dwIndex As Long, _
      ByVal lpName As String, ByVal cbName As Long) _
      As Long

Declare Function RegEnumKeyEx Lib "advapi32.dll" _
      Alias "RegEnumKeyExA" _
      (ByVal hKey As Long, ByVal dwIndex As Long, _
      ByVal lpName As String, lpcbName As Long, _
      ByVal lpReserved As Long, ByVal lpClass As String, _
      lpcbClass As Long, lpftLastWriteTime As Any) As Long
' Definition of lpReserved changed by adding ByVal
'
' Definition of lpftLastWriteTime changed from FILETIME to As Any
' This means that 0 values must be passed by value
      
' Retrieval Functions
Declare Function RegQueryValue Lib "advapi32.dll" _
      Alias "RegQueryValueA" _
      (ByVal hKey As Long, ByVal lpSubkey As String, _
      ByVal lpValue As String, pcbData As Long) As Long

Declare Function RegQueryValueEx Lib "advapi32.dll" _
      Alias "RegQueryValueExA" _
      (ByVal hKey As Long, ByVal lpszValueName As String, _
      ByVal lpdwReserved As Long, lpdwType As Long, _
      lpData As Any, lpcbData As Long) As Long
' Definition of lpdwReserved modified by adding BYVAL

' Modification functions
Declare Function RegSetValue Lib "advapi32.dll" _
      Alias "RegSetValueA" _
      (ByVal hKey As Long, ByVal lpSubkey As String, _
      ByVal dwType As Long, ByVal lpData As String, _
      ByVal cbData As Long) As Long

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

' Deletion functions
Declare Function RegDeleteKey Lib "advapi32.dll" _
      Alias "RegDeleteKeyA" _
      (ByVal hKey As Long, ByVal lpszSubkey As String) _
      As Long

Declare Function RegDeleteValue Lib "advapi32.dll" _
      Alias "RegDeleteValueA" _
      (ByVal hKey As Long, ByVal lpValueName As String) _
      As Long

' Backup/Restore functions
Declare Function RegSaveKey Lib "advapi32.dll" _
      Alias "RegSaveKeyA" _
      (ByVal hKey As Long, ByVal lpFileName As String, _
      lpSecurityDescriptor As Any) _
      As Long
' Definition of lpSecurityDescriptor modified by changing type
' from SECURITY_ATTRIBUTES to Any

Declare Function RegLoadKey Lib "advapi32.dll" _
      Alias "RegLoadKeyA" _
      (ByVal hKey As Long, ByVal lpSubkey As String, _
      ByVal lpFile As String) As Long

Declare Function RegUnLoadKey Lib "advapi32.dll" _
      Alias "RegUnLoadKeyA" _
      (ByVal hKey As Long, ByVal lpSubkey As String) _
      As Long

Declare Function RegReplaceKey Lib "advapi32.dll" _
      Alias "RegReplaceKeyA" _
      (ByVal hKey As Long, ByVal lpSubkey As String, _
      ByVal lpNewFile As String, ByVal lpOldFile As String) _
      As Long

' RegRestoreKey not supported by Windows 95
Declare Function RegRestoreKey Lib "advapi32.dll" _
      Alias "RegRestoreKeyA" _
      (ByVal hKey As Long, ByVal lpFile As String, _
       ByVal dwFlags As Long) As Long

' Security functions (NOT IMPLEMENTED IN WIN95)
Declare Function RegGetKeySecurity Lib "advapi32.dll" _
      (ByVal hKey As Long, ByVal SecurityInformation As Long, _
      pSecurityDescriptor As SECURITY_DESCRIPTOR, _
      lpcbSecurityDescriptor As Long) As Long

Declare Function RegSetKeySecurity Lib "advapi32.dll" _
      (ByVal hKey As Long, ByVal SecurityInformation As Long, _
      pSecurityDescriptor As SECURITY_DESCRIPTOR) As Long

' Notification functions (NOT IMPLEMENTED IN WIN95)
Declare Function RegNotifyChangeKeyValue Lib "advapi32.dll" _
      (ByVal hKey As Long, ByVal bWatchSubtree As Boolean, _
      ByVal dwNotifyFilter As Long, ByVal hEvent As Long, _
      ByVal fAsynchronous As Boolean) As Long

' Auxiliary functions
Declare Function RegFlushKey Lib "advapi32.dll" _
      (ByVal hKey As Long) As Long

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

'' Special purpose Registry functions using the ALIAS clause
'
' Writes string data to a value entry
Declare Function RegSetStringValue Lib "advapi32.dll" _
      Alias "RegSetValueExA" _
      (ByVal hKey As Long, ByVal lpValueName As String, _
      ByVal Reserved As Long, ByVal dwType As Long, _
      ByVal lpData As String, ByVal cbData As Long) As Long
' This eliminates the need to explicitly pass cbData by value in the function call

' Initialization File Functions
Declare Function WriteProfileString Lib "kernel32" _
      Alias "WriteProfileStringA" _
      (ByVal lpszSection As String, ByVal lpszKeyName As String, _
      ByVal lpszString As String) As Long

Declare Function GetProfileString Lib "kernel32" _
      Alias "GetProfileStringA" _
      (ByVal lpAppName As String, ByVal lpKeyName As String, _
      ByVal lpDefault As String, ByVal lpReturnedString As String, _
      ByVal nSize As Long) As Long

' Registry-Related Functions
Declare Function ExpandEnvironmentStrings Lib "kernel32" _
      Alias "ExpandEnvironmentStringsA" _
      (ByVal lpSrc As String, ByVal lpDst As String, _
      ByVal nSize As Long) As Long

' Non-Registry API Functions
Public Declare Function GetVersionEx Lib "kernel32" _
      Alias "GetVersionExA" _
      (lpVersionInformation As OSVERSIONINFO) As Boolean

Declare Sub Sleep Lib "kernel32" _
      (ByVal dwMilliseconds As Long)

Declare Function CreateEvent Lib "kernel32" _
      Alias "CreateEventA" _
      (lpEventAttributes As SECURITY_ATTRIBUTES, _
      ByVal bManualReset As Long, ByVal bInitialState As Long, _
      ByVal lpName As String) As Long

Declare Function SendMessage Lib "user32" _
      Alias "SendMessageA" _
      (ByVal hwnd As Long, ByVal wMsg As Long, _
      ByVal wParam As Long, lParam As Any) _
      As Long

Declare Function SHFileOperation Lib "Shell32" _
      Alias "SHFileOperationA" _
      (lpFileOp As SHFILEOPSTRUCT) As Long

Declare Function RegisterServiceProcess Lib "kernel32" _
      (ByVal dwProcessID As Long, ByVal dwServiceType As Long) _
      As Long
      
' Structures
Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type

Type SECURITY_ATTRIBUTES
        nLength As Long
        lpSecurityDescriptor As Long
        bInheritHandle As Boolean
End Type

' for WinNT security functions only
Type ACL
   AclRevision As Byte
   Sbz1 As Byte
   AclSize As Integer
   AceCount As Integer
   Sbz2 As Integer
End Type

' for WinNT security functions only
Type SECURITY_DESCRIPTOR
   Revision As Byte
   Sbz1 As Byte
   Control As Long
   Owner As Long
   Group As Long
   Sacl As ACL
   Dacl As ACL
End Type

' Non-registry API structures
Type OSVERSIONINFO
   dwOSVersionInfoSize As Long
   dwMajorVersion As Long
   dwMinorVersion As Long
   dwBuildNumber As Long
   dwPlatformId As Long
   szCSDVersion As String * 128
End Type
 
Type SHFILEOPSTRUCT
        hwnd As Long
        wFunc As Long
        pFrom As String
        pTo As String
        fFlags As Integer
        fAnyOperationsAborted As Boolean
        hNameMappings As Long
        lpszProgressTitle As String '  only used if FOF_SIMPLEPROGRESS
End Type
  
Type WINDOWPOS
   hwnd As Long
   hwndInsertAfter As Long
   x As Integer
   y As Integer
   cx As Integer
   cy As Integer
   flags As Integer
End Type

' Constants for Registry top-level keys
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_DYN_DATA = &H80000006
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_USERS = &H80000003

' Return values
Public Const ERROR_SUCCESS = 0&
Public Const ERROR_FILE_NOT_FOUND = 2&
Public Const ERROR_ACCESS_DENIED = 5&
Public Const ERROR_INVALID_HANDLE = 6&
Public Const ERROR_INVALID_PARAMETER = 87
Public Const ERROR_CALL_NOT_IMPLEMENTED = 120&
Public Const ERROR_INSUFFICIENT_BUFFER = 122
Public Const ERROR_MORE_DATA = 234
Public Const ERROR_NO_MORE_ITEMS = 259&
Public Const ERROR_CANTOPEN = 1011&
Public Const ERROR_CANTREAD = 1012&
Public Const ERROR_CANTWRITE = 1013&
Public Const ERROR_REGISTRY_RECOVERED = 1014&
Public Const ERROR_REGISTRY_CORRUPT = 1015&
Public Const ERROR_REGISTRY_IO_FAILED = 1016&
Public Const ERROR_NOT_REGISTRY_FILE = 1017&
Public Const ERROR_KEY_DELETED = 1018&

' RegCreateKeyEx options
Public Const REG_OPTION_NON_VOLATILE = 0
Public Const REG_OPTION_VOLATILE = 1

' RegCreateKeyEx Disposition
Public Const REG_CREATED_NEW_KEY = &H1
Public Const REG_OPENED_EXISTING_KEY = &H2

' Registry data types
Public Const REG_NONE = 0
Public Const REG_SZ = 1
Public Const REG_EXPAND_SZ = 2
Public Const REG_BINARY = 3
Public Const REG_DWORD = 4
Public Const REG_DWORD_LITTLE_ENDIAN = 4
Public Const REG_DWORD_BIG_ENDIAN = 5
Public Const REG_LINK = 6
Public Const REG_MULTI_SZ = 7
Public Const REG_RESOURCE_LIST = 8
Public Const REG_FULL_RESOURCE_DESCRIPTOR = 9
Public Const REG_RESOURCE_REQUIREMENTS_LIST = 10

' Registry security attributes
Public Const READ_CONTROL = &H20000
Public Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Public Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Public Const KEY_QUERY_VALUE = &H1
Public Const STANDARD_RIGHTS_ALL = &H1F0000
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 SYNCHRONIZE = &H100000
Public Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Public Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
Public Const KEY_EXECUTE = (KEY_READ)
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))

' Security constants (for WinNT only)
' typedef DWORD SECURITY_INFORMATION, *PSECURITY_INFORMATION;
Public Const OWNER_SECURITY_INFORMATION = &H1
Public Const GROUP_SECURITY_INFORMATION = &H2
Public Const DACL_SECURITY_INFORMATION = &H4
Public Const SACL_SECURITY_INFORMATION = &H8

' Notification constants (for WInNT only)
Public Const REG_NOTIFY_CHANGE_NAME = &H1
Public Const REG_NOTIFY_CHANGE_ATTRIBUTES = &H2
Public Const REG_NOTIFY_CHANGE_LAST_SET = &H4
Public Const REG_NOTIFY_CHANGE_SECURITY = &H8

' User-Defined Error Codes for Err.Raise
Public Const vbREG_ERROR = vbObjectError + 2048

Public Const regERROR_SUCCESS = vbREG_ERROR + ERROR_SUCCESS
Public Const regERROR_ACCESS_DENIED = vbREG_ERROR + ERROR_ACCESS_DENIED
Public Const regERROR_FILE_NOT_FOUND = vbREG_ERROR + ERROR_FILE_NOT_FOUND
Public Const regERROR_CALL_NOT_IMPLEMENTED = vbREG_ERROR + ERROR_CALL_NOT_IMPLEMENTED
Public Const regERROR_INVALID_HANDLE = vbREG_ERROR + ERROR_INVALID_HANDLE
Public Const regERROR_INVALID_PARAMETER = vbREG_ERROR + ERROR_INVALID_PARAMETER
Public Const regERROR_NO_MORE_ITEMS = vbREG_ERROR + ERROR_NO_MORE_ITEMS
Public Const regERROR_MORE_DATA = vbREG_ERROR + ERROR_MORE_DATA
Public Const regERROR_CANTOPEN = vbREG_ERROR + ERROR_CANTOPEN
Public Const regERROR_CANTREAD = vbREG_ERROR + ERROR_CANTREAD
Public Const regERROR_CANTWRITE = vbREG_ERROR + ERROR_CANTWRITE
Public Const regERROR_REGISTRY_CORRUPT = vbREG_ERROR + ERROR_REGISTRY_CORRUPT
Public Const regERROR_REGISTRY_IO_FAILED = vbREG_ERROR + ERROR_REGISTRY_IO_FAILED
Public Const regERROR_REGISTRY_RECOVERED = vbREG_ERROR + ERROR_REGISTRY_RECOVERED
Public Const regERROR_KEY_DELETED = vbREG_ERROR + ERROR_KEY_DELETED
Public Const regERROR_NOT_REGISTRY_FILE = vbREG_ERROR + ERROR_NOT_REGISTRY_FILE

' Non-Registry constants
'
' For dwPlatformID parameter of GetVersionEx
Public Const VER_PLATFORM_WIN32s = 0
Public Const VER_PLATFORM_WIN32_WINDOWS = 1
Public Const VER_PLATFORM_WIN32_NT = 2
'
' For PostMessage/SendMessage
Public Const HWND_BROADCAST = &HFFFF&
'
' Messages
Public Const WM_WININICHANGE = &H1A
'
' Maximum path length
Public Const MAX_PATH = 260
' Null character

' SHFileOperation wFunc constants
Public Const FO_COPY = &H2
Public Const FO_DELETE = &H3
Public Const FO_MOVE = &H1
Public Const FO_RENAME = &H4

' SHFileOperation fFlag constants
Public Const FOF_ALLOWUNDO = &H40
Public Const FOF_CONFIRMMOUSE = &H2
Public Const FOF_FILESONLY = &H80
Public Const FOF_MULTIDESTFILES = &H1
Public Const FOF_NOCONFIRMATION = &H10
Public Const FOF_NOCONFIRMMKDIR = &H200
Public Const FOF_RENAMEONCOLLISION = &H8
Public Const FOF_SILENT = &H4
Public Const FOF_SIMPLEPROGRESS = &H100
Public Const FOF_WANTMAPPINGHANDLE = &H20

' Constants for RegisterServiceProcess
Public Const EWX_REALLYLOGOFF = &H80000000
Public Const RSP_SIMPLE_SERVICE = &H1&
Public Const RSP_UNREGISTER_SERVICE = &H0&

' Public NULL

' Extract a top-level key name from a string containing a fully
' qualified registry path
'
' Parameters:
'   strFullRegPath       Fully qualified registry path
'
' Returns:
'   string containing top-level key name
Public Function ExtractRegRoot(ByVal strFullRegPath As String) As String

Dim intSepPos As Integer      ' Position of path separator
Dim lngTopKey As Long
Dim strTopKey As String       ' Text for Registry root name

intSepPos = InStr(1, strFullRegPath, "\")
   
If intSepPos > 0 Then
   strTopKey = Left(strFullRegPath, intSepPos - 1)
Else
   strTopKey = strFullRegPath
End If

' Convert top-level key to constant
Select Case strTopKey
   Case "HKEY_CLASSES_ROOT"
      lngTopKey = HKEY_CLASSES_ROOT
   Case "HKEY_LOCAL_MACHINE"
      lngTopKey = HKEY_LOCAL_MACHINE
   Case "HKEY_CURRENT_USER"
      lngTopKey = HKEY_CURRENT_USER
   Case "HKEY_USERS"
      lngTopKey = HKEY_USERS
   Case "HKEY_CURRENT_CONFIG"
      lngTopKey = HKEY_CURRENT_CONFIG
   Case "HKEY_DYN_DATA"
      lngTopKey = HKEY_DYN_DATA
   Case "HKEY_PERFORMANCE_DATA"
      lngTopKey = HKEY_PERFORMANCE_DATA
   Case Else
      lngTopKey = 0
End Select

ExtractRegRoot = lngTopKey

End Function


' Separate a registry path from its top-level key
'
' Parameters:
'   strFullRegPath       Fully qualified registry path
'
' Returns:
'   string containing registry path without the top-level key name
Public Function ExtractRegPath(ByVal strFullRegPath As String) As String

Dim intSepPos As Integer
Dim strKeyPath As String

intSepPos = InStr(1, strFullRegPath, "\")
If intSepPos > 0 Then
   strKeyPath = Mid(strFullRegPath, intSepPos + 1)
Else
   strKeyPath = ""
End If

ExtractRegPath = strKeyPath

End Function