VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cRegistry"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit
Private Declare Function GetTempFileName _
                Lib "kernel32.dll" _
                Alias "GetTempFileNameA" (ByVal lpszPath As String, _
                                          ByVal lpPrefixString As String, _
                                          ByVal wUnique As Long, _
                                          ByVal lpTempFileName As String) As Long
Private Declare Function GetTempPath _
                Lib "kernel32.dll" _
                Alias "GetTempPathA" (ByVal nBufferLength As Long, _
                                      ByVal lpBuffer As String) As Long

' =========================================================
' Class:    cRegistry
' Author:   Steve McMahon
' Date  :   21 Feb 1997
'
' A nice class wrapper around the registry functions
' Allows searching,deletion,modification and addition
' of Keys or Values.
'
' Updated 29 April 1998 for VB5.
'   * Fixed GPF in EnumerateValues
'   * Added support for all registry types, not just strings
'   * Put all declares in local class
'   * Added VB5 Enums
'   * Added CreateKey and DeleteKey methods
'
' Updated 2 January 1999
'   * The CreateExeAssociation method failed to set up the
'     association correctly if the optional document icon
'     was not provided.
'   * Added new parameters to CreateExeAssociation to set up
'     other standard handlers: Print, Add, New
'   * Provided the CreateAdditionalEXEAssociations method
'     to allow non-standard menu items to be added (for example,
'     right click on a .VBP file.  VB installs Run and Make
'     menu items).
'
' Updated 8 February 2000
'   * Ensure CreateExeAssociation and related items sets up the
'     registry keys in the
'           HKEY_LOCAL_MACHINE\SOFTWARE\Classes
'     branch as well as the HKEY_CLASSES_ROOT branch.
'
'EDIT: Michael Burgwin, --7/8/2007 @ 19:22--
'   err, the HKEY_CLASSES_ROOT is an Alias for HKEY_LOCAL_MACHINE\SOFTWARE\Classes,
'   so the above modification to this class by steve as indicated above is moot.
'
' Updated 23 January 2004
'   * Added remote registry connection.  Thanks to Yaron Lavi
'     for providing the code.
'   * Fixed problem with saving zero length strings.  Thanks to
'     Shane Marsden for the fix.
'   * Fixed problem with truncation of binary data.  Thanks to
'     Morten Egelund Rasmussen.
'

'
' update 09 November 2006:

'
'--9/10/2007 @ 01:41--
'EDIT: Michael Burgwin
'Added useful "Feature". Now if the classkey is HKEY_CURRENT_USER, and a value is not present, the
'code will try to use a corresponding key in HKEY_LOCAL_MACHINE. This set's up automatic defaults.
'use "AutoMachineCheck" to toggle.
' ---------------------------------------------------------------------------
' vbAccelerator - free, advanced source code for VB programmers.
'     http://vbaccelerator.com
' =========================================================

'Registry Specific Access Rights
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private Const KEY_ALL_ACCESS = &H3F
Private Const KEY_WOW64_64KEY = &H100
'Open/Create Options
Private Const REG_OPTION_NON_VOLATILE = 0&
Private Const REG_OPTION_VOLATILE = &H1

'Key creation/open disposition
Private Const REG_CREATED_NEW_KEY = &H1
Private Const REG_OPENED_EXISTING_KEY = &H2

'masks for the predefined standard access types
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const SPECIFIC_RIGHTS_ALL = &HFFFF

'Define severity codes
Private Const ERROR_SUCCESS = 0&
Private Const ERROR_ACCESS_DENIED = 5
Private Const ERROR_INVALID_DATA = 13&
Private Const ERROR_MORE_DATA = 234 '  dderror
Private Const ERROR_NO_MORE_ITEMS = 259

'Structures Needed For Registry Prototypes
Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Boolean
End Type

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
'Registry Function Prototypes
Private Declare Function RegOpenKeyExA _
                Lib "advapi32" (ByVal hKey As Long, _
                                ByVal lpSubKey As String, _
                                ByVal ulOptions As Long, _
                                ByVal samDesired As Long, _
                                phkResult As Long) As Long

'Unicode...
Private Declare Function RegOpenKeyExW _
                Lib "advapi32" (ByVal hKey As Long, _
                                ByVal lpSubKey As Long, _
                                ByVal ulOptions As Long, _
                                ByVal samDesired As Long, _
                                phkResult As Long) As Long

Private Declare Function RegSetValueExStrA _
                Lib "advapi32" _
                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

Private Declare Function RegSetValueExStrW _
                Lib "advapi32" _
                Alias "RegSetValueExW" (ByVal hKey As Long, _
                                        ByVal lpValueName As Long, _
                                        ByVal Reserved As Long, _
                                        ByVal dwType As Long, _
                                        ByVal szData As Long, _
                                        ByVal cbData As Long) As Long

Private Declare Function RegSetValueExLongA _
                Lib "advapi32" _
                Alias "RegSetValueExA" (ByVal hKey As Long, _
                                        ByVal lpValueName As String, _
                                        ByVal Reserved As Long, _
                                        ByVal dwType As Long, _
                                        szData As Long, _
                                        ByVal cbData As Long) As Long

Private Declare Function RegSetValueExLongW _
                Lib "advapi32" _
                Alias "RegSetValueExW" (ByVal hKey As Long, _
                                        ByVal lpValueName As Long, _
                                        ByVal Reserved As Long, _
                                        ByVal dwType As Long, _
                                        szData As Long, _
                                        ByVal cbData As Long) As Long

Private Declare Function RegSetValueExByteA _
                Lib "advapi32" _
                Alias "RegSetValueExA" (ByVal hKey As Long, _
                                        ByVal lpValueName As String, _
                                        ByVal Reserved As Long, _
                                        ByVal dwType As Long, _
                                        szData As Byte, _
                                        ByVal cbData As Long) As Long

Private Declare Function RegSetValueExByteW _
                Lib "advapi32" _
                Alias "RegSetValueExW" (ByVal hKey As Long, _
                                        ByVal lpValueName As Long, _
                                        ByVal Reserved As Long, _
                                        ByVal dwType As Long, _
                                        szData As Byte, _
                                        ByVal cbData As Long) As Long

Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long

'BOOL WINAPI GetSystemRegistryQuota(
'  __out_opt  PDWORD pdwQuotaAllowed,
'  __out_opt  PDWORD pdwQuotaUsed
');

Private Declare Function GetSystemRegistryQuota _
                Lib "kernel32.dll" (ByVal pdwAllowed As Long, _
                                    ByVal pdwUsed As Long) As Long

'Private Type FILETIME
'    dwLowDateTime As Long
'    dwHighDateTime As Long
'End Type

Private Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
End Type

Private Declare Function FileTimeToSystemTime _
                Lib "kernel32.dll" (ByRef lpFileTime As FILETIME, _
                                    ByRef lpSystemTime As SYSTEMTIME) As Long

Private Declare Function RegQueryValueExStrA _
                Lib "advapi32" _
                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
Private Declare Function RegQueryValueExStrW _
                Lib "advapi32" _
                Alias "RegQueryValueExW" (ByVal hKey As Long, _
                                          ByVal lpValueName As Long, _
                                          ByVal lpReserved As Long, _
                                          ByRef lpType As Long, _
                                          ByVal szData As Long, _
                                          ByRef lpcbData As Long) As Long

'!Current progress of Unicode conversion....

