Option Explicit
'Registry API's to use 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 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 RegEnumValue Lib "advapi32.dll" _ Alias "RegEnumValueA" (ByVal HKey As Long, _ ByVal dwIndex As Long, ByVal lpName As String, _ cbName As Long, ByVal lpReserved As Long, _ lpType As Long, ByVal lpData As String, _ lpcbData As Long) As Long Private Declare Function 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 RegCloseKey Lib "advapi32.dll" _ (ByVal HKey As Long) As Long Private Declare Function ExpandEnvironmentStrings _ Lib "advapi32.dll" (lpSrc As String, lpDst _ As String, ByVal nSize As Long) As Long 'Enum's for the OpenRegistry function Public Enum HKeys HKEY_CLASSES_ROOT = &H80000000 HKEY_CURRENT_USER = &H80000001 HKEY_LOCAL_MACHINE = &H80000002 HKEY_USERS = &H80000003 HKEY_PERFORMANCE_DATA = &H80000004 HKEY_CURRENT_CONFIG = &H80000005 HKEY_DYN_DATA = &H80000006 End Enum 'Registry Type's Private Const REG_NONE = 0 Private Const REG_SZ = 1 Private Const REG_EXPAND_SZ = 2 Private Const REG_BINARY = 3 Private Const REG_DWORD = 4 Private Const REG_DWORD_LITTLE_ENDIAN = 4 Private Const REG_DWORD_BIG_ENDIAN = 5 Private Const REG_LINK = 6 Private Const REG_MULTI_SZ = 7 Private Const REG_RESOURCE_LIST = 8 Private Const REG_FULL_RESOURCE_DESCRIPTOR = 9 Private Const REG_RESOURCE_REQUIREMENTS_LIST = 10 'Right's for the OpenRegistry 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 SYNCHRONIZE = &H100000 Private Const KEY_READ = &H20009 Private Const KEY_WRITE = &H20006 Private Const KEY_READ_WRITE = (KEY_READ And KEY_WRITE ) 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 )) 'Local var's to keep track of things happening Dim RootHKey As HKeys Dim SubDir As String Dim HKey As Long Dim OpenRegOk As Boolean 'This function will return a array of variant 'with all the subkey values es. '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 es. 'Dim MyVariant As Variant, MyReg As New CReadEasyReg, i As Integer 'If Not MyReg.OpenRegistry(HKEY_LOCAL_MA ' CHINE, "HardWare\Description\System\Cent ' ralProcessor\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 es. '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, _ Optional ReturnBinStr As Boolean = False) _ 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, RtnVal As Long If Not OpenRegOk Then Exit Function 'Read the size of the value value RtnVal = RegQueryValueEx(HKey, VarName, 0&, value_type, ByVal 0&, Length) Select Case RtnVal Case 0 'Ok so continue Case 2 'Not Found Exit Function Case 5 'Access Denied GetValue = "Access Denied" Exit Function Case Else 'What? GetValue = "RegQueryValueEx Returned : (" & RtnVal & ")" Exit Function End Select 'declare the size of the value and read it SubKey_Value = Space$(Length) RtnVal = RegQueryValueEx(HKey, VarName, 0&, _ value_type, ByVal SubKey_Value, Length) Select Case value_type Case REG_NONE 'Not defined SubKey_Value = "Not defined value_type=REG_NONE" Case REG_SZ 'A null-terminated String SubKey_Value = Left$(SubKey_Value, Length - 1) Case REG_EXPAND_SZ 'A null-terminated string that contains unexpanded 'references to environment variables '(for example, "%PATH%"). 'Use ExpandEnvironmentStrings to expand SubKey_Value = Left$(SubKey_Value, Length - 1) Case REG_BINARY 'Binary data in any form. SubKey_Value = Left$(SubKey_Value, Length) If Not ReturnBinStr Then TempStr = "" For i = 1 To Len(SubKey_Value) TempStr = TempStr & Right$("00" & _ Trim$(Hex(Asc(Mid$(SubKey_Value, i, 1)))), 2) & " " Next i SubKey_Value = TempStr End If Case REG_DWORD, REG_DWORD_LITTLE_ENDIAN 'A 32-bit number. SubKey_Value = Left$(SubKey_Value, Length) If Not ReturnBinStr Then TempStr = "" For i = 1 To Len(SubKey_Value) TempStr = TempStr & Right$("00" & _ Trim$(Hex(Asc(Mid$(SubKey_Value, i, 1)))), 2) & " " Next i SubKey_Value = TempStr End If Case REG_DWORD_BIG_ENDIAN 'A 32-bit number in big-endian format. 'In big-endian format, a multi-byte value 'is stored in memory from 'the highest byte (the "big end") to the 'lowest byte. For example, 'the value 0x12345678 is stored as (0x12 '0x34 0x56 0x78) in big-endian format. Case REG_LINK 'A Unicode symbolic link. Used internally; 'applications should not use this type. SubKey_Value = "Not defined value_type=_ REG_LINK" Case REG_MULTI_SZ 'Array of null-terminated string SubKey_Value = Left$(SubKey_Value, Length) Case REG_RESOURCE_LIST 'Device driver resource list. SubKey_Value = "Not defined value_type=_ REG_RESOURCE_LIST" Case REG_FULL_RESOURCE_DESCRIPTOR 'Device driver resource list. SubKey_Value = "Not defined value_type=_ REG_FULL_RESOURCE_DESCRIPTOR" Case REG_RESOURCE_REQUIREMENTS_LIST 'Device driver resource list. SubKey_Value = "Not defined value_type=_ REG_RESOURCE_REQUIREMENTS_LIST" 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' es. '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 Integer On Error Goto OpenReg Dim ReturnVal As Integer If RtHKey = 0 Then OpenRegistry = False OpenRegOk = False Exit Function End If RootHKey = RtHKey SubDir = SbDr If OpenRegOk Then CloseRegistry OpenRegOk = False End If ReturnVal = RegOpenKeyEx(RootHKey, SubDir, 0&, KEY_READ, HKey) If ReturnVal <> 0 Then OpenRegistry = ReturnVal 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 |