Attribute VB_Name = "RegistryFunctions"
Option Explicit
'   Public Function QueryValue(lPredefinedKey As Hive, sKeyName As String, sValueName As String)
'   Public Function SetKeyValue(lPredefinedKey As Hive, sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As DataType)
'   Public Function CreateNewKey(lPredefinedKey As Hive, sNewKeyName As String)
'   Public Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As DataType, vValue As Variant) As Long
'   Public Function DeleteValue(lPredefinedKey As Hive, sKeyName As String, sValueName As String)
'   Public Function DeleteKey(lPredefinedKey As Hive, sKeyName As String)
'   Public Function EnumRegKey(lPredefinedKey As Hive, sKeyName As String) As String()
'   Public Function EnumKeyValues(lPredefinedKey As Hive, sKeyName As String) As String()

Public Enum Hive
    [HKEY_CLASSES_ROOT] = &H80000000
    [HKEY_CURRENT_USER] = &H80000001
    [HKEY_LOCAL_MACHINE] = &H80000002
    [HKEY_USERS] = &H80000003
End Enum

Public Enum DataType
    [Reg_String] = 1
    [Reg_Number] = 4
End Enum

Global Const ERROR_NONE = 0
Global Const ERROR_BADDB = 1
Global Const ERROR_BADKEY = 2
Global Const ERROR_CANTOPEN = 3
Global Const ERROR_CANTREAD = 4
Global Const ERROR_CANTWRITE = 5
Global Const ERROR_OUTOFMEMORY = 6
Global Const ERROR_INVALID_PARAMETER = 7
Global Const ERROR_ACCESS_DENIED = 8
Global Const ERROR_INVALID_PARAMETERS = 87
Global Const ERROR_NO_MORE_ITEMS = 259
Global Const KEY_ALL_ACCESS = &H3F
Global Const REG_OPTION_NON_VOLATILE = 0

Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" _
                (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, _
                ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, _
                ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long
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
Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" _
                (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
                lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" _
                (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
                lpType As Long, lpData As Long, lpcbData As Long) As Long
Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" _
                (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
                lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long
Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" _
                (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
                ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" _
                (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
                ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long
Declare Function RegDeleteKey& Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, _
                ByVal lpSubKey As String)
Declare Function RegDeleteValue& Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, _
                ByVal lpValueName As String)
Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, _
                ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, _
                ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, _
                ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, _
                lpftLastWriteTime As Any) As Long
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 Function DeleteKey(lPredefinedKey As Hive, sKeyName As String)
'###################################################################################
' Description:
'   This Function will Delete a key
'
' Syntax:
'   DeleteKey Location, KeyName
'
'   Location must equal HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_lOCAL_MACHINE
'   , HKEY_USERS
'
'   KeyName is name of the key you wish to delete, it may include
'   subkeys (example "Key1\SubKey1")
'
'   NOTE in Win2K you have to delete all subkey before delete key above them
'   Example
'    DeleteKey HKEY_LOCAL_MACHINE, "software\MyApp\Information"
'    DeleteKey HKEY_LOCAL_MACHINE, "software\MyApp"
'###################################################################################
    Dim lRetVal As Long         'result of the SetValueEx function
    Dim hKey As Long         'handle of open key
    
    'open the specified key
    
    'lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
    lRetVal = RegDeleteKey(lPredefinedKey, sKeyName)
    'RegCloseKey (hKey)
End Function

Public Function DeleteValue(lPredefinedKey As Hive, sKeyName As String, sValueName As String)
'###################################################################################
' Description:
'   This Function will delete a value
'
' Syntax:
'   DeleteValue Location, KeyName, ValueName
'
'   Location must equal HKEY_CLASSES_ROOT, HKEY_CURRENT_USER,
'   HKEY_lOCAL_MACHINE, HKEY_USERS
'
'   KeyName is the name of the key that the value you wish to delete is in
'   , it may include subkeys (example "Key1\SubKey1")
'
'   ValueName is the name of value you wish to delete
'
'   Example
'   DeleteValue HKEY_LOCAL_MACHINE, "Software\MyApp\Information", "Name"
'   DeleteValue HKEY_LOCAL_MACHINE, "Software\MyApp\Information", "Street number"
'###################################################################################

       Dim lRetVal As Long         'result of the SetValueEx function
       Dim hKey As Long         'handle of open key

       'open the specified key

       lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
       lRetVal = RegDeleteValue(hKey, sValueName)
       RegCloseKey (hKey)
End Function

Public Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As DataType, vValue As Variant) As Long
    Dim lValue As Long
    Dim sValue As String

    Select Case lType
        Case Reg_String
            sValue = vValue
            SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))
        Case Reg_Number
            lValue = vValue
            SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)
        End Select

