Reg via api advapi32.dll

Commenter

Contenu du snippet

J'ai trouvé plusieurs code traitant du registre à droit à gauche sur le net et certain diront "et 1 de plus"
Donc voila un ensemble de fonctions pour jouer avec le registre de votre windows...

Source / Exemple : 


Option Explicit
Option Compare Text
Option Base 0

'######################################################################################################################
'######################################################################################################################
'######################################################################################################################
'
' REG. BASE DE REGISTRE
'
' 1. Fonction de lecture      :  RegExistKey, RegExistVal, RegInfoKey, RegEnumSubKey, RegEnumVal
'
' 2. Fonction d'écriture      :  RegAddKey, RegAddVal
'
' 3. Fonction de suppression  :  RegDelKey, RegDelVal
'
' 4. Fonction de conversion   :  SwapEndian, ExpandEnvStr, StringEnByte, ByteEnString, VarByte, StringEnLong, LongEnString
'
' References:
'   http://www.supinfo-projects.com/fr/2004/api_basederegistre__vb_fr/3/   [Thomas HAMOU  09/05/2004 23:11:22]
'   http://files.codes-sources.com/fichier.aspx?id=37927&f=cRegistry.cls   [Sechaud       03/06/2006 16:58:52]
'
'----------------------------------------------------------------------------------------------------------------------
' 0.0. Les Constantes REG
Const REG_BUFFER_SIZE As Long = 255&
Const REG_MAX_LEN As Long = 2048&

Const REG_CREATED_NEW_KEY = &H1
Const REG_OPENED_EXISTING_KEY = &O2

Const REG_SEP = "\"

Const REG_ERROR_SUCCESS = 0
Const REG_ERROR_INVALID_FUNCTION = 1
Const REG_ERROR_BADKEY = 2
Const REG_ERROR_CANTOPEN = 3
Const REG_ERROR_CANTREAD = 4
Const REG_ERROR_CANTWRITE = 5
Const REG_ERROR_ACCESS_DENIED = 8
Const REG_ERROR_OUTOFMEMORY = 14
Const REG_ERROR_INVALID_PARAMETER = 87
Const REG_ERROR_MORE_DATA = 234
Const REG_ERROR_NO_MORE_ITEMS = 259
Const REG_ERROR_REGISTRY_CORRUPTED = 1015

'----------------------------------------------------------------------------------------------------------------------
' 0.1.1. Retour d'information de secutiré sur les KEY
Type REG_SECURITY_ATTRIBUTES
  nLength As Long
  lpSecurityDescriptor As Long
  bInheritHandle As Long
End Type
'----------------------------------------------------------------------------------------------------------------------
' 0.1.2. Retour d'information de Query sur une KEY
Type REG_QUERY_KEY
  Reg_Key_n As Long    ' Nombre de Sous Key
  Reg_Key_l As Long    ' Taille du nom de Key le plus longue *
  Reg_Name_n As Long   ' Nombre de Nom de valeur
  Reg_Name_l As Long   ' Taille du plus grand Nom de Valeur *
  Reg_Value_n As Long  ' Nombre de Valeur
  Reg_Value_l As Long  ' Taille de la plus grande Valeur *
End Type               '      * NULL finale non compris
'----------------------------------------------------------------------------------------------------------------------
' 0.1.3. Retour d'information de Query sur une KEY
Type REG_TIME
  Reg_LowDateTime As Long
  Reg_HighDateTime As Long
End Type
'----------------------------------------------------------------------------------------------------------------------
' 0.2.1. Enumération des Key ROOT HKEY_CLASSES_ROOT,HKEY_CURRENT_CONFIG, HKEY_CURRENT_USER, HKEY_LOCAL_MACHINE, HKEY_USERS
'                                 HKEY_DYN_DATA, HKEY_PERFORMANCE_DAT
Public Enum RegRootKey
  HKCR = &H80000000
  HKCC = &H80000005
  HKCU = &H80000001
  HKLM = &H80000002
  HKU = &H80000003
  'HKDD = &H80000006
  'HKEY_PERFORMANCE_DAT = &H80000004
