Classe Register

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Register"
Attribute VB_Creatable = True
Attribute VB_Exposed = True

Option Explicit
'************************************************
'API de lecture de la base de registre
'************************************************

Const SYNCHRONIZE = &H100000

Const READ_CONTROL = &H20000


Const REG_BINARY = 3
Const REG_CREATED_NEW_KEY = &H1

Const REG_DWORD = 4
Const REG_DWORD_BIG_ENDIAN = 5
Const REG_DWORD_LITTLE_ENDIAN = 4
Const REG_EXPAND_SZ = 2
Const REG_FULL_RESOURCE_DESCRIPTOR = 9
Const REG_LINK = 6
Const REG_MULTI_SZ = 7
Const REG_NONE = 0
Const REG_NOTIFY_CHANGE_ATTRIBUTES = &H2

Const REG_NOTIFY_CHANGE_LAST_SET = &H4

Const REG_NOTIFY_CHANGE_NAME = &H1

Const REG_NOTIFY_CHANGE_SECURITY = &H8

Const REG_OPENED_EXISTING_KEY = &H2

Const REG_OPTION_BACKUP_RESTORE = 4
Const REG_OPTION_CREATE_LINK = 2
Const REG_OPTION_NON_VOLATILE = 0
Const REG_OPTION_RESERVED = 0
Const REG_OPTION_VOLATILE = 1
Const REG_REFRESH_HIVE = &H2

Const REG_RESOURCE_LIST = 8
Const REG_RESOURCE_REQUIREMENTS_LIST = 10
Const REG_SZ = 1
Const REG_WHOLE_HIVE_VOLATILE = &H1

Const REG_LEGAL_CHANGE_FILTER = (REG_NOTIFY_CHANGE_NAME Or REG_NOTIFY_CHANGE_ATTRIBUTES Or REG_NOTIFY_CHANGE_LAST_SET Or REG_NOTIFY_CHANGE_SECURITY)
Const REG_LEGAL_OPTION = (REG_OPTION_RESERVED Or REG_OPTION_NON_VOLATILE Or REG_OPTION_VOLATILE Or REG_OPTION_CREATE_LINK Or REG_OPTION_BACKUP_RESTORE)
Const STANDARD_RIGHTS_ALL = &H1F0000

Const STANDARD_RIGHTS_EXECUTE = (READ_CONTROL)
Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Const STANDARD_RIGHTS_REQUIRED = &HF0000

Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Const HKEY_CLASSES_ROOT = &H80000000

Const HKEY_CURRENT_CONFIG = &H80000005

Const HKEY_CURRENT_USER = &H80000001

Const HKEY_DYN_DATA = &H80000006

Const HKEY_LOCAL_MACHINE = &H80000002

Const HKEY_PERFORMANCE_DATA = &H80000004

Const HKEY_USERS = &H80000003

Const KEY_CREATE_LINK = &H20

Const KEY_CREATE_SUB_KEY = &H4

Const KEY_ENUMERATE_SUB_KEYS = &H8

Const KEY_EVENT = &H1

Const KEY_NOTIFY = &H10

Const KEY_QUERY_VALUE = &H1

Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Const KEY_SET_VALUE = &H2

Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
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))

Private Declare Function API_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
Private Declare Function API_RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function API_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
Public Function Create() As Boolean
    Create = True
End Function
Public Function Key(ByVal strPath As String, ByVal strKey As String, ByVal Default As Variant) As Variant
Dim hkey As Long
Dim strSubKey As String
Dim strValName As String
Dim i As Integer
Dim s As String
    If UCase(Left(strPath, 4)) <> "HKEY" Then
        hkey = HKEY_CURRENT_USER
        strPath = "Software\VB and VBA Program Settings\" & strPath
    Else
        i = InStr(strPath, "\")
        s = Left(strPath, i - 1)
        strPath = Mid(strPath, i + 1)
        Select Case UCase(s)
  

hkey = HKEY_CLASSES_ROOT
            Case "HKEY_CURRENT_USER"
                hkey = HKEY_CURRENT_USER
            Case "HKEY_LOCAL_MACHINE"
                hkey = HKEY_LOCAL_MACHINE
            Case "HKEY_USERS"
                hkey = HKEY_USERS
            Case "HKEY_CURRENT_CONFIG"
                hkey = HKEY_CURRENT_CONFIG
            Case "HKEY_DYN_DATA"
                hkey = HKEY_DYN_DATA
            Case Else
                RaiseError REG_InvalidKey
                Exit Function
        End Select
    End If
    Key = fRegGetString(hkey, strPath, strKey, Default)
End Function
Private Function fRegGetString(hInkey As Long, ByVal strSubKey As String, ByVal strValName As String, Default As Variant) As Variant
Dim phkResult As Long
Dim strValeur As String * 256
Dim lngValeur As Long
Dim dummy As Long
    dummy = API_RegOpenKeyEx(hInkey, strSubKey, 0, KEY_ALL_ACCESS, phkResult)
    If dummy = 0 Then
        lngValeur = 256
        dummy = API_RegQueryValueEx(phkResult, strValName, 0, REG_SZ, ByVal strValeur, lngValeur)
        If dummy = 0 Then
            fRegGetString = Left(strValeur, Len(Trim(strValeur)) - 1)
        Else
            fRegGetString = Default
            Err = dummy
        End If
    End If
    
End Function

Private Function fRegSetString(hInkey As Long, ByVal strSubKey As String, ByVal strValName As String, strValeur As String) As Long
Dim phkResult As Long
Dim dummy As Long
    dummy = API_RegOpenKeyEx(hInkey, strSubKey, 0, KEY_ALL_ACCESS, phkResult)
    If dummy = 0 Then
        strValeur = strValeur & Chr$(0)
        fRegSetString = API_RegSetValueEx(phkResult, strValName, 0, REG_SZ, ByVal strValeur, Len(strValeur))
    End If

End Function