End Function

Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long
    Dim cch As Long
    Dim lrc As Long
    Dim lType As DataType
    Dim lValue As Long
    Dim sValue As String

    On Error GoTo QueryValueExError
    
    ' Determine the size and type of data to be read
    
    lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
    If lrc <> ERROR_NONE Then Error 5

    Select Case lType
        ' For strings
        Case Reg_String
            sValue = String(cch, 0)
            lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)
            If lrc = ERROR_NONE Then
                vValue = Left$(sValue, cch)
            Else
                vValue = Empty
            End If

        ' For DWORDS
        Case Reg_Number
            lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch)
            If lrc = ERROR_NONE Then vValue = lValue
        Case Else
            'all other data types not supported
            lrc = -1
    End Select

QueryValueExExit:

    QueryValueEx = lrc
    Exit Function

QueryValueExError:

    Resume QueryValueExExit

End Function

Public Function CreateNewKey(lPredefinedKey As Hive, sNewKeyName As String)
'###################################################################################
' Description:
'   This Function will create a new key
'
' Syntax:
'   QueryValue Location, KeyName
'
'   Location must equal HKEY_CLASSES_ROOT, HKEY_CURRENT_USER,
'   HKEY_lOCAL_MACHINE, HKEY_USERS
'
'   KeyName is name of the key you wish to create, it may include
'   subkeys (example "Key1\SubKey1")
'
'   Example
'   CreateNewKey HKEY_LOCAL_MACHINE, "Software\MyApp\Information"
'###################################################################################
    Dim hNewKey As Long         'handle to the new key
    Dim lRetVal As Long         'result of the RegCreateKeyEx function
    
    lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, vbNullString, _
                REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hNewKey, lRetVal)
    RegCloseKey (hNewKey)
End Function

Public Function SetKeyValue(lPredefinedKey As Hive, sKeyName As String, _
        sValueName As String, vValueSetting As Variant, lValueType As DataType)
'###################################################################################
' Description:
'   This Function will set the data field of a value
'
' Syntax:
'   QueryValue Location, KeyName, ValueName, ValueSetting, ValueType
'
'   Location must equal HKEY_CLASSES_ROOT, HKEY_CURRENT_USER,
'   HKEY_lOCAL_MACHINE, HKEY_USERS
'
'   KeyName is the key that the value is under (example: "Key1\SubKey1")
'
'   ValueName is the name of the value you want to create, or set
'   the value of (example: "ValueTest")
'
'   ValueSetting is what you want the value to equal
'
'   ValueType must equal either Reg_String Or RegInteger
'
'   Examples
'   SetKeyValue HKEY_LOCAL_MACHINE, "software\MyApp\Information", _
                    "Name", "Mark", Reg_String
'   SetKeyValue HKEY_LOCAL_MACHINE, "Software\MyApp\Information", _
                    "Street Number", 11724, Reg_Number
'###################################################################################
       Dim lRetVal As Long         'result of the SetValueEx function
       Dim hKey As Long         'handle of open key

       'open the specified key

       lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
       lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
       RegCloseKey (hKey)

End Function

Public Function QueryValue(lPredefinedKey As Hive, sKeyName As String, sValueName As String)
'###################################################################################
' Description:
'   This Function will return the data field of a value
'
' Syntax:
'   Variable = QueryValue(Location, KeyName, ValueName)
'
'   Location must equal HKEY_CLASSES_ROOT, HKEY_CURRENT_USER,
'   HKEY_lOCAL_MACHINE, HKEY_USERS
'
'   KeyName is the key that the value is under
'   (example: "Software\Microsoft\Windows\CurrentVersion\Explorer")
'
'   ValueName is the name of the value you want to access (example: "link")
'
'   Examples
'   MsgBox QueryValue(HKEY_LOCAL_MACHINE, "Software\MyApp\Information", "Name")
'   MsgBox QueryValue(HKEY_LOCAL_MACHINE, "Software\MyApp\Information", "Street Number")
'###################################################################################

       Dim lRetVal As Long         'result of the API functions
       Dim hKey As Long         'handle of opened key
       Dim vValue As Variant      'setting of queried value


       lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
       lRetVal = QueryValueEx(hKey, sValueName, vValue)
      
       vValue = Trim(vValue)
       
       If vValue <> "" Then
        If Asc(Right(vValue, 1)) > 127 Then vValue = Left(vValue, Len(vValue) - 1)
       End If
       
       If vValue <> "" Then
        If Asc(Right(vValue, 1)) < 21 Then vValue = Left(vValue, Len(vValue) - 1)
       End If
       
       QueryValue = vValue
       RegCloseKey (hKey)