End Enum
'----------------------------------------------------------------------------------------------------------------------
' 0.2.2. Enumération des TYPE de valeur dans la base de registre
Public Enum RegTypeKey
  REG_NONE = 0&                             ' No value type
  REG_SZ = 1&                               ' Unicode nul terminated string
  REG_EXPAND_SZ = 2&                        ' Unicode nul terminated string (with environment variable references)
  REG_BINARY = 3&                           ' Free form binary
  REG_DWORD = 4&                            ' 32-bit number (Integer)
  REG_DWORD_BIG_ENDIAN = 5&                 ' 32-bit number (avec les bytes a l'envers)
  REG_LINK = 6&                             ' Symbolic Link (unicode)
  REG_MULTI_SZ = 7&                         ' Multiple Unicode strings
  REG_RESOURCE_LIST = 8&                    ' Resource list in the resource map
  REG_FULL_RESOURCE_DESCRIPTOR = 9&         ' Resource list in the hardware description
  REG_RESOURCE_REQUIREMENTS_LIST = 10&      ' Resource list in the hardware description map
End Enum
'----------------------------------------------------------------------------------------------------------------------
' 0.2.3. Enumération des OPTIONS VOLATILE des Key dans la base de registre
Public Enum RegOptionKey
  REG_OPTION_NON_VOLATILE = 0&
  REG_OPTION_VOLATILE = 1&
End Enum
'----------------------------------------------------------------------------------------------------------------------
' 0.2.4. Enumération des Controle d'ACCES aux Key dans la base de registre
Public Enum RegAccess
  KEY_BA_DELETE = &H10000           ' Droit de supprimer un objet
  KEY_BA_READ_CONTROL = &H20000     ' Droit de lire l?information sur la sécurité de l?objet
  KEY_BA_SYNCHRONIZE = &H100000     ' Droit d?utiliser l?objet pour une synchronisation. Les clés de la base de registre ne supportent pas ce droit.
  KEY_BA_WRITE_DAC = &H40000        ' Droit de modifier le DACL sur un objet : définition des accès à l?objet
  KEY_BA_WRITE_OWNER = &H80000      ' Droit de changer le propriétaire de l?objet
  KEY_ST_RIGHTS_ALL = &H1F0000      ' KEY_BA_DELETE, KEY_BA_READ_CONTROL, KEY_BA_WRITE_DAC, KEY_BA_WRITE_OWNER et KEY_BA_SYNCHRONIZE
  KEY_ST_RIGHTS_EXECUTE = &H20000   ' KEY_BA_READ_CONTROL
  KEY_ST_RIGHTS_READ = &H20000      ' KEY_BA_READ_CONTROL
  KEY_ST_RIGHTS_REQUIRED = &HF0000  ' KEY_BA_DELETE Or KEY_BA_READ_CONTROL Or KEY_BA_WRITE_DAC Or KEY_BA_WRITE_OWNER
  KEY_ST_RIGHTS_WRITE = &H20000     ' KEY_BA_READ_CONTROL
  KEY_ALL_ACCESS = &HF003F          ' KEY_ST_RIGHTS_REQUIRED, KEY_TY_QUERY_VALUE, KEY_TY_SET_VALUE, KEY_TY_CREATE_SUB_KEY,
                                    ' KEY_TY_ENUMERATE_SUB_KEYS, KEY_TY_NOTIFY, et KEY_TY_CREATE_LINK
  KEY_TY_CREATE_LINK = &H20         ' Réservé pour l?utilisation du système
  KEY_TY_CREATE_SUB_KEY = &H4       ' Requis pour la création d?une clé ou d?une sous-clé
  KEY_TY_ENUMERATE_SUB_KEYS = &H8   ' Requis pour énumérer les sous-clés contenues dans une clé
  KEY_TY_EXECUTE = &H20019          ' Equivalent de KEY_TY_READ
  KEY_TY_QUERY_VALUE = &H1          ' Requis pour lister les valeurs d?une clé
  KEY_TY_NOTIFY = &H10              ' Requis pour demander des avis de changement pour une clé ou pour des sous-clés
  KEY_TY_READ = &H20019             ' KEY_ST_RIGHTS_READ, KEY_TY_QUERY_VALUE, KEY_TY_ENUMERATE_SUB_KEYS et KEY_TY_NOTIFY
  KEY_TY_SET_VALUE = &H2            ' Requis pour créer, supprimer, ou changer une valeur
  KEY_TY_WOW64_64KEY = &H100        ' pas sur ????
  KEY_TY_WOW64_32KEY = &H200        ' pas sur ????
  KEY_TY_WRITE = &H20006            ' KEY_ST_RIGHTS_WRITE, KEY_TY_SET_VALUE et KEY_TY_CREATE_SUB_KEY
