Attribute VB_Name = "Registry"

Public 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

Public 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

Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Public 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, _
                                      lpData As Byte, _
                                      lpcbData As Long) As Long

Public 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

Public AllKeys()   As String

Public ValueKeys() As String

Public ValueCount  As Long

Public NoExist     As Long

Public TrialName   As String

Public Result      As String

Public Const KEY_READ = &H20019

Public Const KEY_QUERY_VALUE = &H1

Public Const KEY_WRITE = &H20006

Public Enum RegistryPaths

    HKEY_CLASSES_ROOT = &H80000000
    HKEY_CURRENT_USER = &H80000001
    HKEY_LOCAL_MACHINE = &H80000002
    HKEY_USERS = &H80000003

End Enum

Dim ReturnValue As Long

Public Function ReadValue(ByVal hKey As RegistryPaths, _
                          ByVal SubKey As String, _
                          ByVal ValueName As String)

    Dim Temp       As Long

    Dim foundValue As String

    Dim ValueSize  As Long

    Dim DataType   As Long

    Dim ValueData  As String

    Dim TempValue  As String

    ReturnValue = RegOpenKeyEx(hKey, SubKey, 0, KEY_READ, Temp)

    If ReturnValue <> 0 Then NoExist = 1 Else NoExist = 0

    If ReturnValue = 0 Then
        foundValue = Space$(3200)
        ValueSize = 3200
        ReturnValue = RegQueryValueEx(Temp, ValueName, 0, DataType, ByVal foundValue, ValueSize)

        If ValueSize <> 0 Then foundValue = Left$(foundValue, ValueSize - 1)
        ValueData = ""
        ValueData = foundValue
        ReturnValue = RegCloseKey(Temp)
        ReadValue = ValueData
    
    End If

End Function

Public Sub EnumAllRegKeys(ByVal hKey As RegistryPaths, ByVal SubKey As String)

    On Error GoTo Er

    Dim Temp    As Long

    Dim Index   As Long

    Dim KeyName As String

    Dim TempKey As String

    If RegOpenKeyEx(hKey, SubKey, 0, KEY_READ, Temp) Then Exit Sub

    Do
        KeyName = Space$(255)

        If RegEnumKey(Temp, Index, KeyName, 255) <> 0 Then Exit Do
        Index = Index + 1
        KeyName = TrimNull(KeyName)

        If SubKey <> "" Then
            TempKey = SubKey & "\" & KeyName
        Else
            TempKey = KeyName
        End If

        ReDim Preserve AllKeys(UBound(AllKeys) + 1) As String
        AllKeys(UBound(AllKeys)) = TempKey
        Call EnumAllRegKeys(hKey, TempKey)
    
    Loop

Er:
    RegCloseKey Temp
End Sub

Public Function TrimNull(StartStr As String) As String

    Dim pos As Integer

    pos = InStr(StartStr, Chr$(0))

    If pos Then
        TrimNull = Left$(StartStr, pos - 1)

        Exit Function

    End If

    TrimNull = StartStr
End Function

Public Function EnumValues(ByVal hKey As RegistryPaths, ByVal SubKey As String) As Long

    On Error Resume Next

    Dim Index          As Long

    Dim ValueName      As String

    Dim ValueLen       As Long

    Dim DataLen        As Long

    Dim DataType       As Long

    Dim Data(0 To 254) As Byte

    Dim FoundValueName As String

    Dim FoundValueData As String

    Dim TempValue      As String

    Erase ValueKeys()
    ReDim ValueKeys(0) As String

    ReturnValue = RegOpenKeyEx(hKey, SubKey, 0, KEY_QUERY_VALUE, Temp)

    ValueCount = 0
    Index = 0

    While ReturnValue = 0

        ValueName = Space$(255)
        ValueLen = 255
        DataLen = 255
    
        ReturnValue = RegEnumValue(Temp, Index, ValueName, ValueLen, ByVal 0, DataType, Data(0), DataLen)

        If ReturnValue = 0 Then
            ValueCount = ValueCount + 1
            ValueName = Left$(ValueName, ValueLen)
            FoundValueName = ValueName
            ReDim Preserve ValueKeys(UBound(ValueKeys) + 1) As String
            ValueKeys(UBound(ValueKeys)) = ValueName
        End If

        Index = Index + 1

    Wend

    EnumValues = ValueCount

End Function

Public Sub AddToList(Key As String)
    Result = Result & vbCrLf & "1" & vbTab & TrialName & vbTab & Key
End Sub