End Function

Public Function EnumRegKey(lPredefinedKey As Hive, sKeyName As String) As String()
'###################################################################################
' Description:
'   This Function will return an array containing all the sub keys of the specified key.
'
' Syntax:
'   Array = EnumRegKey(Location, KeyName)
'
'   Location must equal HKEY_CLASSES_ROOT, HKEY_CURRENT_USER,
'   HKEY_lOCAL_MACHINE, HKEY_USERS
'
'   KeyName is the key that the value is under
'   (example: "Software\Microsoft\Windows\CurrentVersion\Explorer")
'
'   Usage:
'   Private Sub Command1_Click()
'      Dim RegArray() As String
'      Dim intLoop As Integer
'
'       RegArray = EnumRegKey(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Explorer")
'
'       For intLoop = 0 To UBound(RegArray)
'           Me.Print RegArray(intLoop)
'       Next intLoop
'    End Sub
'###################################################################################
Dim hKey As Long
Dim Cnt As Long
Dim sSave As String
Dim strKeys() As String
    
    '   Open a registry key
    RegOpenKey lPredefinedKey, sKeyName, hKey

    Do
        '   Create a buffer
        sSave = String(255, 0)
        '   Enumerate the keys
        If RegEnumKeyEx(hKey, Cnt, sSave, 255, 0, vbNullString, ByVal 0&, ByVal 0&) <> 0 Then
            Exit Do
        Else
            '   Add the Keys to the array.
            ReDim Preserve strKeys(Cnt)
            strKeys(Cnt) = StripTerminator(sSave)
            Cnt = Cnt + 1
        End If
    Loop

    RegCloseKey hKey
    
    For Cnt = 0 To UBound(strKeys)
        Debug.Print strKeys(Cnt)
    Next Cnt
    
    EnumRegKey = strKeys
End Function

Public Function EnumKeyValues(lPredefinedKey As Hive, sKeyName As String) As String()
'###################################################################################
' Description:
'   This Function will return an array containing all the values of the specified sub key.
'
' Syntax:
'   Array = EnumKeyValues(Location, KeyName)
'
'   Location must equal HKEY_CLASSES_ROOT, HKEY_CURRENT_USER,
'   HKEY_lOCAL_MACHINE, HKEY_USERS
'
'   KeyName is the key that the value is under
'   (example: "Software\Microsoft\Windows\CurrentVersion\Run")
'
'   Usage:
'   Private Sub Command1_Click()
'      Dim RegArray() As String
'      Dim intLoop As Integer
'
'       RegArray = EnumKeyValues(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run")
'
'       For intLoop = 0 To UBound(RegArray)
'           Me.Print RegArray(intLoop)
'       Next intLoop
'    End Sub
'###################################################################################
    Dim hKey As Long
    Dim Cnt As Long
    Dim sSave As String
    Dim strKeys() As String
    
    '   Open the retistry key
    RegOpenKey lPredefinedKey, sKeyName, hKey
    
    Do
        'Create a buffer
        sSave = String(255, 0)
        'enumerate the values
        If RegEnumValue(hKey, Cnt, sSave, 255, 0, ByVal 0&, ByVal 0&, ByVal 0&) <> 0 Then
            Exit Do
        Else
            '   Add the Keys to the array.
            ReDim Preserve strKeys(Cnt)
            strKeys(Cnt) = StripTerminator(sSave)
            Cnt = Cnt + 1
        End If
    Loop
    
    'Close the registry
    RegCloseKey hKey
    
    EnumKeyValues = strKeys
End Function

Private Function StripTerminator(sInput As String) As String
'This function is used to stripoff all the unnecessary chr$(0)'s
    Dim ZeroPos As Integer
    'Search the first chr$(0)
    ZeroPos = InStr(1, sInput, vbNullChar)
    If ZeroPos > 0 Then
        StripTerminator = Left$(sInput, ZeroPos - 1)
    Else
        StripTerminator = sInput
    End If
End Function