End Enum

'----------------------------------------------------------------------------------------------------------------------
' 0.3.1. Les fonctions Principale de l'API DLL "advapi32.dll" utilisée pour accéder à la base de registre
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
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

'----------------------------------------------------------------------------------------------------------------------
' 0.3.2. Les fonctions de lecture de l'API DLL "advapi32.dll"
Private 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, ByVal lpData As String, lpcbData As Long) As Long
Private 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 REG_TIME) As Long
Private 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
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 REG_TIME) As Long
Private Declare Function RegQueryValueExStr 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 RegQueryValueExLong 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 RegQueryValueExByte 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

'----------------------------------------------------------------------------------------------------------------------
' 0.3.3. Les fonctions d'écriture de l'API DLL "advapi32.dll"
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 REG_SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition As Long) As Long
Private Declare Function RegSetValueExStr 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 RegSetValueExLong 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 RegSetValueExByte 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

'----------------------------------------------------------------------------------------------------------------------
' 0.3.4. Les fonctions de suppression de l'API DLL "advapi32.dll"
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long

'----------------------------------------------------------------------------------------------------------------------
' 0.3.5. Les fonctions de connexion reseau de l'API DLL "advapi32.dll"
Private Declare Function RegConnectRegistry Lib "advapi32.dll" Alias "RegConnectRegistryA" (ByVal lpMachineName As String, ByVal hKey As Long, phkResult As Long) As Long

'----------------------------------------------------------------------------------------------------------------------
' 0.4. Declaration des fonctions API Windows LIB kernel32 pour les convertions de type voir aussi : StrPtr, VarPtr
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Long) As Long
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, ByVal Source As Long, ByVal Length As Long)
Private Declare Function ExpandEnvironmentStrings Lib "kernel32" Alias "ExpandEnvironmentStringsA" (ByVal lpSrc As String, ByVal lpDst As String, ByVal nSize As Long) As Long

'######################################################################################################################
'######################################################################################################################
'######################################################################################################################
' 1. Fonction de lecture      : RegExistKey, RegExistVal, RegInfoKey, RegEnumSubKey, RegEnumVal
'----------------------------------------------------------------------------------------------------------------------
' 1.1. Retourne TRUE si la KEY exist
Public Function RegExistKey(keyroot As RegRootKey, Key$) As Boolean
  Dim h As Long
  RegExistKey = (RegOpenKeyEx(keyroot, Key$, 0, KEY_ALL_ACCESS, h) = 0)
  If h <> 0 Then RegCloseKey h
End Function
'----------------------------------------------------------------------------------------------------------------------
' 1.2. Retourne TRUE si la VALUE exist
Public Function RegExistVal(keyroot As RegRootKey, Key$, value$) As Boolean
  Dim h As Long
  RegExistVal = (RegOpenKeyEx(keyroot, Key$, 0&, KEY_ALL_ACCESS, h) = 0)
  If h <> 0 Then
    RegExistVal = (RegQueryValueExStr(h, value$, 0&, 0&, vbNullString, 0&) = 0)
    RegCloseKey h
  End If
End Function
'----------------------------------------------------------------------------------------------------------------------
' 1.3. Retourne un REG_QUERY_KEY d'informations d'une KEY
Public Function RegInfoKey(keyroot As RegRootKey, Key$) As REG_QUERY_KEY '???? ne retourn que 0,0,0,0,0,0 ????
  Dim h As Long, r As REG_QUERY_KEY, v As Long, ti As REG_TIME ', t As String, l As Long, n As Long
  RegInfoKey = r
  If RegOpenKeyEx(keyroot, Key$, 0, KEY_ALL_ACCESS, h) = 0 Then
    If RegQueryInfoKey(h, 0&, 0&, 0&, _
    r.Reg_Key_n, r.Reg_Key_l, r.Reg_Value_n, r.Reg_Name_n, r.Reg_Name_l, r.Reg_Value_l, 0&, ti) = 0 Then RegInfoKey = r
    RegCloseKey h
  End If
