'Copyright 2003 Adam Caudill. Email: adam@adamcaudill.com
'Read me:
'           You are free use this code in your application without cost.
'           All that is required is this:
'               1) An email letting me know you are using this code, the
'                  email can be sent to: adam@adamcaudill.com
'               2) Somewhere on your website, or in a about box, or 'read me'
'                  type file you should include a link to my site.
'                  https://adamcaudill.com
'
' You may not reproduce or publish this file online without prior permission from
' from Adam Caudill. In most cases I will grant permission so long as this notice
' remains intact. You must not removed this notice.

Option Explicit

Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" ( _
    ByVal hKey As Long, _
    ByVal lpSubKey As String, _
    phkResult 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 RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" ( _
    ByVal hKey As Long, _
    ByVal lpSubKey As String, _
    phkResult As Long _
) As Long

Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" ( _
    ByVal hKey As Long, _
    ByVal lpValueName As String, _
    ByVal Reserved As Long, _
    ByVal dwType As Long, _
    lpData As Any, _
    ByVal cbData As Long _
) As Long

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

Private Const REG_SZ = 1                            'This tells the API that we are dealing with strings only.
                                                    '(Unicode, null terminated strings to be exact)

Private Const ERROR_SUCCESS = 0&                    'Even though it says 'error', this actually means it worked.

Private Const HKEY_CURRENT_USER = &H80000001        'Lets only save data for the current user, nobody else needs to see it.

Public Sub SaveSetting(ByVal strAppName As String, ByVal strSection As String, ByVal strKey As String, ByVal strValue As String)
'strAppName Required.             String expression containing the name of the application or project to which the setting applies.
'strSection Required.             String expression containing the name of the section where the key setting is being saved.
'strKey Required.                 String expression containing the name of the key setting being saved.
'strValue Required.               Expression containing the value that key is being set to.

Dim lngResult As Long
Dim lngKeyHandle As Long

    lngResult = RegCreateKey(HKEY_CURRENT_USER, "Software\" & strAppName & "\" & strSection, lngKeyHandle)
        'This will attempt to make a new key, this way we know the key exists when we go to save the data. We
        'don't really care about the return value of this one, so we wont even check it since it will fail
        'if the key we are saving to already exists (not a problem at all). The lngKeyHandle is passed ByRef
        'so that the call can modify it's value, it will hold the handle (an address of sorts) to this
        'specific key.
    lngResult = RegSetValueEx(lngKeyHandle, strKey, 0, REG_SZ, ByVal strValue, Len(strValue))
        'This is where the real magic happens, actually saving this precious chunk of data. The first
        'parameter above is the lngKeyHandle we talked about before, this tells the API just where this data
        'should be saved. The next, strKey, is the name of the actual key itself, it is this item that the
        'value will be stored with. The next item (the 0) is reserved for future use (it doesn't do anything
        'right now) so we'll always pass a 0 (zero, not the letter) to it. REG_SZ just tells it we are sending
        'it a string. "ByVal strValue" sends the string we are saving. Finally, Len(strValue) it the length of
        'the string we want to save.
    lngResult = RegCloseKey(lngKeyHandle)
        'Now that all the work is done, all we do is close the handle. This tells Windows that we are done with
        'this key (for now at least).
End Sub

Public Function GetSetting(ByVal strAppName As String, ByVal strSection As String, ByVal strKey As String, Optional ByVal strDefault As String = "") As String
'strAppName Required.           String expression containing the name of the application or project whose key setting is requested.
'strSection Required.           String expression containing the name of the section where the key setting is found.
'strKey Required.               String expression containing the name of the key setting to return.
'strDefault Optional.           Expression containing the value to return if no value is set in the key setting. If omitted, default is assumed to be a zero-length string ("").

Dim lngResult As Long
Dim lngKeyHandle As Long
Dim lngValueType As Long
Dim lngBufferSize As Long
Dim strBuffer As String

    lngResult = RegOpenKey(HKEY_CURRENT_USER, "Software\" & strAppName & "\" & strSection, lngKeyHandle)
        'This opens the key we want, when the function returns lngKeyHandle will hold the handle to this key.
        'We are using this in a similar way as the call to "RegCreateKey" in the "SaveSetting" function.
    lngResult = RegQueryValueEx(lngKeyHandle, strKey, 0&, lngValueType, ByVal 0&, lngBufferSize)
        'We will use this to get some information about the data we are looking for.
        'lngKeyHandle - This is the handle to the key we just opened with RegOpenKey.
        'strKey - This is the name of the value we are after.
        '0& - This is a reserved value that does nothing now, so we have to pass it a 0 (zero).
        'lngValueType - This will contain the type of data the API returns, since we are only interested
        '               in strings, we'll check this later to see if it is "REG_SZ", which is in registry
        '               terms means that it's a null (Chr(0)) terminated unicode string.
        'ByVal 0& - Since we aren't actually returning the value, we'll just pass 0 so it wont do anything.
        'lngBufferSize - This will return the size of the data that we are about to get.
    If lngValueType = REG_SZ Then
        'This makes sure it's a string we're dealing with, we wont be touching any other data types here.
        strBuffer = String(lngBufferSize, " ")
            'This fills in the buffer with spaces.
        lngResult = RegQueryValueEx(lngKeyHandle, strKey, 0&, 0&, ByVal strBuffer, lngBufferSize)
            'Here is where we actually get the data from the registry, strBuffer will contain the data
            'when the call returns.
        If lngResult = ERROR_SUCCESS Then
            'If the call worked, lngResult will be equal to ERROR_SUCCESS.
            If (InStr(strBuffer, Chr$(0))) > 0 Then
                'Lets see if there are any nulls at the end of the string
                GetSetting = Left(strBuffer, (InStr(strBuffer, Chr$(0))) - 1)
                    'If there are any nulls at the end, lets chop them off and return the rest.
            Else
                GetSetting = strBuffer
                    'Since there aren't any nulls, lets just return the whole thing.
            End If
        End If
    Else
        'If we've gotten here, that means we didn't find what we're after.
        Err.Raise 13
            'Although I would have don't it differently, the runtime raises error 13 (type mis-match) if
            'the key doesn't exist, so our GetSetting will now show the same behavior
    End If
End Function