Lecture récursive du registre

Hello,

Voici un bout de code qui le permet.

Option Explicit

Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_USERS = &H80000003
Private Const HKEY_PERFORMANCE_DATA = &H80000004
Private Const HKEY_CURRENT_CONFIG = &H80000005
Private Const HKEY_DYN_DATA = &H80000006

Private Const REG_SZ = 1
Private Const REG_DWORD = 4

'------------------------------------
'Droits d'accès
Private Const DELETE = (&H10000)
Private Const READ_CONTROL = (&H20000)
Private Const WRITE_DAC = (&H40000)
Private Const WRITE_OWNER = (&H80000)
Private Const SYNCHRONIZE = (&H100000)

Private Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Private Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Private Const STANDARD_RIGHTS_EXECUTE = (READ_CONTROL)

Private Const STANDARD_RIGHTS_ALL = (&H1F0000)

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_WOW64_32KEY = (&H200)
Private Const KEY_WOW64_64KEY = (&H100)
Private Const KEY_WOW64_RES = (&H300)
Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or
KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Private Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or
KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
Private Const KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE))
Private 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))

'------------------------------------
'Types requis par les fonctions

Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type


'----------------------------------
'Fonctions

Private Declare Function RegEnumKeyEx _
Lib "Advapi32" _
Alias "RegEnumKeyExA" _
( _
ByVal hKey As Long, _
ByVal dwIndex As Long, _
ByVal lpName As String, _
lpcName As Long, _
ByVal lpReserved As Long, _
ByVal lpClass As String, _
lpcClass As Long, _
lpftLastWriteTime As FILETIME _
) _
As Long
Private Declare Function RegOpenKeyEx _
Lib "Advapi32" _
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" _
( _
ByVal hKey As Long _
) _
As Long
Private Declare Function RegEnumValue _
Lib "Advapi32" _
Alias "RegEnumValueA" _
( _
ByVal hKey As Long, _
ByVal dwIndex As Long, _
ByVal lpValueName As String, _
lpcValueName As Long, _
ByVal lpReserved As Long, _
lpType As Long, _
lpData As Any, _
lpcbData As Long _
) _
As Long
Private Declare Sub CopyMemory _
Lib "kernel32" _
Alias "RtlMoveMemory" _
( _
Destination As Any, _
Source As Any, _
ByVal Length As Long)

Private Sub Form_Load()
EnumKeys HKEY_CURRENT_USER, "Identities" 'HKEY_CURRENT_USERIdentities
End Sub

Private Sub EnumKeys(RootKey As Long, KeyPath As String)
Dim Name As String, NameLenght As Long
Dim Index As Long
Dim RC As Long
Dim LastWritten As FILETIME
Dim BaseKey As Long
Dim ValueType As Long
Dim ValueLenght As Long
Dim Value As String

Static Tabs As Long

'On ajoute un a la fin du chemin s'il n'était pas présent
'pour des raisons de facilité
KeyPath = EndPath(KeyPath)

'Pour énumérer les sous clés, il faut ouvrir la clé
'Enum Sous clés : KEY_ENUMERATE_SUB_KEYS
'Enum Valeurs requiert : KEY_QUERY_VALUE
If RegOpenKeyEx(RootKey, KeyPath, 0, KEY_ENUMERATE_SUB_KEYS Or
KEY_QUERY_VALUE, BaseKey) = 0 Then

'On part du premier élément, pour l'énumération qui suivra
Index = 0

Do
'La fonction RegEnumKeyEx ne retourne pas le nombre de
caractères du nom qu'elle renvoie
'Il faut donc boucler et augmenter le buffer jusqu'a ce qu'il y
ait suffisament de caractères
'dispo dans le buffer pour ne plus générer l'erreur, si erreur
il y a

NameLenght = 0
RC = 234
Do
'Incrémente la taille du nom
NameLenght = NameLenght + 255

'Initialise le buffer à la taille requise
Name = String$(NameLenght + 1, vbNullChar)

'Appel de l'API
RC = RegEnumKeyEx(BaseKey, Index, Name, NameLenght, 0,
vbNullString, 0, LastWritten)
Loop While (RC = 234) ' ERROR_MOREDATA

'On trim le buffer au nombre de caractères écrits par l'API
If RC = 0 Then
List1.AddItem String$(Tabs, vbTab) & Left$(Name, NameLenght)

Tabs = Tabs + 1
EnumKeys RootKey, KeyPath & Left$(Name, NameLenght)
Tabs = Tabs - 1
End If

Index = Index + 1

' a la moindre erreur (et en particulier, la fin de l'énumération -
ERROR_NO_MORE_ITEMS)
'on arrête l'énumération
Loop Until RC

'On recommence une énumération des valeurs cette fois
Index = 0

Do
NameLenght = 0
RC = 234
ValueLenght = 0
ValueType = 0
Do
NameLenght = NameLenght + 255
Name = String$(NameLenght + 1, vbNullChar)
Value = String$(ValueLenght, vbNullChar)
RC = RegEnumValue(BaseKey, Index, Name, NameLenght, 0,
ValueType, ByVal Value, ValueLenght)
Loop While (RC = 234) ' ERROR_MOREDATA

If RC = 0 Then
Select Case ValueType
Case REG_SZ
List1.AddItem "* " & String$(Tabs, vbTab) &
Left$(Name, NameLenght) & " = " & Left$(Value, ValueLenght - 1) & vbTab &
"(REG_SZ)"
Case REG_DWORD
List1.AddItem "* " & String$(Tabs, vbTab) &
Left$(Name, NameLenght) & " = " & StringToLong(Value) & vbTab &
"(REG_DWORD)"
Case Else
List1.AddItem "*" & String$(Tabs, vbTab) &
Left$(Name, NameLenght)
End Select
End If