End Function
'----------------------------------------------------------------------------------------------------------------------
' 1.4. Retourne la liste String() des sous-Key d'une KEY
Public Function RegEnumSubKey(keyroot As RegRootKey, Key$) As Variant
  Dim ls(), h As Long, r$, i, t As Long, n As Long, l As Long, ti As REG_TIME, ttt As Long
  ls = Array()
  RegEnumSubKey = ls()
  If RegOpenKeyEx(keyroot, Key$, 0, KEY_ALL_ACCESS, h) = 0 Then
    r = Space(REG_BUFFER_SIZE)
    t = REG_NONE
    n = 0&: l = REG_BUFFER_SIZE
    Do
      If RegEnumKeyEx(h, n, r, l, 0&, vbNullString, 0&, ti) <> 0 Then Exit Do
      If UBound(ls) < n Then ReDim Preserve ls(n)
      ls(n) = Left(r, l)
      r = Space(REG_BUFFER_SIZE)
      l = REG_BUFFER_SIZE
      n = n + 1
    Loop
    RegCloseKey h
    RegEnumSubKey = ls
    Erase ls
  End If
End Function
'----------------------------------------------------------------------------------------------------------------------
' 1.5. Retourne la liste String() des Value d'une KEY
Public Function RegEnumVal(keyroot As RegRootKey, Key$) As Variant
  Dim ls, h As Long, r$, i, t As Long, n As Long, l As Long
  ls = Array()
  RegEnumVal = ls
  If RegOpenKeyEx(keyroot, Key$, 0, KEY_ALL_ACCESS, h) = 0 Then
    r = Space(REG_BUFFER_SIZE)
    t = REG_NONE
    n = 0&: l = REG_BUFFER_SIZE
    While (RegEnumValue(h, n, r, l, 0, t, vbNullString, 0) <> REG_ERROR_NO_MORE_ITEMS)
      If UBound(ls) < n Then ReDim Preserve ls(n)
      ls(n) = Left(r, l)
      r = Space(REG_BUFFER_SIZE)
      l = REG_BUFFER_SIZE
      n = n + 1
    Wend
    RegCloseKey h
  End If
  RegEnumVal = ls
  Erase ls
  Erase ls
End Function
'----------------------------------------------------------------------------------------------------------------------
' 1.6. Lit une VALUE dans la KEY de Registre
Public Function RegGetVal(keyroot As RegRootKey, Key$, value$) As Variant
  Dim h As Long, r$, rl As Long, rb() As Byte, i, t As Long, l As Long, c, tt
  RegGetVal = Null
  If RegOpenKeyEx(keyroot, Key$, 0, KEY_ALL_ACCESS, h) = 0 Then
    r = Space(REG_BUFFER_SIZE)
    l = REG_BUFFER_SIZE
    t = REG_NONE
    If RegQueryValueExStr(h, value$, 0, t, r, l) = 0 Then
      Select Case t
        Case REG_SZ:
          RegGetVal = Left(r, l - 1)
        Case REG_EXPAND_SZ:
          RegGetVal = ExpandEnvStr(r)
        Case REG_MULTI_SZ:
          RegGetVal = Split(Left(r, l - 1), Chr(0))
        Case REG_DWORD:
          If RegQueryValueExStr(h, value$, 0, t, rl, l) = 0 Then RegGetVal = CLng(rl)
        Case REG_DWORD_BIG_ENDIAN:  ' long avec les bytes a l'envers
          If RegQueryValueExStr(h, value$, 0, t, rl, l) = 0 Then RegGetVal = SwapEndian(rl)
        Case Else: ' REG_BINARY....
          ReDim rb(l)
          If RegQueryValueExByte(h, value$, 0, t, rb(0), l) = 0 Then RegGetVal = rb
      End Select
    End If
    RegCloseKey h
  End If
