Attribute VB_Name = "modRegistry"
Option Explicit

'=======================================================================================
' Module Name : modRegistry
' Contents    : API definitions and wrapper functions for accessing the Windows registry
' Comments    : This code borrowed heavily from the Windows API Guide, http://www.vbapi.com/, originally by
'                 Paul Kuliniewicz, now maintained by Chris Pietschmann.  Modified here to fit my own style
'                 and to provide compatibility with internal VB functions.  SDG, 7/17/2002
' Properties  :
' Methods     :
' Enums       :
' Created By  : Seth D. Galitzer
' Created     : 7/16/2002
' Modified    : 7/25/2002, 8/15/2002, 2/15/2003
'=======================================================================================

Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_CONFIG = &H80000005
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_DYN_DATA = &H80000006
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_PERFORMANCE_DATA = &H80000004
Const HKEY_USERS = &H80000003
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_DWORD_BIG_ENDIAN = 5
Const REG_DWORD_LITTLE_ENDIAN = 4
Const REG_EXPAND_SZ = 2
Const REG_LINK = 6
Const REG_MULTI_SZ = 7
Const REG_NONE = 0
Const REG_RESOURCE_LIST = 8
Const REG_SZ = 1
Const KEY_ALL_ACCESS = &HF003F
Const KEY_CREATE_LINK = &H20
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_EXECUTE = &H20019
Const KEY_NOTIFY = &H10
Const KEY_QUERY_VALUE = &H1
Const KEY_READ = &H20019
Const KEY_SET_VALUE = &H2
Const KEY_WRITE = &H20006

Type SECURITY_ATTRIBUTES
  nLength As Long
  lpSecurityDescriptor As Long
  bInheritHandle As Boolean
End Type

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 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

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, lpSecurityAttributes As SECURITY_ATTRIBUTES, _
    phkResult As Long, lpdwDisposition As Long) As Long

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

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

'.Comments  : Replacement for built-in GetSetting function
'               instead of HKCU\Software\VB and VBA Program Settings.  Makes it more like a "real" application
'.Parameters: AppName - parent key under HKLM\Software
'             Section - sub-key under AppName in which the values reside
'             Key - value you want to retrieve
'             Default - what to return if the requested key/value does not exist
'             RootHive - the major portion of the registry we want to read from; HKLM by default
'             BaseKey - the parent key from under which we want to read our keys/values; "Software" by default
'.Sets      :
'.Returns   :
'.Created by: Seth D. Galitzer
'.Created   :
'.Modified  : 8/15/2002, 2/13/2003
Public Function basGetSetting(AppName As String, Section As String, Key As String, Optional Default As String = "", Optional RootHive As Long = HKEY_LOCAL_MACHINE, Optional BaseKey As String = "Software") As String
    Dim hKey As Long  ' receives a handle to the newly created or opened registry key
    Dim strSubKey As String
    Dim strBuffer As String  ' receives data read from the registry
    Dim lngStrLen As Long  ' receives length of returned data
    Dim lngRet As Long  ' return value
On Error GoTo Err_basGetSetting


    strSubKey = BaseKey & "\" & AppName & "\" & Section
    strBuffer = Space(255)
    lngStrLen = 255

    lngRet = RegOpenKeyEx(RootHive, strSubKey, 0, KEY_READ, hKey)
    If lngRet <> 0 Then
        strBuffer = Default
        GoTo Exit_basGetSetting
    End If

    lngRet = RegQueryValueEx(hKey, Key, 0, 0&, ByVal strBuffer, lngStrLen)
    If lngRet <> 0 Then
        strBuffer = Default
    Else
        strBuffer = Left(strBuffer, lngStrLen - 1)
    End If

Exit_basGetSetting:
    lngRet = RegCloseKey(hKey)
    basGetSetting = strBuffer
Exit Function
Err_basGetSetting:
    Select Case Err
        Case 0
            Resume Next
        Case Else
            Beep
            Dim intResult As Integer
            If boolLog Then basLogIt Err.Number & ": " & Err.Description, "basGetSetting"
            intResult = MsgBox("Error Line: " & Erl & vbTab & "Error Number: " & Err.Number & vbCrLf & _
                    "Error Description: " & Err.Description & vbCrLf & "in basGetSetting in modRegistry", _
                vbAbortRetryIgnore)
            If bolInDevelopment = True Then Stop
            Select Case intResult
                Case vbAbort
                    Resume Exit_basGetSetting
                Case vbRetry
                    Resume 0
                Case vbIgnore
                    Resume Next
                Case Else
            End Select
    End Select
    Resume 0

End Function

'.Comments  : Replacement for built-in SaveSetting function
'               instead of HKCU\Software\VB and VBA Program Settings.  Makes it more like a "real" application
'.Parameters: AppName - parent key under HKLM\Software
'             Section - sub-key under AppName in which the values reside
'             Key - name of value you want to set
'             Setting - the actual value to be set
'             RootHive - the major portion of the registry we want to read from; HKLM by default
'             BaseKey - the parent key from under which we want to read our keys/values; "Software" by default
'.Sets      :
'.Returns   :
'.Created by: Seth D. Galitzer
'.Created   :
'.Modified  : 8/15/2002, 2/13/2003
Public Function basSaveSetting(AppName As String, Section As String, Key As String, ByVal Setting As String, Optional RootHive As Long = HKEY_LOCAL_MACHINE, Optional BaseKey As String = "Software")
    Dim hKey As Long  ' receives handle to the newly created or opened registry key
    Dim typSecAttr As SECURITY_ATTRIBUTES  ' security settings of the key
    Dim strSubKey As String
    Dim strBuffer As String  ' the string to put into the registry
    Dim lngRet As Long  ' return value
On Error GoTo Err_basSaveSetting


    strSubKey = BaseKey & "\" & AppName & "\" & Section
    typSecAttr.nLength = Len(typSecAttr)  ' size of the structure
    typSecAttr.lpSecurityDescriptor = 0  ' default security level
    typSecAttr.bInheritHandle = True  ' the default value for this setting

    lngRet = RegCreateKeyEx(RootHive, strSubKey, 0, "", 0, KEY_WRITE, typSecAttr, hKey, 0&)
    If lngRet <> 0 Then  ' error during open
        MsgBox "Error opening or creating registry key -- aborting."
        GoTo Exit_basSaveSetting
    End If

    strBuffer = Setting & vbNullChar  ' note how a null character must be appended to the string
    lngRet = RegSetValueEx(hKey, Key, 0, REG_SZ, ByVal strBuffer, Len(strBuffer)) ' write the string

Exit_basSaveSetting:
    lngRet = RegCloseKey(hKey)
    Exit Function
Exit Function
Err_basSaveSetting:
    Select Case Err
        Case 0
            Resume Next
        Case Else
            Beep
            Dim intResult As Integer
            If boolLog Then basLogIt Err.Number & ": " & Err.Description, "basSaveSetting"
            intResult = MsgBox("Error Line: " & Erl & vbTab & "Error Number: " & Err.Number & vbCrLf & _
                    "Error Description: " & Err.Description & vbCrLf & "in basSaveSetting in modRegistry", _
                vbAbortRetryIgnore)
            If bolInDevelopment = True Then Stop
            Select Case intResult
                Case vbAbort
                    Resume Exit_basSaveSetting
                Case vbRetry
                    Resume 0
                Case vbIgnore
                    Resume Next
                Case Else
            End Select
    End Select
    Resume 0

End Function