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 & Replace(Key, "\\", "\")
End Sub