End Function

'######################################################################################################################
'######################################################################################################################
'######################################################################################################################
' 2. Fonction d'écriture      : RegAddKey, RegAddVal
'----------------------------------------------------------------------------------------------------------------------
' 2.1. Creer une KEY de registre et toutes ses sous-KEY si elles n'existent pas
Public Function RegAddKey(keyroot As RegRootKey, Key$, Optional acces As RegAccess = KEY_ALL_ACCESS, Optional volatile As RegOptionKey = REG_OPTION_NON_VOLATILE)
  Dim h As Long, ph As Long, r As Long, s As REG_SECURITY_ATTRIBUTES, kl, n
  RegAddKey = False
  kl = Split(Key, REG_SEP)
  If RegOpenKeyEx(keyroot, vbNullString, 0, KEY_ALL_ACCESS, ph) <> 0 Then Exit Function
  For n = 0 To UBound(kl)
    If RegCreateKeyEx(ph, kl(n), 0, vbNullString, volatile, acces, s, h, r) <> 0 Then Exit For
    If r <> REG_CREATED_NEW_KEY And r <> REG_OPENED_EXISTING_KEY Then Exit For
    RegCloseKey ph
    ph = h
  Next n
  RegCloseKey ph
  RegAddKey = RegExistKey(keyroot, Key)
End Function
'----------------------------------------------------------------------------------------------------------------------
' 2.2. Creer une VALUE dans la KEY et lui affect DATA
Public Function RegAddVal(keyroot As RegRootKey, Key$, value$, data As Variant, Optional keytype As RegTypeKey = REG_NONE, Optional autocreatekey As Boolean = True) As Boolean
  Dim h As Long, l As Long, v As String, p As Long, datab() As Byte
  RegAddVal = False
  If autocreatekey Then If Not RegAddKey(keyroot, Key) Then Exit Function
  On Error GoTo ERREUR
  If RegOpenKeyEx(keyroot, Key$, 0, KEY_ALL_ACCESS, h) = 0 Then
    Select Case VarType(data)
      Case vbArray + vbByte:
        If keytype = REG_NONE Then keytype = REG_BINARY
        datab = data
        RegAddVal = (RegSetValueExByte(h, value, 0&, keytype, datab(0), CLng(UBound(data) - LBound(data) + 1)) = 0)
      Case vbArray + vbString, vbArray + vbVariant:
        keytype = REG_MULTI_SZ
        data = Join(data, Chr(0))
        RegAddVal = (RegSetValueExStr(h, value, 0&, keytype, data, CLng(Len(data) + 1)) = 0)
      Case vbInteger, vbLong:
        RegAddVal = (RegSetValueExLong(h, value, 0&, REG_DWORD, CLng(data), 4&) = 0)
      Case vbBoolean:
        If data Then data = 1& Else data = 0&
        RegAddVal = (RegSetValueExLong(h, value, 0&, REG_DWORD, CLng(data), 4&) = 0)
      Case Else:
        If keytype = REG_NONE Then
          keytype = REG_SZ
          p = InStr(1, data, "%")
          If p Then If InStr((p + 2), data, "%") Then keytype = REG_EXPAND_SZ
        End If
        RegAddVal = (RegSetValueExStr(h, value, 0&, keytype, data, CLng(Len(data) + 1)) = 0)
    End Select
    RegCloseKey h
  End If
  Exit Function
ERREUR:
  On Error GoTo 0
  RegAddVal = False
End Function

'######################################################################################################################
'######################################################################################################################
'######################################################################################################################
' 3. Fonction de suppression  :   RegDelKey, RegDelVal
'----------------------------------------------------------------------------------------------------------------------
' 3.1. Supprime une KEY du registre
Public Function RegDelKey(keyroot As RegRootKey, Key$, Optional delsubkeyauto As Boolean = False)
  Dim h As Long, papa$, le, i
  RegDelKey = False
  papa = RegParent(Key)
  If RegOpenKeyEx(keyroot, papa, 0, KEY_ALL_ACCESS, h) = 0 Then
    If delsubkeyauto Then
      le = RegEnumSubKey(keyroot, Key)
      For i = 0 To UBound(le)
        RegDelKey keyroot, Key & "\" & le(i), delsubkeyauto
      Next i
    End If
    RegDelKey = (RegDeleteKey(h, RegName(Key)) = 0)
    RegCloseKey h
  End If