Private Declare Function RegQueryValueExLongA _
                Lib "advapi32" _
                Alias "RegQueryValueExA" (ByVal hKey As Long, _
                                          ByVal lpValueName As String, _
                                          ByVal lpReserved As Long, _
                                          ByRef lpType As Long, _
                                          szData As Long, _
                                          ByRef lpcbData As Long) As Long

Private Declare Function RegQueryValueExLongW _
                Lib "advapi32" _
                Alias "RegQueryValueExW" (ByVal hKey As Long, _
                                          ByVal lpValueName As Long, _
                                          ByVal lpReserved As Long, _
                                          ByRef lpType As Long, _
                                          szData As Long, _
                                          ByRef lpcbData As Long) As Long

Private Declare Function RegQueryValueExByteA _
                Lib "advapi32" _
                Alias "RegQueryValueExA" (ByVal hKey As Long, _
                                          ByVal lpValueName As String, _
                                          ByVal lpReserved As Long, _
                                          ByRef lpType As Long, _
                                          szData As Byte, _
                                          ByRef lpcbData As Long) As Long
Private Declare Function RegQueryValueExByteW _
                Lib "advapi32" _
                Alias "RegQueryValueExW" (ByVal hKey As Long, _
                                          ByVal lpValueName As Long, _
                                          ByVal lpReserved As Long, _
                                          ByRef lpType As Long, _
                                          szData As Byte, _
                                          ByRef lpcbData As Long) As Long

Private Declare Function RegCreateKeyExA _
                Lib "advapi32" (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

Private Declare Function RegCreateKeyExW _
                Lib "advapi32" (ByVal hKey As Long, _
                                ByVal lpSubKey As Long, _
                                ByVal Reserved As Long, _
                                ByVal lpClass As Long, _
                                ByVal dwOptions As Long, _
                                ByVal samDesired As Long, _
                                lpSecurityAttributes As SECURITY_ATTRIBUTES, _
                                phkResult As Long, _
                                lpdwDisposition As Long) As Long

Private Declare Function RegEnumKeyExA _
                Lib "advapi32.dll" (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 FILETIME) As Long

Private Declare Function RegEnumKeyExW _
                Lib "advapi32.dll" (ByVal hKey As Long, _
                                    ByVal dwIndex As Long, _
                                    ByVal lpName As Long, _
                                    lpcbName As Long, _
                                    ByVal lpReserved As Long, _
                                    ByVal lpClass As Long, _
                                    lpcbClass As Long, _
                                    lpftLastWriteTime As FILETIME) As Long

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

Private Declare Function RegEnumValueA _
                Lib "advapi32.dll" (ByVal hKey As Long, _
                                    ByVal dwIndex As Long, _
                                    ByVal lpValueName As String, _
                                    lpcbValueName As Long, _
                                    ByVal lpReserved As Long, _
                                    ByVal lpType As Long, _
                                    ByVal lpData As Long, _
                                    ByVal lpcbData As Long) As Long
Private Declare Function RegEnumValueLongA _
                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 Long, _
                                       lpcbData As Long) As Long
Private Declare Function RegEnumValueStrA _
                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, _
                                       ByVal lpData As String, _
                                       lpcbData As Long) As Long
Private Declare Function RegEnumValueByteA _
                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

Private Declare Function RegEnumValueW _
                Lib "advapi32.dll" (ByVal hKey As Long, _
                                    ByVal dwIndex As Long, _
                                    ByVal lpValueName As Long, _
                                    lpcbValueName As Long, _
                                    ByVal lpReserved As Long, _
                                    ByVal lpType As Long, _
                                    ByVal lpData As Long, _
                                    ByVal lpcbData As Long) As Long
Private Declare Function RegEnumValueLongW _
                Lib "advapi32.dll" _
                Alias "RegEnumValueW" (ByVal hKey As Long, _
                                       ByVal dwIndex As Long, _
                                       ByVal lpValueName As Long, _
                                       lpcbValueName As Long, _
                                       ByVal lpReserved As Long, _
                                       lpType As Long, _
                                       lpData As Long, _
                                       lpcbData As Long) As Long
Private Declare Function RegEnumValueStrW _
                Lib "advapi32.dll" _
                Alias "RegEnumValueW" (ByVal hKey As Long, _
                                       ByVal dwIndex As Long, _
                                       ByVal lpValueName As Long, _
                                       lpcbValueName As Long, _
                                       ByVal lpReserved As Long, _
                                       lpType As Long, _
                                       ByVal lpData As Long, _
                                       lpcbData As Long) As Long
Private Declare Function RegEnumValueByteW _
                Lib "advapi32.dll" _
                Alias "RegEnumValueW" (ByVal hKey As Long, _
                                       ByVal dwIndex As Long, _
                                       ByVal lpValueName As Long, _
                                       lpcbValueName As Long, _
                                       ByVal lpReserved As Long, _
                                       lpType As Long, _
                                       lpData As Byte, _
                                       lpcbData As Long) As Long

Private Declare Function RegConnectRegistry _
                Lib "advapi32.dll" _
                Alias "RegConnectRegistryA" (ByVal lpMachineName As String, _
                                             ByVal hKey As Long, _
                                             phKey As Long) As Long
Private 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
Private Declare Function RegDeleteKey _
                Lib "advapi32.dll" _
                Alias "RegDeleteKeyA" (ByVal hKey As Long, _
                                       ByVal lpSubKey As String) As Long
Private Declare Function RegDeleteValue _
                Lib "advapi32.dll" _
                Alias "RegDeleteValueA" (ByVal hKey As Long, _
                                         ByVal lpValueName As String) As Long

Private Declare Sub CopyMemory _
                Lib "kernel32" _
                Alias "RtlMoveMemory" (lpvDest As Any, _
                                       lpvSource As Any, _
                                       ByVal cbCopy As Long)
Private Declare Function ExpandEnvironmentStrings _
                Lib "kernel32" _
                Alias "ExpandEnvironmentStringsA" (ByVal lpSrc As String, _
                                                   ByVal lpDst As String, _
                                                   ByVal nSize As Long) As Long

'I don't use the INI API since they are deprecated.

'What type of read is occuring?
Private mvarReadFrom As String  'Defaults to "Registry"
'can be changed to filename, which will cause use of INI file functions.

Public Enum ERegistryClassConstants
    hhkey_classes_root = &H80000000
    HHKEY_CURRENT_USER = &H80000001
    HHKEY_LOCAL_MACHINE = &H80000002
    HHKEY_USERS = &H80000003
    'HHKEY_PERF_ROOT = HKEY_LOCAL_MACHINE
    HHKEY_PERFORMANCE_DATA = &H80000004

End Enum

Public Enum ERegistryValueTypes
    'Predefined Value Types
    RREG_NONE = (0)                         'No value type
    RREG_SZ = (1)                           'Unicode nul terminated string
    RREG_EXPAND_SZ = (2)                    'Unicode nul terminated string
    ' w/enviornment var
    RREG_BINARY = (3)                       'Free form binary
    RREG_DWORD = (4)                        '32-bit number
    RREG_DWORD_LITTLE_ENDIAN = (4)          '32-bit number (same as REG_DWORD)
    RREG_DWORD_BIG_ENDIAN = (5)             '32-bit number
    RREG_LINK = (6)                         'Symbolic Link (unicode)
    RREG_MULTI_SZ = (7)                     'Multiple Unicode strings
    RREG_RESOURCE_LIST = (8)                'Resource list in the resource map
    RREG_FULL_RESOURCE_DESCRIPTOR = (9)     'Resource list in the hardware
    Description
    RREG_RESOURCE_REQUIREMENTS_LIST = (10)
End Enum