Index = Index + 1
Loop Until RC

RegCloseKey BaseKey
End If
End Sub

Public Function StringToLong(strIn As String) As Long
'Convertit une chaine en long en employant CopyMemory
If LenB(strIn) = 8 Then
CopyMemory StringToLong, ByVal strIn, 4
End If
End Function

Public Function EndPath(FilePath As String) As String
EndPath = Trim$(FilePath)
If Right$(EndPath, 1) <> "" Then EndPath = EndPath & ""
End Function

--
François Picalausa

Salut Scraper! :O)

utilise ma classe CRegistry, ça te facilitera les choses
http://groups.google.com/groups?selm=%2333VNZD1CHA.1768%40TK2MSFTNGP12

tu dois y ajouter un ligne toute simple ... dans la méthode GetValues()
ajoute la ligne contenant le Split() comme suit :
'***
' snip
Dim sValues() As String
Const BUFFER_SIZE As Long = 255

sValues = Split("", " ") ' Initialise le tableau
If RegOpenKey(bkh, sKey, hKey) = 0 Then
' snip
'***

Cela permet de retourner un tableau vide MAIS initialisé (de 0 à -1) ce qui
évite le déclenchement d'une erreur lorsque l'on appelle UBound().


et maintenant voici un exemple de ce que souhaite faire :
remarque que l'algorithme de récursivité est très simple dans un cas
semblable.. tu vérifies si l'objet à des enfants et si oui tu rappelles la
même fonction pour chacun d'eux :
'***
' Module1
Option Explicit

Private Sub Main()
Call PrintKeyInfo("SOFTWAREODBCODBC.INI", rkcLocalMachine, 0)
End Sub

Private Sub PrintKeyInfo(ByRef sKey As String, ByRef rkc As
eRootKeyConstants, ByRef iStackLevel As Long)

Dim rg As CRegistry
Dim sKeys() As String
Dim sValues() As String
Dim i As Long

Set rg = New CRegistry

'imprime le nom de la clé courante
Debug.Print String$(iStackLevel, vbTab) & "key::" & sKey

' on imprime les valeurs de la clé courante
sValues = rg.GetValues(rkc, sKey)
For i = 0 To UBound(sValues)
If (sValues(i) <> " ") Then
Debug.Print String$(iStackLevel + 1, vbTab) & "value::" &
sValues(i)
End If
Next i

' on test si la clé à des enfants
sKeys = rg.GetKeys(rkc, sKey)
For i = 0 To UBound(sKeys)
' on rapelle la fonction sur les sous-clés
' en incrémentant le stack level (pour les tabs)
' note que l'on concatène la clé reçu en paramètre
' afin d'obtenir le path absolu et non relatif.
' c-a-d. SOFTWAREODBCODBC.INI et on seulement ODBC.INI par
exemple
Call PrintKeyInfo(sKey & "" & sKeys(i), rkc, iStackLevel + 1)
Next i

End Sub
'***

--
Cordialement
Yanick Lefebvre
MVP pour Visual Basic
"scraper" <scraper@pasdespam.fr> a écrit dans le message de
news:OzKN%23WksEHA.2560@tk2msftngp13.phx.gbl...

bonjour à tous !

je cherche à lister toutes les sous clés (et les valeurs qu'elles
contiennent) d'une clé donnée du registre

si quelqu'un a ça dans ses cartons, (ou une URL) ça m'aiderait beaucoup,
parce que là, je sèche ...

(la notion de récursivité ... Brrr )

merci d'avance

:-)

--

Attention ! Adresse mail invalide ...
Pour me contacter, cliquez sur le lien ci-dessous:
http://scraper.chez.tiscali.fr/contact.htm

scraper

Bonjour Zoury
(dans news:exvSiQwsEHA.636@TK2MSFTNGP09.phx.gbl)
tu nous disais :

Salut Scraper! :O)

utilise ma classe CRegistry, ça te facilitera les choses
http://groups.google.com/groups?selm=%2333VNZD1CHA.1768%40TK2MSFTNGP12

merci, j'ai bien noté et te remercie

dès que je peux (là, je suis un peu short ...) je te dis ce qu'il en est

merci encore à toi


--

Attention ! Adresse mail invalide ...
Pour me contacter, cliquez sur le lien ci-dessous:
http://scraper.chez.tiscali.fr/contact.htm

scraper

Bonjour François Picalausa
(dans news:uvjW1HwsEHA.2300@TK2MSFTNGP09.phx.gbl)
tu nous disais :

Hello,

Voici un bout de code qui le permet.

OK, c'est sympa, merci :-)

je pense pas pouvoir tester en profondeur avant la semaine prochaine ...

je reviendrai te dire

merci encore



--

Attention ! Adresse mail invalide ...
Pour me contacter, cliquez sur le lien ci-dessous:
http://scraper.chez.tiscali.fr/contact.htm

scraper

Bonjour François Picalausa
(dans news:uvjW1HwsEHA.2300@TK2MSFTNGP09.phx.gbl)
tu nous disais :

Hello,

Voici un bout de code qui le permet.

hello :-)

je reviens ... un peu tard :-)

c'est parfait, ça fonctionne à merveille :-)

merci, c'est royal

à +



--

Attention ! Adresse mail invalide ...
Pour me contacter, cliquez sur le lien ci-dessous:
http://scraper.chez.tiscali.fr/contact.htm

scraper