End Function
'----------------------------------------------------------------------------------------------------------------------
' 3.2. Supprime une VALUE dans la KEY du registre
Public Function RegDelVal(keyroot As RegRootKey, Key$, value$)
  Dim h As Long
  RegDelVal = False
  If RegOpenKeyEx(keyroot, Key$, 0, KEY_ALL_ACCESS, h) = 0 Then
    RegDelVal = RegDeleteValue(h, value)
    RegCloseKey h
  End If
End Function

'######################################################################################################################
'######################################################################################################################
'######################################################################################################################
' 4. Fonction de conversion   : SwapEndian, ExpandEnvStr, StringEnByte, ByteEnString, VarByte, StringEnLong, LongEnString
'----------------------------------------------------------------------------------------------------------------------
' 4.1. Inverce les bytes d'un long pour le type REG_DWORD_BIG_ENDIAN
Private Function SwapEndian(ByVal dw As Long) As Long
  MoveMemory ByVal VarPtr(SwapEndian) + 3, dw, 1
  MoveMemory ByVal VarPtr(SwapEndian) + 2, ByVal VarPtr(dw) + 1, 1
  MoveMemory ByVal VarPtr(SwapEndian) + 1, ByVal VarPtr(dw) + 2, 1
  MoveMemory SwapEndian, ByVal VarPtr(dw) + 3, 1
End Function
'----------------------------------------------------------------------------------------------------------------------
' 4.2. Conversion de Texte pour le type REG_EXPAND_SZ Windows 95 limitation
Private Function ExpandEnvStr(sData As String) As String
  Dim c As Long, s As String
  s = "" ' Needed to get around Windows 95 limitation
  c = ExpandEnvironmentStrings(sData, s, c)
  s = String$(c - 1, 0)
  c = ExpandEnvironmentStrings(sData, s, c)
  ExpandEnvStr = s
End Function
'----------------------------------------------------------------------------------------------------------------------
' 4.3.1. Conversion de Texte String en table de Byte (le C me manque)
Function StringEnByte(s As String, Optional l As Long = 0) As Byte()
  Dim b() As Byte
  If l <= 0& Then l = CLng(Len(s)) * 2&
  ReDim b(l)
  MoveMemory b(0), StrPtr(s), l
  StringEnByte = b
End Function
'----------------------------------------------------------------------------------------------------------------------
' 4.3.2. Conversion d'un table de Byte en String (le C me manque)
Function ByteEnString(b() As Byte) As String
  Dim r As String, l As Long
  l = Round(CLng((UBound(b)) + 1&) / 2&) * 2&
  r = String(l, Chr(0))
  MoveMemory r, VarPtr(b(0)), l
  ByteEnString = r
End Function
'----------------------------------------------------------------------------------------------------------------------
' 4.4.1. Conversion de String en Long (le C me manque)
Function StringEnLong(s As String) As Long   'StrPtr, VarPtr
  Dim l As Long, r As String
  r = String(4, Chr(0))
  lstrcpy r, VarPtr(s)
  MoveMemory l, StrPtr(r), 4
  StringEnLong = l
End Function
'----------------------------------------------------------------------------------------------------------------------
' 4.4.2. Conversion de long en String (le C me manque)
Function LongEnString(n As Long) As String
  Dim r As String
  r = String(4, Chr(0))
  lstrcpy r, VarPtr(n)
  LongEnString = r
End Function
'----------------------------------------------------------------------------------------------------------------------
' 4.5.
Function VarByte(b As Variant) As Byte()
  Dim r() As Byte, n As Long
  ReDim r(UBound(b)) As Byte
  For n = 0 To UBound(b): r(n) = b(n): Next n
  VarByte = r