Private m_hClassKey             As Long
Private m_sSectionKey           As String
Private m_sValueKey             As String
Private m_vValue                As Variant
Private m_sSetValue             As String
Private m_vDefault              As Variant
Private m_eValueType            As ERegistryValueTypes
Private m_sMachine              As String

Private m_SearchCorrespondingLM As Boolean  'wether to use the value in a corresponding
'HKEY_LOCAL_MACHINE key when HKEY_CURRENT_USER is specified and a value is not found there.
Private mDirect64bit            As Boolean
'Version....

'Private Declare Function RegQueryInfoKey Lib "advapi32.dll" Alias "RegQueryInfoKeyA" (ByVal hKey As Long, ByVal lpClass As String, ByRef lpcbClass As Long, ByRef lpReserved As Long, ByRef lpcSubKeys As Long, ByRef lpcbMaxSubKeyLen As Long, ByRef lpcbMaxClassLen As Long, ByRef lpcValues As Long, ByRef lpcbMaxValueNameLen As Long, ByRef lpcbMaxValueLen As Long, ByRef lpcbSecurityDescriptor As Long, ByRef lpftLastWriteTime As FILETIME) As Long

Private Declare Function GetVersionEx _
                Lib "kernel32.dll" _
                Alias "GetVersionExA" (ByRef lpVersionInformation As OSVERSIONINFO) As Long
Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128 ' Maintenance string for PSS usage
End Type
Private Const VER_PLATFORM_WIN32_NT As Long = 2
Public Function RegistryMaxSize() As Long
    Dim regmax   As Long
    Dim regquota As Long, Ret As Long
    Ret = GetSystemRegistryQuota(VarPtr(regmax), VarPtr(regquota))
    RegistryMaxSize = regmax
End Function
Public Function RegistryCurrentSize() As Long
    '

    Dim regmax   As Long
    Dim regquota As Long
    GetSystemRegistryQuota VarPtr(regmax), VarPtr(regquota)
    RegistryCurrentSize = regquota
End Function
Function IsWinNT() As Boolean
    Static OSver As OSVERSIONINFO
    If OSver.dwOSVersionInfoSize = 0 Then
        OSver.dwOSVersionInfoSize = Len(OSver)
        GetVersionEx OSver
    
    End If
    IsWinNT = OSver.dwPlatformId = VER_PLATFORM_WIN32_NT

    'IsWinNt = False
    
End Function

