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...
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.