End Function
Public Function RegParent(Key$)
  Dim p
  RegParent = Key
  p = InStrRev(Key, "\", , vbTextCompare)
  If p <> 0 And Not IsNull(p) Then RegParent = mid(Key, 1, p - 1)
End Function
Public Function RegName(Key$)
  Dim p
  RegName = Key
  p = InStrRev(Key, "\", , vbTextCompare)
  If p <> 0 And Not IsNull(p) Then RegName = mid(Key, p + 1)
End Function

'######################################################################################################################
'######################################################################################################################
'######################################################################################################################

Sub RegTest()
  Dim r As RegRootKey, k$, v$, m, i As REG_QUERY_KEY, t
  t = 3
  r = HKLM: k = "HARDWARE\DESCRIPTION\System": v = "Component Information"      ' REG_BINARY
  'r = HKCU: k = "AppEvents\EventLabels\ActivatingDocument": v = "DispFileName"  ' REG_EXPAND_SZ
  Select Case t
    Case 1: ' ------------------------------------------------------- Test des fonctions de lecture
      '1.1. RegExistKey
      MsgBox "RegExistKey" & vbCrLf & RegExistKey(r, k)
      '1.2. RegExistVal
      MsgBox "RegExistVal" & vbCrLf & RegExistVal(r, k, v)
      '1.1. RegInfoKey
      i = RegInfoKey(r, k)
      MsgBox "RegInfoKey" & vbCrLf & "Key nbr : " & i.Reg_Key_n & vbCrLf & "Key len : " & i.Reg_Key_l & vbCrLf & "Nom nbr : " & i.Reg_Name_n & vbCrLf & "Nom len : " & i.Reg_Name_l & vbCrLf & "Val nbr : " & i.Reg_Value_n & vbCrLf & "Val len : " & i.Reg_Value_l
      '1.2. RegEnumVal
      MsgBox "RegEnumVal" & vbCrLf & Join(RegEnumVal(r, k), vbCrLf)
      '1.3. RegEnumSubKey
      MsgBox "RegEnumSubKey" & vbCrLf & Join(RegEnumSubKey(r, k), vbCrLf)
      '1.3. RegGetVal
      MsgBox "RegGetVal" & vbCrLf & RegGetVal(r, k, v)
    Case 2: ' ------------------------------------------------------- Test des fonctions d'ecriture
      r = HKLM: k = "SOFTWARE\_Tom\REG.Bas\v1.0": v = "version"
      Dim db() As Byte, td
      ReDim db(10): db(10) = &H64: db(0) = &H96: db(5) = &HFF
      td = Array("juste", "pour", "voir")
      '2.1. RegAddKey
      MsgBox RegAddKey(r, k)
      '2.1. RegAddKey
      RegAddVal r, k, v, True
      RegAddVal r, k, v & "1", CStr(False)
      MsgBox "RegGetVal" & vbCrLf & RegGetVal(r, k, v)
      'MsgBox "RegGetVal" & vbCrLf & RegGetVal(r, k, v)(1)
    Case 3: ' --------------------------------------------------- Test des fonctions de suppression
      r = HKLM: k = "SOFTWARE\_Tom\REG.Bas": v = "version"
      RegAddVal r, k & "\001", v & "0", "text1"
      RegAddVal r, k & "\001", v & "1", Array("txt0", "txt1", "txt2", "txt3")
      RegAddVal r, k & "\001", v & "2", 300
      RegAddVal r, k & "\001", v & "3", True
      RegAddVal r, k & "\002", v & "0", "text1"
      RegAddVal r, k & "\002", v & "1", Array("txt0", "txt1", "txt2", "txt3")
      RegAddVal r, k & "\003", v & "2", 300
      RegAddVal r, k & "\003", v & "3", True
      MsgBox "Ajoute de clé et valeur : HKLM\" & k & vbCrLf & Join(RegEnumVal(r, k & "\001"), vbCrLf)
      RegDelVal r, k & "\001", v & "0"
      RegDelVal r, k & "\001", v & "2"
      MsgBox "Valeur Supprimées : HKLM\" & k & vbCrLf & Join(RegEnumVal(r, k & "\001"), vbCrLf)
      r = HKLM: k = "SOFTWARE\_Tom\REG.Bas"                     ' ecriture
      RegDelKey r, k, True
      MsgBox "Clée Supprimée : " & k
  End Select
End Sub

Conclusion :


Et voila un premier code...

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.