'Unicode/ANSI....
Private Function RegSetValueExStr(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
    '
    If IsWinNT Then
        RegSetValueExStr = RegSetValueExStrW(hKey, StrPtr(lpValueName), Reserved, _
                dwType, StrPtr(szData), cbData * 2)

    Else
        RegSetValueExStr = RegSetValueExStrA(hKey, lpValueName, Reserved, dwType, _
                szData, cbData)

    End If

End Function

Private Function RegSetValueExLong(ByVal hKey As Long, _
                                   ByVal lpValueName As String, _
                                   ByVal Reserved As Long, _
                                   ByVal dwType As Long, _
                                   szData As Long, _
                                   ByVal cbData As Long) As Long

    If IsWinNT Then
        RegSetValueExLong = RegSetValueExLongW(hKey, StrPtr(lpValueName), Reserved, _
                dwType, szData, cbData)

    Else

        RegSetValueExLong = RegSetValueExLongA(hKey, lpValueName, Reserved, dwType, _
                szData, cbData)
    End If

End Function

Private Function RegSetValueExByte(ByVal hKey As Long, _
                                   ByVal lpValueName As String, _
                                   ByVal Reserved As Long, _
                                   ByVal dwType As Long, _
                                   szData As Byte, _
                                   ByVal cbData As Long) As Long

    If IsWinNT Then
        RegSetValueExByte = RegSetValueExByteW(hKey, StrPtr(lpValueName), Reserved, _
                dwType, szData, cbData)
    Else
        RegSetValueExByte = RegSetValueExByteA(hKey, lpValueName, Reserved, dwType, _
                szData, cbData)
    End If

End Function
Private Function RegQueryValueExStr(ByVal hKey As Long, _
                                    ByVal lpValueName As String, _
                                    ByVal lpReserved As Long, _
                                    ByRef lpType As Long, _
                                    ByRef szData As String, _
                                    ByRef lpcbData As Long) As Long

    If IsWinNT Then
        szData = Space$(lpcbData)
        RegQueryValueExStr = RegQueryValueExStrW(hKey, StrPtr(lpValueName), lpReserved, _
                lpType, StrPtr(szData), lpcbData * 2)
    
    Else
        RegQueryValueExStr = RegQueryValueExStrA(hKey, lpValueName, lpReserved, lpType, _
                szData, lpcbData)
    End If

    szData = Replace$(szData, vbNullChar, "")
    Debug.Print "returning " & szData
End Function
Private Function RegQueryValueExLong(ByVal hKey As Long, _
                                     ByVal lpValueName As String, _
                                     ByVal lpReserved As Long, _
                                     ByRef lpType As Long, _
                                     szData As Long, _
                                     ByRef lpcbData As Long) As Long

    If IsWinNT Then
        RegQueryValueExLong = RegQueryValueExLongW(hKey, StrPtr(lpValueName), _
                lpReserved, lpType, szData, lpcbData)
    Else
        RegQueryValueExLong = RegQueryValueExLongA(hKey, lpValueName, lpReserved, _
                lpType, szData, lpcbData)
    End If

End Function
Private Function RegQueryValueExByte(ByVal hKey As Long, _
                                     ByVal lpValueName As String, _
                                     ByVal lpReserved As Long, _
                                     ByRef lpType As Long, _
                                     szData As Byte, _
                                     ByRef lpcbData As Long) As Long

    If IsWinNT Then
        RegQueryValueExByte = RegQueryValueExByteW(hKey, StrPtr(lpValueName), _
                lpReserved, lpType, szData, lpcbData)
    
    Else

        RegQueryValueExByte = RegQueryValueExByteA(hKey, lpValueName, lpReserved, _
                lpType, szData, lpcbData)
    End If
End Function

Private Function RegOpenKeyEx(ByVal hKey As Long, _
                              ByVal lpSubKey As String, _
                              ByVal ulOptions As Long, _
                              ByVal samDesired As Long, _
                              phkResult As Long) As Long
    If IsWinNT Then
        RegOpenKeyEx = RegOpenKeyExW(hKey, StrPtr(lpSubKey), ulOptions, samDesired, _
                phkResult)
    Else
        RegOpenKeyEx = RegOpenKeyExA(hKey, lpSubKey, ulOptions, samDesired, phkResult)
    End If

End Function
Private Function RegCreateKeyEx(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

    If IsWinNT Then
        RegCreateKeyEx = RegCreateKeyExW(hKey, StrPtr(lpSubKey), Reserved, StrPtr( _
                lpClass), dwOptions, samDesired, lpSecurityAttributes, phkResult, _
                lpdwDisposition)
    Else
        RegCreateKeyEx = RegCreateKeyExA(hKey, lpSubKey, Reserved, lpClass, dwOptions, _
                samDesired, lpSecurityAttributes, phkResult, lpdwDisposition)

    End If

End Function

Private Function RegEnumKeyEx(ByVal hKey As Long, _
                              ByVal dwIndex As Long, _
                              ByRef lpName As String, _
                              lpcbName As Long, _
                              ByVal lpReserved As Long, _
                              ByRef lpClass As String, _
                              lpcbClass As Long, _
                              lpftLastWriteTime As FILETIME) As Long

    If IsWinNT Then
        RegEnumKeyEx = RegEnumKeyExW(hKey, dwIndex, StrPtr(lpName), lpcbName, _
                lpReserved, StrPtr(lpClass), lpcbClass, lpftLastWriteTime)
    Else
        RegEnumKeyEx = RegEnumKeyExA(hKey, dwIndex, lpName, lpcbName, lpReserved, _
                lpClass, lpcbClass, lpftLastWriteTime)
    End If

End Function
Private Function RegEnumKey(ByVal hKey As Long, _
                            ByVal dwIndex As Long, _
                            ByRef lpName As String, _
                            ByVal cbName As Long) As Long
    If IsWinNT Then
        RegEnumKey = RegEnumKeyW(hKey, dwIndex, StrPtr(lpName), cbName)
    Else
        RegEnumKey = RegEnumKeyA(hKey, dwIndex, lpName, cbName)
    End If

End Function

Private Function RegEnumValue(ByVal hKey As Long, _
                              ByVal dwIndex As Long, _
                              ByRef lpValueName As String, _
                              lpcbValueName As Long, _
                              ByVal lpReserved As Long, _
                              ByVal lpType As Long, _
                              ByVal lpData As Long, _
                              ByVal lpcbData As Long) As Long
    If IsWinNT Then
        lpcbValueName = lpcbValueName * 2
        lpValueName = Space$(lpcbValueName)
        RegEnumValue = RegEnumValueW(hKey, dwIndex, StrPtr(lpValueName), lpcbValueName, _
                lpReserved, lpType, lpData, lpcbData)
    
    Else

        RegEnumValue = RegEnumValueA(hKey, dwIndex, lpValueName, lpcbValueName, _
                lpReserved, lpType, lpData, lpcbData)

    End If

End Function
Private Function RegEnumValueLong(ByVal hKey As Long, _
                                  ByVal dwIndex As Long, _
                                  ByVal lpValueName As String, _
                                  lpcbValueName As Long, _
                                  ByVal lpReserved As Long, _
                                  lpType As Long, _
                                  lpData As Long, _
                                  lpcbData As Long) As Long

    If IsWinNT Then
        RegEnumValueLong = RegEnumValueLongW(hKey, dwIndex, StrPtr(lpValueName), _
                lpcbValueName, lpReserved, lpType, lpData, lpcbData)

    Else
        RegEnumValueLong = RegEnumValueLongA(hKey, dwIndex, StrPtr(lpValueName), _
                lpcbValueName, lpReserved, lpType, lpData, lpcbData)
    End If
End Function
Private Function RegEnumValueStr(ByVal hKey As Long, _
                                 ByVal dwIndex As Long, _
                                 ByRef lpValueName As String, _
                                 lpcbValueName As Long, _
                                 ByVal lpReserved As Long, _
                                 ByRef lpType As Long, _
                                 ByRef lpData As String, _
                                 lpcbData As Long) As Long
    If IsWinNT Then
        RegEnumValueStr = RegEnumValueStrW(hKey, dwIndex, StrPtr(lpValueName), _
                lpcbValueName, lpReserved, lpType, StrPtr(lpData), lpcbData)
    Else
        RegEnumValueStr = RegEnumValueStrA(hKey, dwIndex, lpValueName, lpcbValueName, _
                lpReserved, lpType, lpData, lpcbData)
    End If
End Function
Private Function RegEnumValueByte(ByVal hKey As Long, _
                                  ByVal dwIndex As Long, _
                                  ByVal lpValueName As String, _
                                  ByRef lpcbValueName As Long, _
                                  ByVal lpReserved As Long, _
                                  lpType As Long, _
                                  ByRef lpData As Byte, _
                                  lpcbData As Long) As Long
    If IsWinNT Then
        RegEnumValueByte = RegEnumValueByteW(hKey, dwIndex, StrPtr(lpValueName), _
                lpcbValueName, lpReserved, lpType, lpData, lpcbData)
    Else
        RegEnumValueByte = RegEnumValueByteA(hKey, dwIndex, lpValueName, lpcbValueName, _
                lpReserved, lpType, lpData, lpcbData)
    End If
End Function

Private Function Is64BitOS() As Boolean
    Is64BitOS = Environ$("ProgramW6432") <> ""
End Function

Public Property Let Direct64Bit(ByVal Vdata As Boolean)
    mDirect64bit = Vdata
End Property
Public Property Get Direct64Bit() As Boolean
    Direct64Bit = mDirect64bit
End Property

Public Property Let AutoMachineCheck(ByVal Vdata As Boolean)
    m_SearchCorrespondingLM = Vdata
End Property
Public Property Get AutoMachineCheck() As Boolean
    AutoMachineCheck = m_SearchCorrespondingLM
End Property

'This is my new feature idea.
'if no default value is specified, then the default value will be retrieved via:
'First, a INI file named app.exename .ini will be opened. using the following function.
'as such, default values will be stored in the INI file.
'if the INI file cannot be opened or the classkey,sectionkey, and valuekey combination
'is not found, then a search will be performed in the string table of the application.
'a search? how? well, not really a search, but a file retrieval-
'the file text will be stored in a custom resource type, named "INI"
'it will be named REGDEF.INI
'this text should be loaded, and parsed in a similiar fashion.
'whew. That should be enough fallbacks.

'Private Function GetIniDefault(ByVal ClassKey As ERegistryClassConstants, ByVal SectionKey As String, ByVal Value As String) As Variant
'        'we need to open the file.
'        Dim fNum As Long
'        Dim SearchFor As String, searchline As String
'        Dim LineFound As Boolean
'        Dim DefText As String
'        Dim SearchFailure As Boolean
'        On Error GoTo nodefaultFile
'        fNum = FreeFile
'        Open m_IniDefFile For Input As #fNum
'RESUMEAGAIN:
'            'ok. now we need to scan for a line like:
'            '[classkey\sectionkey]
'            'first we need to convert the classkey value to a string.
'            SearchFor = "[" & ClassKeyEnum2String(ClassKey) & "\" & SectionKey & "]"
'            Do Until EOF(fNum)
'                Line Input #1, searchline
'                If searchline = SearchFor Then
'                'HA we found it.
'
'                End If
'
'            Loop
'
'        Close #fNum
'        Exit Function
'nodefaultFile:
'        'retrieve the text as appropriate, save to a local file,
'        'reopen it, and then goto immediately after the Open statement.
'        On Error Resume Next
'        DefText = LoadResData("REGDEF.INI", "INI")
'        DefText = StrConv(DefText, vbFromUnicode)
'        'he ha.
'        'now, we save.
'        'let's see-
'        Dim Fload As String
'        Fload = GetTempFile("TMP", "INI")
'        Open Fload For Input As #fNum
'        GoTo RESUMEAGAIN
'
'End Function
Private Function ClassKeyEnum2String(EnumVal As ERegistryClassConstants) As String
    If EnumVal = hhkey_classes_root Then
        ClassKeyEnum2String = "HKEY_CLASSES_ROOT"
    ElseIf EnumVal = HHKEY_CURRENT_USER Then
        ClassKeyEnum2String = "HKEY_CURRENT_USER"
    ElseIf EnumVal = HHKEY_LOCAL_MACHINE Then
        ClassKeyEnum2String = "HKEY_LOCAL_MACHINE"
    ElseIf EnumVal = HHKEY_USERS Then
        ClassKeyEnum2String = "HKEY_USERS"
    End If

End Function
Public Property Get Machine() As String
    Machine = m_sMachine
End Property

Public Property Let Machine(ByVal sMachine As String)
    If Len(sMachine) < 3 Then
        m_sMachine = ""
    
    ElseIf Left$(sMachine, 2) <> "\\" Then
        m_sMachine = "\\" & sMachine
    
    Else
        m_sMachine = sMachine
    
    End If

End Property

Public Property Get KeyExists() As Boolean
    Dim hKey          As Long
    Dim MRemoteHandle As Long
    
    If m_sMachine <> "" Then
        MRemoteHandle = ConnectToRemoteMachine(m_sMachine, m_hClassKey)
    Else
        MRemoteHandle = m_hClassKey
    End If
    
    If RegOpenKeyEx(MRemoteHandle, m_sSectionKey, 0, 1, hKey) = ERROR_SUCCESS Then
        KeyExists = True
        RegCloseKey hKey
    Else
        KeyExists = False
    End If
    
    If m_sMachine <> "" Then
        RegCloseKey MRemoteHandle
    End If
End Property

Public Function CreateKey() As Boolean
    Dim tSA           As SECURITY_ATTRIBUTES
    Dim hKey          As Long
    Dim lCreate       As Long
    Dim e             As Long

    Dim MRemoteHandle As Long
    
    If m_sMachine <> "" Then
        MRemoteHandle = ConnectToRemoteMachine(m_sMachine, m_hClassKey)
    Else
        MRemoteHandle = m_hClassKey
    End If
    'middle

    'Open or Create the key
    e = RegCreateKeyEx(MRemoteHandle, m_sSectionKey, 0, "", REG_OPTION_NON_VOLATILE, _
            KEY_ALL_ACCESS, tSA, hKey, lCreate)
    If e Then
        Err.Raise 26001, App.EXEName & ".cRegistry", "Failed to create registry Key:'" _
                & m_sSectionKey & "'"
    Else
        CreateKey = (e = ERROR_SUCCESS)
        'Close the key
        RegCloseKey hKey
    End If
    
    If m_sMachine <> "" Then
        RegCloseKey MRemoteHandle
    End If
    
End Function

Public Function DeleteKey(Optional ByVal Deletesubkeys As Boolean = False) As Boolean
    Dim e             As Long
    Dim MRemoteHandle As Long
    If m_sMachine <> "" Then
        MRemoteHandle = ConnectToRemoteMachine(m_sMachine, m_hClassKey)
    Else
        MRemoteHandle = m_hClassKey
    End If
    'middle
    
    If Deletesubkeys Then
        ForceDeleteKey Me
    
    End If
    e = RegDeleteKey(m_hClassKey, m_sSectionKey)
    If e Then
        Err.Raise 26001, App.EXEName & ".cRegistry", "Failed to delete registry Key:" & _
                m_hClassKey & "Section: '" & m_sSectionKey & "'"
    Else
        DeleteKey = (e = ERROR_SUCCESS)
    End If
    If m_sMachine <> "" Then
        RegCloseKey MRemoteHandle
    End If
End Function

Public Function DeleteValue() As Boolean
    Dim e             As Long
    Dim hKey          As Long
    Dim MRemoteHandle As Long
    If m_sMachine <> "" Then
        MRemoteHandle = ConnectToRemoteMachine(m_sMachine, m_hClassKey)
    Else
        MRemoteHandle = m_hClassKey
    End If
    'middle

    e = RegOpenKeyEx(MRemoteHandle, m_sSectionKey, 0, KEY_ALL_ACCESS, hKey)
    If e Then
        Err.Raise 26001, App.EXEName & ".cRegistry", "Failed to open key '" & _
                m_hClassKey & "',Section: '" & m_sSectionKey & "' for delete access"
        Else: e = RegDeleteValue(hKey, m_sValueKey)
        If e Then
            Err.Raise 26001, App.EXEName & ".cRegistry", _
                    "Failed to delete registry Key: " & MRemoteHandle & ",Section: " & _
                    m_sSectionKey & "',Key: '" & m_sValueKey
        Else
            DeleteValue = (e = ERROR_SUCCESS)
        End If
    End If
    
    If m_sMachine <> "" Then
        RegCloseKey MRemoteHandle
    End If
End Function
Public Property Get KeyDate() As Date
    Dim hKey As Long
    Dim e    As Long
    If m_sMachine <> "" Then
        e = RegConnectRegistry(m_sMachine, m_hClassKey, hKey)
        If e Then
            Value = m_vDefault
            Exit Property
        End If
    End If
    
    e = RegOpenKeyEx(m_hClassKey, m_sSectionKey, 0, KEY_QUERY_VALUE, hKey)
    
    Dim query_result As Long
    Dim NumSubKeys   As Long
    Dim lpClass      As String
    Dim lpcClass     As Long
    Dim MaxKeyLen    As Long
    Dim MaxClassLen  As Long
    Dim NumValues    As Long
    Dim MaxNameLen   As Long
    Dim MaxValueLen  As Long
    Dim SecDes       As Long 'not used:I used KEY_READ instead
    Dim LastWrite    As FILETIME
    Dim lastwritesys As SYSTEMTIME
    query_result = RegQueryInfoKey(hKey, lpClass, lpcClass, ByVal 0&, NumSubKeys, _
            MaxKeyLen, MaxClassLen, NumValues, MaxNameLen, MaxValueLen, ByVal 0&, _
            LastWrite)
    
    FileTimeToSystemTime LastWrite, lastwritesys
    With lastwritesys
        KeyDate = DateSerial(.wYear, .wMonth, .wDay) + TimeSerial(.wHour, .wMinute, _
                .wSecond)
    End With
    
End Property
Public Property Get Value() As Variant
    Dim vValue  As Variant
    Dim cData   As Long
    Dim sData   As String
    Dim ordType As Long
    Dim e       As Long
    Dim hKey    As Long
    
    If m_sMachine <> "" Then
        e = RegConnectRegistry(m_sMachine, m_hClassKey, hKey)
        If e Then
            Value = m_vDefault
            Exit Property
        End If
    End If
    
    e = RegOpenKeyEx(m_hClassKey, m_sSectionKey, 0, KEY_QUERY_VALUE, hKey)
    
    e = RegQueryValueExLong(hKey, m_sValueKey, 0&, ordType, 0&, cData)
    If e And e <> ERROR_MORE_DATA Then
        'value not found- use default.
        'EDIT: Michael Burgwin --9/10/2007 @ 01:33--
        'adding ability to use value from HKEY_LOCAL_MACHINE for values not found in HKEY_CURRENT_USER.
        'this is a common tactic among programs. Store the default configuration in HKEY_LOCAL_MACHINE, and allow
        'user customizations to appear in HKEY_CURRENT_USER.

        Value = m_vDefault
        Exit Property
    End If
    
    m_eValueType = ordType
    Select Case ordType
        Case RREG_DWORD, RREG_DWORD_LITTLE_ENDIAN
            Dim iData As Long
            e = RegQueryValueExLong(hKey, m_sValueKey, 0&, ordType, iData, cData)
            vValue = CLng(iData)
        
        Case RREG_DWORD_BIG_ENDIAN  ' Unlikely, but you never know
            Dim dwData As Long
            e = RegQueryValueExLong(hKey, m_sValueKey, 0&, ordType, dwData, cData)
            vValue = SwapEndian(dwData)
        
        Case RREG_SZ, RREG_MULTI_SZ ' Same thing to Visual Basic
            sData = String$(cData - 1, 0)
            e = RegQueryValueExStr(hKey, m_sValueKey, 0&, ordType, sData, cData)
            vValue = sData
            vValue = Trim$(vValue)
        Case RREG_EXPAND_SZ
            sData = String$(cData - 1, 0)
            e = RegQueryValueExStr(hKey, m_sValueKey, 0&, ordType, sData, cData)
            vValue = ExpandEnvStr(sData)
            vValue = Trim$(vValue)
            ' Catch REG_BINARY and anything else
        Case Else
            Dim abData() As Byte
            ReDim abData(cData)
            e = RegQueryValueExByte(hKey, m_sValueKey, 0&, ordType, abData(0), cData)
            vValue = abData
        
    End Select
    Value = vValue
    
End Property

Public Property Let Value(ByVal vValue As Variant)
    Dim ordType As Long
    Dim C       As Long
    Dim hKey    As Long
    Dim e       As Long
    Dim lCreate As Long
    Dim tSA     As SECURITY_ATTRIBUTES
    
    ' If a remote machine (m_sMachine<>"") then try to connect to the remote
registry:
    If m_sMachine <> "" Then
        e = RegConnectRegistry(m_sMachine, m_hClassKey, hKey)
        If e Then
            Value = m_vDefault
            Exit Property
        End If
    End If

    'Open or Create the key
    e = RegCreateKeyEx(m_hClassKey, m_sSectionKey, 0, "", REG_OPTION_NON_VOLATILE, _
            KEY_ALL_ACCESS, tSA, hKey, lCreate)
    
    If e Then
        Err.Raise 26001, App.EXEName & ".cRegistry", _
                "Failed to set registry Value Key: '" & m_hClassKey & "',Section: '" & _
                m_sSectionKey & "',Key: '" & m_sValueKey & "' to value: '" & m_vValue & _
                "'"
    Else

        Select Case m_eValueType
            Case RREG_BINARY
                If (VarType(vValue) = vbArray + vbByte) Then
                    Dim ab() As Byte
                    ab = vValue
                    ordType = RREG_BINARY
                    C = UBound(ab) - LBound(ab) + 1 ' Bugfix by Morten Egelund
                
                    e = RegSetValueExByte(hKey, m_sValueKey, 0&, ordType, ab(0), C)
                Else
                    Err.Raise 26001
                End If
            Case RREG_DWORD, RREG_DWORD_BIG_ENDIAN, RREG_DWORD_LITTLE_ENDIAN
                If (VarType(vValue) = vbInteger) Or (VarType(vValue) = vbLong) Then
                    Dim I As Long
                    I = vValue
                    ordType = RREG_DWORD
                    e = RegSetValueExLong(hKey, m_sValueKey, 0&, ordType, I, 4)
                End If
            Case RREG_SZ, RREG_EXPAND_SZ
                Dim s As String, iPos As Long
                s = vValue
                ordType = RREG_SZ
                ' Assume anything with two non-adjacent percents is expanded string
                iPos = InStr(s, "%")
                If iPos Then
                    If InStr(iPos + 2, s, "%") Then ordType = RREG_EXPAND_SZ
                End If
                C = Len(s) + 1
                s = s & vbNullChar ' Thanks to Shane Marsden
                e = RegSetValueExStr(hKey, m_sValueKey, 0&, ordType, s, C)
            
                ' User should convert to a compatible type before calling
            Case Else
                e = ERROR_INVALID_DATA
            
        End Select
        
        If Not e Then
            m_vValue = vValue
        Else
            Err.Raise vbObjectError + 1048 + 26001, App.EXEName & ".cRegistry", _
                    "Failed to set registry value Key: '" & m_hClassKey & _
                    "',Section:             '" & m_sSectionKey & "',Key: '" & _
                    m_sValueKey & "' to value: '" & m_vValue & "'"
        End If
        
        'Close the key
        RegCloseKey hKey
    
    End If
    
End Property

Public Function EnumerateValues(ByRef sKeyNames() As String, _
                                ByRef iKeyCount As Long) As Boolean
    Dim lResult     As Long
    Dim hKey        As Long
    Dim sName       As String
    Dim lNameSize   As Long
    Dim lIndex      As Long
    Dim cJunk       As Long
    Dim cNameMax    As Long
    Dim ft          As Currency
    Dim mMainHandle As Long
    'if we are connecting to a remote machine,
    If m_sMachine <> "" Then
        mMainHandle = ConnectToRemoteMachine(m_sMachine, m_hClassKey)
    Else
        mMainHandle = m_hClassKey
    End If
    ' Log "EnterEnumerateValues"
 
    iKeyCount = 0
    Erase sKeyNames()
    
    lIndex = 0
    lResult = RegOpenKeyEx(mMainHandle, m_sSectionKey, 0, KEY_QUERY_VALUE, hKey)
    If (lResult = ERROR_SUCCESS) Then
        ' Log "OpenedKey:" & m_hClassKey & "," & m_sSectionKey
        lResult = RegQueryInfoKey(hKey, "", cJunk, 0, cJunk, cJunk, cJunk, cJunk, _
                cNameMax, cJunk, cJunk, ft)
        Do While lResult = ERROR_SUCCESS
   
            'Set buffer space
            lNameSize = cNameMax + 1
            sName = String$(lNameSize, 0)
            If (lNameSize = 0) Then lNameSize = 1
           
            ' Log "Requesting Next Value"
         
            'Get value name:
            lResult = RegEnumValue(hKey, lIndex, sName, lNameSize, 0&, 0&, 0&, 0&)
            ' Log "RegEnumValue returned:" & lResult
            If (lResult = ERROR_SUCCESS) Then
       
                ' Although in theory you can also retrieve the actual
                ' value and type here, I found it always (ultimately) resulted
                ' in a GPF, on Win95 and NT.  Why?  Can anyone help?
       
                sName = Left$(sName, lNameSize)
                ' Log "Enumerated value:" & sName
                 
                iKeyCount = iKeyCount + 1
                ReDim Preserve sKeyNames(1 To iKeyCount) As String
                sKeyNames(iKeyCount) = sName
               
            End If
            lIndex = lIndex + 1
        Loop
    End If
    If (hKey <> 0) Then
        RegCloseKey hKey
    End If

    ' Log "Exit Enumerate Values"
    EnumerateValues = True
    Exit Function
   
EnumerateValuesError:
    If (m_sMachine <> "") Then
        RegCloseKey mMainHandle
    End If
    Err.Raise vbObjectError + 1048 + 26003, App.EXEName & ".cRegistry", Err.Description
    Exit Function

End Function
Private Function ConnectToRemoteMachine(ByVal m_sMachine As String, _
                                        m_Classkey As ERegistryClassConstants) As Long
    Dim hKey As Long, e As Long
    If m_sMachine <> "" Then
        e = RegConnectRegistry(m_sMachine, m_hClassKey, hKey)
        If e Then
            'Value = m_vDefault
            'Exit Function
            ConnectToRemoteMachine = 0
            Err.Raise 60, "ConnectToRemoteMachine", _
                    "Failed to connect to remove machine, """ & m_sMachine & """."
        Else
            ConnectToRemoteMachine = hKey
        End If
    Else
        Err.Raise 60, "ConnectToRemoteMachine", _
                "Failed to connect to remove machine, """ & m_sMachine & """."
        ConnectToRemoteMachine = 0
    End If
End Function
Public Function EnumerateSections(ByRef sSect() As String, _
                                  ByRef iSectCount As Long) As Boolean
    Dim lResult     As Long
    Dim hKey        As Long
    Dim szBuffer    As String
    Dim lBuffSize   As Long
    Dim lIndex      As Long
    Dim iPos        As Long, e As Long
    Dim mMainHandle As Long
    'if we are connecting to a remote machine,
    If m_sMachine <> "" Then
        mMainHandle = ConnectToRemoteMachine(m_sMachine, m_hClassKey)
    Else
        mMainHandle = m_hClassKey
    End If
    
    '     If m_sMachine <> "" Then
    '        e = RegConnectRegistry(m_sMachine, m_hClassKey, hKey)
    '        If e Then
    '            'Value = m_vDefault
    '            'Exit Function
    '
    '        End If
    '    Else
    '        hKey = m_hClassKey
    '    End If
    On Error GoTo EnumerateSectionsError

    iSectCount = 0
    Erase sSect
    '
    lIndex = 0

    lResult = RegOpenKeyEx(mMainHandle, m_sSectionKey, 0, KEY_ENUMERATE_SUB_KEYS, hKey)
    Do While lResult = ERROR_SUCCESS
        'Set buffer space
        szBuffer = String$(32768, 0)
        lBuffSize = Len(szBuffer)
      
        'Get next value
        lResult = RegEnumKey(hKey, lIndex, szBuffer, lBuffSize)
                             
        If (lResult = ERROR_SUCCESS) Then
            iSectCount = iSectCount + 1
            ReDim Preserve sSect(1 To iSectCount) As String
            iPos = InStr(szBuffer, Chr$(0))
            If (iPos > 0) Then
                sSect(iSectCount) = Left(szBuffer, iPos - 1)
            Else
                sSect(iSectCount) = Left(szBuffer, lBuffSize)
            End If
        End If
       
        lIndex = lIndex + 1
    Loop
    If (hKey <> 0) Then
        RegCloseKey hKey
    End If
    EnumerateSections = True
    If m_sMachine <> "" Then
        RegCloseKey hKey
    End If
    If m_sMachine <> "" Then
        RegCloseKey mMainHandle
    End If
    Exit Function

EnumerateSectionsError:
   
    Err.Raise vbObjectError + 1048 + 26002, App.EXEName & ".cRegistry", Err.Description
    Exit Function
End Function

Private Sub pSetClassValue(ByVal sValue As String)
    Dim sSection As String
    
    Classkey = hhkey_classes_root
    Value = sValue
    sSection = SectionKey
    Classkey = HHKEY_LOCAL_MACHINE
    SectionKey = "SOFTWARE\Classes\" & sSection
    Value = sValue
    SectionKey = sSection
End Sub

Public Sub CreateEXEAssociation(ByVal sExePath As String, _
                                ByVal sClassName As String, _
                                ByVal sClassDescription As String, _
                                ByVal sAssociation As String, _
                                Optional ByVal sOpenMenuText As String = "&Open", _
                                Optional ByVal bSupportPrint As Boolean = False, _
                                Optional ByVal SprintMenuText As String = "&Print", _
                                Optional ByVal bSupportNew As Boolean = False, _
                                Optional ByVal sNewMenuText As String = "&New", _
                                Optional ByVal bSupportInstall As Boolean = False, _
                                Optional ByVal sInstallMenuText As String = "", _
                                Optional ByVal lDefaultIconIndex As Long = -1)
    ' Check if path is wrapped in quotes:
    sExePath = Trim$(sExePath)
    If (Left$(sExePath, 1) <> """") Then
        sExePath = """" & sExePath
    End If
    If (Right$(sExePath, 1) <> """") Then
        sExePath = sExePath & """"
    End If
    
    ' Create the .File to Class association:
    SectionKey = "." & sAssociation
    ValueType = RREG_SZ
    ValueKey = ""
    pSetClassValue sClassName
   
    ' Create the Class shell open command:
    SectionKey = sClassName
    pSetClassValue sClassDescription
   
    SectionKey = sClassName & "\shell\open"
    If (sOpenMenuText = "") Then sOpenMenuText = "&Open"
    ValueKey = ""
    pSetClassValue sOpenMenuText
    SectionKey = sClassName & "\shell\open\command"
    ValueKey = ""
    pSetClassValue sExePath & " ""%1"""
   
    If (bSupportPrint) Then
        SectionKey = sClassName & "\shell\print"
        If (SprintMenuText = "") Then SprintMenuText = "&Print"
        ValueKey = ""
        pSetClassValue SprintMenuText
        SectionKey = sClassName & "\shell\print\command"
        ValueKey = ""
        pSetClassValue sExePath & " /p ""%1"""
    End If
   
    If (bSupportInstall) Then
        If (sInstallMenuText = "") Then
            sInstallMenuText = "&Install " & sAssociation
        End If
        SectionKey = sClassName & "\shell\add"
        ValueKey = ""
        pSetClassValue sInstallMenuText
        SectionKey = sClassName & "\shell\add\command"
        ValueKey = ""
        pSetClassValue sExePath & " /a ""%1"""
    End If
   
    If (bSupportNew) Then
        SectionKey = sClassName & "\shell\new"
        ValueKey = ""
        If (sNewMenuText = "") Then sNewMenuText = "&New"
        pSetClassValue sNewMenuText
        SectionKey = sClassName & "\shell\new\command"
        ValueKey = ""
        pSetClassValue sExePath & " /n ""%1"""
    End If
   
    If lDefaultIconIndex > -1 Then
        SectionKey = sClassName & "\DefaultIcon"
        ValueKey = ""
        pSetClassValue sExePath & "," & CStr(lDefaultIconIndex)
    End If
    
End Sub

Public Sub CreateAdditionalEXEAssociations(ByVal sClassName As String, _
                                           ParamArray vItems() As Variant)
    Dim iItems As Long
    Dim iItem  As Long
   
    On Error Resume Next
    
    iItems = UBound(vItems) + 1
    If (iItems Mod 3) <> 0 Or (Err.Number <> 0) Then
        Err.Raise vbObjectError + 1048 + 26004, App.EXEName & ".cRegistry", _
                "Invalid parameter list passed to CreateAdditionalEXEAssociations -expected Name/Text/Command"
    Else
        ' Check if it exists:
        SectionKey = sClassName
        If Not (KeyExists) Then
            Err.Raise vbObjectError + 1048 + 26005, App.EXEName & ".cRegistry", _
                    "Error - attempt to create additional associations before class defined."
        Else
            For iItem = 0 To iItems - 1 Step 3
                ValueType = RREG_SZ
                SectionKey = sClassName & "\shell\" & vItems(iItem)
                ValueKey = ""
                pSetClassValue vItems(iItem + 1)
                SectionKey = sClassName & "\shell\" & vItems(iItem) & "\command"
                ValueKey = ""
                pSetClassValue vItems(iItem + 2)
            Next iItem
        End If
    End If
   
End Sub

Public Property Get ValueType() As ERegistryValueTypes
    ValueType = m_eValueType
End Property

Public Property Let ValueType(ByVal eValueType As ERegistryValueTypes)
    m_eValueType = eValueType
End Property

Public Property Get Classkey() As ERegistryClassConstants
    Classkey = m_hClassKey
End Property

Public Property Let Classkey(ByVal eKey As ERegistryClassConstants)
    m_hClassKey = eKey
End Property

Public Property Get SectionKey() As String
    SectionKey = m_sSectionKey
End Property

Public Property Let SectionKey(ByVal sSectionKey As String)
    m_sSectionKey = sSectionKey
End Property

Public Property Get ValueKey() As String
    ValueKey = m_sValueKey
End Property

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' A Wrapper Property for the VALUE property .
' Assign all passed values to the class properties and call
' ME.VALUE to return value
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Property Get ValueEx(ByVal Classkey As ERegistryClassConstants, SectionKey As _
        String, ValueKey As String, ValueType As ERegistryValueTypes, Default As _
        Variant) As Variant
    With Me
    
        .Classkey = Classkey
        .SectionKey = SectionKey
        .ValueKey = ValueKey
        
        .ValueType = ValueType
        .Default = Default
        ValueEx = .Value
    End With
End Property

Public Property Let ValueEx(ByVal Classkey As ERegistryClassConstants, SectionKey As _
        String, ValueKey As String, ValueType As ERegistryValueTypes, Default As _
        Variant, NewValue As Variant)
    Debug.Print "ValueEx"
    With Me
        .Classkey = Classkey
        .SectionKey = SectionKey
        .ValueKey = ValueKey
        .ValueType = ValueType
        .Default = Default
       
        If .ValueType = RREG_SZ Then
            If CStr(NewValue) = "" Then
                NewValue = Default
            End If
        End If
        .Value = NewValue
    End With
End Property

Public Property Let ValueKey(ByVal sValueKey As String)
    m_sValueKey = sValueKey
End Property

Public Property Get Default() As Variant
    Default = m_vDefault
End Property

Public Property Let Default(ByVal vDefault As Variant)
    m_vDefault = vDefault
End Property

Private Function SwapEndian(ByVal dw As Long) As Long
    CopyMemory ByVal VarPtr(SwapEndian) + 3, dw, 1
    CopyMemory ByVal VarPtr(SwapEndian) + 2, ByVal VarPtr(dw) + 1, 1
    CopyMemory ByVal VarPtr(SwapEndian) + 1, ByVal VarPtr(dw) + 2, 1
    CopyMemory SwapEndian, ByVal VarPtr(dw) + 3, 1
End Function

Private Function ExpandEnvStr(sData As String) As String
    Dim C As Long
    Dim s As String
    
    ' Get the length
    s = "" ' Needed to get around Windows 95 limitation
    C = ExpandEnvironmentStrings(sData, s, C)
    
    ' Expand the string
    s = String$(C - 1, 0)
    C = ExpandEnvironmentStrings(sData, s, C)
    
    ExpandEnvStr = s
End Function

Private Sub Class_Initialize()
    m_hClassKey = HHKEY_LOCAL_MACHINE
    mvarReadFrom = "Registry"   'cRegistry defaults to reading from the registry.
    'what a surprise.
    'm_IniDefFile = IIf(right$(App.Path, 1) = "\", App.Path, App.Path & "\") & "DEFAULTS.INI"
    'that would be the default ini file values file.
    m_SearchCorrespondingLM = True
End Sub
'This class can persist registry entries to XML.

Public Sub PersistKeytoXML(ByVal hKey As ERegistryClassConstants, _
                           ByVal SectionKey As String, _
                           ByVal OutputXMLFile As String)
    'persists a given registry key to the given File.
    Dim fnum As Integer
    
    fnum = FreeFile
    Open OutputXMLFile For Output As fnum
    Print #fnum, "<?xml version='1.0' encoding='utf-8'?>"
    Print #fnum, "<!--XML output generated by cRegistry Class-->"
        
    WriteXMLChild hKey, SectionKey, fnum
    Close #fnum

End Sub
Private Sub WriteXMLChild(ByVal Ckey As ERegistryClassConstants, _
                          ByVal Section As String, _
                          ByVal infile As Integer, _
                          Optional ByVal numtabs As Integer = 0)
    Static RecurseCount As Long
    Dim usecreg         As cRegistry
    Dim regsections()   As String
    Dim regvalues()     As String
    Dim numsections&, NumValues&
    Dim I               As Long
    Dim strrep          As String
    Dim bytesgrab()     As Byte
    Dim visSection      As String
    
    Erase regvalues
    RecurseCount = RecurseCount + 1
    'Debug.Print Message "recurse:" & RecurseCount & " SECTION:" & Section
    Set usecreg = New cRegistry
    usecreg.Classkey = Ckey
    usecreg.SectionKey = Section
    usecreg.EnumerateSections regsections, numsections
    usecreg.EnumerateValues regvalues, NumValues
    'Add our tag first.
    visSection = Mid$(Section, InStrRev(Section, "\") + 1)
    Print #infile, String(numtabs, vbTab) & "<KEY NAME=""" & visSection & """> "
    If usecreg.ValueType = RREG_BINARY Then
        bytesgrab = usecreg.Value
        strrep = ""
        For I = 0 To UBound(bytesgrab)
            strrep = strrep & String$(2 - Len(Hex$(bytesgrab(I))), "0") & Hex$( _
                    bytesgrab(I)) & " "
        Next I
    
    End If
    Print #infile, String(numtabs + 1, vbTab) & "<DEFAULT VALUE=""" & strrep & _
            """></DEFAULT>"
    
    For I = 1 To NumValues
        Static P As Long
        usecreg.SectionKey = Section
        usecreg.ValueKey = regvalues(I)
        strrep = usecreg.Value
        If usecreg.ValueType = RREG_BINARY Then
            bytesgrab = usecreg.Value
            strrep = ""
            
            For P = 0 To UBound(bytesgrab)
                strrep = strrep & String$(2 - Len(Hex$(bytesgrab(P))), "0") & Hex$( _
                        bytesgrab(P)) & " "
            Next P
        
        End If
        
        Print #infile, String(numtabs + 1, vbTab) & "<VALUE NAME=""" & regvalues(I) & _
                """ VALUE=""" & strrep & """></VALUE>"
    
    Next I
    For I = 1 To numsections
        Call WriteXMLChild(Ckey, Section & "\" & regsections(I), infile, numtabs + 1)
    Next I
    Print #infile, String$(numtabs, vbTab) & "</KEY>"
    
    Set usecreg = Nothing
    
    RecurseCount = RecurseCount - 1
    
End Sub
Private Sub ForceDeleteKey(OfReg As cRegistry)
    'deletes the key referred to by Ofreg. forcing all sub-keys to delete as well.
    Dim Enumitems() As String, Scount As Long
    Dim tempdeleter As cRegistry, I As Long
    Set tempdeleter = New cRegistry
    If OfReg.EnumerateSections(Enumitems(), Scount) Then
        For I = 1 To Scount
            tempdeleter.Classkey = OfReg.Classkey
            tempdeleter.SectionKey = OfReg.SectionKey & "\" & Enumitems(I)
            Call ForceDeleteKey(tempdeleter)
            
        Next I
    
    End If
    'delete values too.
    Call OfReg.EnumerateValues(Enumitems(), Scount)
    For I = 1 To Scount
        OfReg.ValueKey = Enumitems(I)
        OfReg.DeleteValue
    Next I
        
    OfReg.DeleteKey

End Sub

Public Function getTempFile(Optional ByVal Prefix As String = "TMP", _
                            Optional ByVal Extension As String) As String
    Dim BuildName As String, buildPath As String
    buildPath = Space$(1024)
    GetTempPath 1024, buildPath
    BuildName = Space$(1024)
    buildPath = Trim$(buildPath)
    buildPath = Replace$(buildPath, vbNullChar, "")
    GetTempFileName buildPath, Prefix, 0, BuildName
    BuildName = Trim$(BuildName)
    BuildName = Replace$(BuildName, vbNullChar, "")

    If Right$(buildPath, 1) <> "\" Then buildPath = buildPath & "\"
    BuildName = Mid$(BuildName, 1, InStrRev(BuildName, ".")) & Extension
    getTempFile = BuildName

End Function

