cReadEasyReg

'This function will return a array of variant with all the subkey values
'eg.
'  Dim MyVariant As Variant, MyReg As New CReadEasyReg, i As Integer
'  If Not MyReg.OpenRegistry(HKEY_LOCAL_MACHINE, "Software\Microsoft") Then
'   MsgBox "Couldn't open the registry"
'   Exit Sub
'  End If
'  MyVariant = MyReg.GetAllSubDirectories
'  For i = LBound(MyVariant) To UBound(MyVariant)
'   Debug.Print MyVariant(i)
'  Next i
'  MyReg.CloseRegistry
Function GetAllSubDirectories() As Variant
On Error GoTo handelgetdirvalues
 Dim SubKey_Num As Integer
 Dim SubKey_Name As String
 Dim Length As Long
 Dim ReturnArray() As Variant
 
 If Not OpenRegOk Then Exit Function
 'Get the Dir List
 SubKey_Num = 0
 Do
  Length = 256
  SubKey_Name = Space$(Length)
  If RegEnumKey(HKey, SubKey_Num, SubKey_Name, Length) <> 0 Then
   Exit Do
  End If
  SubKey_Name = Left$(SubKey_Name, InStr(SubKey_Name, Chr$(0)) - 1)
  ReDim Preserve ReturnArray(SubKey_Num) As Variant
  ReturnArray(SubKey_Num) = SubKey_Name
  SubKey_Num = SubKey_Num + 1
 Loop
 GetAllSubDirectories = ReturnArray
 Exit Function
handelgetdirvalues:
 GetAllSubDirectories = Null
 Exit Function
End Function
'This function will return a array of variant with all the value names in a key
'eg.
'  Dim MyVariant As Variant, MyReg As New CReadEasyReg, i As Integer
'  If Not MyReg.OpenRegistry(HKEY_LOCAL_MACHINE, "HardWare\Description\System\CentralProcessor\0") Then
'   MsgBox "Couldn't open the registry"
'   Exit Sub
'  End If
'  MyVariant = MyReg.GetAllValues
'  For i = LBound(MyVariant) To UBound(MyVariant)
'   Debug.Print MyVariant(i)
'  Next i
'  MyReg.CloseRegistry
Function GetAllValues() As Variant
On Error GoTo handelgetdirvalues
 Dim lpData As String, KeyType As Long
 Dim BufferLengh As Long, vname As String, vnamel As Long
 Dim ReturnArray() As Variant, Index As Integer
 
 If Not OpenRegOk Then Exit Function
 
 'Get the Values List
 Index = 0
 Do
  lpData = String(250, " ")
  BufferLengh = 240
  vname = String(250, " ")
  vnamel = 240
  If RegEnumValue(ByVal HKey, ByVal Index, vname, vnamel, 0, KeyType, lpData, BufferLengh) <> 0 Then
   Exit Do
  End If
  vname = Left$(vname, InStr(vname, Chr$(0)) - 1)
  ReDim Preserve ReturnArray(Index) As Variant
  ReturnArray(Index) = vname
  Index = Index + 1
 Loop
 GetAllValues = ReturnArray
 Exit Function
handelgetdirvalues:
 GetAllValues = Null
 Exit Function
End Function
'This function will return a specific value from the registry
'eg.
'  Dim MyString As String, MyReg As New CReadEasyReg, i As Integer
'  If Not MyReg.OpenRegistry(HKEY_LOCAL_MACHINE, "HardWare\Description\System\CentralProcessor\0") Then
'   MsgBox "Couldn't open the registry"
'   Exit Sub
'  End If
'  MyString = MyReg.GetValue("Identifier")
'  Debug.Print MyString
'  MyReg.CloseRegistry
Function GetValue(ByVal VarName As String) As String
On Error GoTo handelgetavalue
 Dim i As Integer
 Dim SubKey_Value As String, TempStr As String
 Dim Length As Long
 Dim value_type As Long
 
 If Not OpenRegOk Then Exit Function
 
 'Read the value
 Length = 256
 SubKey_Value = Space$(Length)
 If RegQueryValueEx(HKey, VarName, 0&, value_type, ByVal SubKey_Value, Length) <> 0 Then
  GetValue = ""
  Exit Function
 End If
 Select Case value_type
  Case 1 'Text
   SubKey_Value = Left$(SubKey_Value, Length - 1)
  Case 3 'Binary
   SubKey_Value = Left$(SubKey_Value, Length - 1)
   TempStr = ""
   For i = 1 To Len(SubKey_Value)
    TempStr = TempStr & Format$(Hex(Asc(Mid$(SubKey_Value, i, 1))), "00") & " "
   Next i
   SubKey_Value = TempStr
  Case Else
   SubKey_Value = "value_type=" & value_type
 End Select
 GetValue = SubKey_Value
 Exit Function
handelgetavalue:
 GetValue = ""
 Exit Function
End Function
'This property returns the current KeyValue
Public Property Get RegistryRootKey() As HKeys
 RegistryRootKey = RootHKey
End Property
'This property returns the current 'Registry Directory' your in
Public Property Get SubDirectory() As String
 SubDirectory = SubDir
End Property
'This function open's the registry at a specific 'Registry Directory'
'eg.
'  Dim MyVariant As Variant, MyReg As New CReadEasyReg, i As Integer
'  If Not MyReg.OpenRegistry(HKEY_LOCAL_MACHINE, "") Then
'   MsgBox "Couldn't open the registry"
'   Exit Sub
'  End If
'  MyVariant = MyReg.GetAllSubDirectories
'  For i = LBound(MyVariant) To UBound(MyVariant)
'   Debug.Print MyVariant(i)
'  Next i
'  MyReg.CloseRegistry
Public Function OpenRegistry(ByVal RtHKey As HKeys, ByVal SbDr As String) As Boolean
On Error GoTo OpenReg
 If RtHKey = 0 Then
  OpenRegistry = False
  OpenRegOk = False
  Exit Function
 End If
 RootHKey = RtHKey
 SubDir = SbDr
 If OpenRegOk Then
  CloseRegistry
  OpenRegOk = False
 End If
 If RegOpenKeyEx(RootHKey, SubDir, 0&, KEY_ALL_ACCESS, HKey) <> 0 Then
  OpenRegistry = False
  Exit Function
 End If
 OpenRegOk = True
 OpenRegistry = True
 Exit Function
OpenReg:
 OpenRegOk = False
 OpenRegistry = False
 Exit Function
End Function
'This function should be called after you're done with the registry
'eg. (see other examples)
Public Function CloseRegistry() As Boolean
On Error Resume Next
 If RegCloseKey(HKey) <> 0 Then
  CloseRegistry = False
  Exit Function
 End If
 CloseRegistry = True
 OpenRegOk = False
End Function
Private Sub Class_Initialize()
 RootHKey = &H0
 SubDir = ""
 HKey = 0
 OpenRegOk = False
End Sub
Private Sub Class_Terminate()
On Error Resume Next
 If RegCloseKey(HKey) <> 0 Then
  Exit Sub
 End If
End Sub