Attribute VB_Name = "Registry"
Option Explicit

Public Enum STARTMENUITEM
    DOCUMENTS = 1
    FAVORITES = 2
    RUN = 3
    SHUTDOWN = 4
    LOGOFF = 5
    CONTROLPANEL = 6
    MPRINTERS = 7
    TASKBARSTARTMENU = 8
    FOLDEROPTIONS = 9
    ACTIVEDESKTOP = 10
    WINDOWSUPDATE = 11
    FIND = 12
End Enum

' Registry security attributes
Public Const KEY_SET_VALUE = &H2
Public Const KEY_CREATE_SUB_KEY = &H4
Public Const KEY_ENUMERATE_SUB_KEYS = &H8
Public Const KEY_QUERY_VALUE = &H1
Public Const NO_ERROR = 0
' Constantes
Private Const HKEY_PERFORMANCE_DATA = &H80000004
Private Const READ_CONTROL = &H20000
Private Const KEY_NOTIFY = &H10
Private Const SYNCHRONIZE = &H100000
Private Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Private Const REG_SZ = 1
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const SPECIFIC_RIGHTS_ALL = &HFFFF
Public Const KEY_ALL_ACCESS = &H3F

Public AUTORISE As Boolean

' Types
Private Type Entrée
    valeur As String
    Nom As String
End Type

Private Type SYSTEMTIME
        wYear As Integer
        wMonth As Integer
        wDayOfWeek As Integer
        wDay As Integer
        wHour As Integer
        wMinute As Integer
        wSecond As Integer
        wMilliseconds As Integer
End Type

Private Type TIME_ZONE_INFORMATION
        Bias As Long
        StandardName(32) As Integer
        StandardDate As SYSTEMTIME
        StandardBias As Long
        DayLightName(32) As Integer
        DayLightDate As SYSTEMTIME
        DayLightBias As Long
End Type

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Type Reg
    Clé As String ' (Sans mentionner la clé de base "HKEY_LOCAL_MACHINE" par exemple)
    Date_Modif As Date
End Type
              '
''
' Variables
Private Ent() As Entrée, VL As Boolean, c As String, hh As Long, Pos As Single

' Fonctions d'accès au registre
Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

Public Declare Function RegEnumKeyY 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 RegEnumKeyExY 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 FILETIME) As Long
Public Declare Function RegEnumValueY 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 RegSetValueExY Lib "advapi32" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal szData As String, ByVal cbData As Long) As Long
Public Declare Function RegSetValueY Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Public Declare Function RegOpenKeyY Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegOpenKeyExY 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 RegQueryValueExY 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
Public Declare Function RegQueryValueY Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue As Long) As Long
Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

' Manipulation des types "heure"
Private Declare Function GetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
Private Declare Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long
Private Declare Sub GetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)
Private Declare Sub GetSystemTimeAsFileTime Lib "kernel32" (lpSystemTime As FILETIME)
Private Declare Function SystemTimeToTzSpecificLocalTime Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION, lpUniversalTime As SYSTEMTIME, lpLocalTime As SYSTEMTIME) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long

'
' Written by Dave Scarmozzino  www.TheScarms.com
'
Type SECURITY_ATTRIBUTES
    nLength              As Long
    lpSecurityDescriptor As Long
    bInheritHandle       As Boolean
End Type

Public Const MAX_SIZE = 2048
Public Const MAX_INISIZE = 8192

' Constants for Registry top-level keys
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_DYN_DATA = &H80000006
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_CLASSES_ROOT = &H80000000

' Return values
Public Const ERROR_FILE_NOT_FOUND = 2&
Public Const ERROR_MORE_DATA = 234
Public Const ERROR_NO_MORE_ITEMS = 259&

' RegCreateKeyEx options
Public Const REG_OPTION_NON_VOLATILE = 0

' RegCreateKeyEx Disposition
Public Const REG_CREATED_NEW_KEY = &H1
Public Const REG_OPENED_EXISTING_KEY = &H2

' Registry data types
Public Const REG_NONE = 0
Public Const REG_BINARY = 3
Public Const REG_DWORD = 4

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 Any, lpcbData As Long) As Long

'Declare Function RegDeleteValue Lib "advapi32.dll" _
        Alias "RegDeleteValueA" _
        (ByVal hKey As Long, ByVal lpValueName As String) _
        As Long

'Declare Function RegDeleteKey Lib "advapi32.dll" _
        Alias "RegDeleteKeyA" _
        (ByVal hKey As Long, ByVal lpSubKey As String) 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 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 RegQueryValueEx Lib "advapi32.dll" _
        Alias "RegQueryValueExA" _
        (ByVal hKey As Long, ByVal lpszValueName As String, _
        ByVal lpdwReserved As Long, lpdwType As Long, _
        lpData As Any, lpcbData 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

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

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

Declare Function GetPrivateProfileSection Lib "kernel32" _
        Alias "GetPrivateProfileSectionA" (ByVal lpAppName As String, _
        ByVal lpReturnedString As String, ByVal nSize As Long, ByVal _
        lpFileName As String) As Long
        
Declare Function GetPrivateProfileString Lib "kernel32" _
        Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, _
        ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString _
        As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
        
Declare Function WritePrivateProfileString Lib "kernel32" _
        Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, _
        ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) _
        As Long

Declare Function GetPrivateProfileInt Lib "kernel32" _
        Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, _
        ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName _
        As String) As Long

Public Function fDeleteKey(ByVal sTopKey As String, _
    ByVal sSubKey As String, ByVal sKeyName As String) As Long
'
' Written by Dave Scarmozzino  www.TheScarms.com
'
' Use this function to:
'   -   Delete a registry key.
'
' sTopKey
'   -   A top level registry key abbreviation {"HKCU","HKLM","HKU","HKDD","HKCC","HKCR"}
'
' sSubKey
'   -   A registry subkey.
'
' sKeyName
'   -   The name of the key to delete.
'
' Return Value
'   -   0 if successful, non-zero otherwise.
'
' Example
'   lResult = fDeleteKey("HKCU", "Software\YourKey\...\YourApp", "KeyToDelete")
'   Call fDeleteKey("HKCU", "Software\YourKey\...\YourApp", "KeyToDelete")
'
' NOTE:
'   The key to be deleted cannot be a top-level key
'   and cannot have any sub-keys.
'
Dim lTopKey As Long
Dim lHandle As Long
Dim lResult As Long

On Error GoTo fDeleteKeyError
lResult = 99
lTopKey = fTopKey(sTopKey)
If lTopKey = 0 Then GoTo fDeleteKeyError

lResult = RegOpenKeyEx(lTopKey, sSubKey, 0, KEY_CREATE_SUB_KEY, lHandle)
If lResult = NO_ERROR Then
    lResult = RegDeleteKey(lHandle, sKeyName)
End If

If lResult = NO_ERROR Or lResult = ERROR_FILE_NOT_FOUND Then
    fDeleteKey = NO_ERROR
Else
    fDeleteKey = lResult
End If
Exit Function

fDeleteKeyError:
    fDeleteKey = lResult
End Function

Public Function fDeleteValue(ByVal sTopKeyOrFile As String, _
    ByVal sSubKeyOrSection As String, ByVal sValueName As String) As Long
'
' Written by Dave Scarmozzino  www.TheScarms.com
'
' Use this function to:
'   -   Delete a registry value.
'   -   Delete an .ini file value.
'
' sTopKeyOrIniFile
'   -   A top level registry key abbreviation {"HKCU","HKLM","HKU","HKDD","HKCC","HKCR"} or
'   -   The full path of an .ini file (ex. "C:\Windows\MyFile.ini")
'
' sSubKeyOrSection
'   -   A registry subkey or
'   -   An .ini file section name
'
' sValueName
'   -   A registry entry or
'   -   An .ini file entry
'
' Return Value
'   -   0 if successful, non-zero otherwise.
'
' Example 1   -   Delete a registry value.
'   lResult = fDeleteValue("HKCU", "Software\YourKey\LastKey\YourApp", "EntryToDelete")
'
' Example 2   -   Delete an .ini file value.
'   lResult = fDeleteValue("C:\Windows\Myfile.ini", "SectionName", "EntryToDelete")
'
Dim lTopKey As Long
Dim lHandle As Long
Dim lResult As Long

On Error GoTo fDeleteValueError
lResult = 99
lTopKey = fTopKey(sTopKeyOrFile)
If lTopKey = 0 Then GoTo fDeleteValueError

If lTopKey = 1 Then
    lResult = WritePrivateProfileString(sSubKeyOrSection, sValueName, "", sTopKeyOrFile)
Else
    lResult = RegOpenKeyEx(lTopKey, sSubKeyOrSection, 0, KEY_SET_VALUE, lHandle)
    If lResult = NO_ERROR Then
        lResult = RegDeleteValue(lHandle, sValueName)
    End If
    
    If lResult = NO_ERROR Or lResult = ERROR_FILE_NOT_FOUND Then
        fDeleteValue = NO_ERROR
    Else
        fDeleteValue = lResult
    End If
End If
Exit Function

fDeleteValueError:
    fDeleteValue = lResult
End Function

Public Function fEnumKey(ByVal sTopKey As String, _
    ByVal sSubKey As String, sValues As String) As Long
'
' Written by Dave Scarmozzino  www.TheScarms.com
'
' Use this function to:
'   -   Enumerate the subkeys of a registry key.
'
' sTopKey
'   -   A top level registry key abbreviation {"HKCU","HKLM","HKU","HKDD","HKCC","HKCR"}
'
' sSubKey
'   -   A registry subkey
'
' sValues
'   -   A returned string of the form:
'           SubKeyName|SubKeyName|.... SubKeyName||
'
'           Where - "|" equals vbNullChar (chr(0)).
'
' Return Value
'   -   0 if successful, non-zero otherwise.
'
' Example 1
'   lResult = fEnumKey("HKLM", "Software\Microsoft", sValues)
'
Dim bDone    As Boolean
Dim lTopKey  As Long
Dim lHandle  As Long
Dim lResult  As Long
Dim lIndex   As Long
Dim sKeyName As String

On Error GoTo fEnumKeyError
lResult = 99
lTopKey = fTopKey(sTopKey)
If lTopKey = 0 Then GoTo fEnumKeyError
'
' Open the registry SubKey.
'
lResult = RegOpenKeyEx(lTopKey, sSubKey, 0, KEY_ENUMERATE_SUB_KEYS, lHandle)
If lResult <> NO_ERROR Then GoTo fEnumKeyError
'
' Get all subkeys until ERROR_NO_MORE_ITEMS or an error occurs.
'
Do While Not bDone
    sKeyName = Space$(MAX_SIZE)
    lResult = RegEnumKey(lHandle, lIndex, sKeyName, MAX_SIZE)
    
    If lResult = NO_ERROR Then
        sValues = sValues & Trim$(sKeyName)
        lIndex = lIndex + 1
    Else
        bDone = True
    End If
Loop
sValues = sValues & vbNullChar
If Len(sValues) = 1 Then sValues = sValues & vbNullChar
'
' Close the key.
'
fEnumKey = RegCloseKey(lHandle)
Exit Function
'
' Error processing.
'
fEnumKeyError:
    fEnumKey = lResult
End Function
Public Function fEnumValue(ByVal sTopKeyOrIniFile As String, _
    ByVal sSubKeyOrSection As String, sValues As String) As Long
'
' Written by Dave Scarmozzino  www.TheScarms.com
'
' Use this function to:
'   -   Enumerate the values of a registry key or
'   -   Enumerate all entries in a particular section of an .ini file.
'
' sTopKeyOrIniFile
'   -   A top level registry key abbreviation {"HKCU","HKLM","HKU","HKDD","HKCC","HKCR"} or
'   -   The full path of an .ini file (ex. "C:\Windows\MyFile.ini")
'
' sSubKeyOrSection
'   -   A registry subkey or
'   -   An .ini file section name
'
' sValues
'   -   A returned string of the form:
'           EntryName=Value|EntryName=Value|.... EntryName=Value||
'
'           Where - Value can be a string or binary value.
'           and   - "|" equals vbNullChar (chr(0)).
'
' Return Value
'   -   0 if successful, non-zero otherwise.
'
' Example 1
'   lResult = fEnumValue("HKCU", "Software\YourKey\LastKey\YourApp", sValues)
'
' Example 2
'   lResult = fEnumValue("C:\Windows\Myfile.ini", "SectionName", sValues)
'
' NOTE:
'   When enumerating registry values, only string, dword and binary values
'   with a length under 2 bytes (which allows for true/false values) are returned.
'
Dim lTopKey    As Long
Dim lHandle    As Long
Dim lResult    As Long
Dim lValueLen  As Long
Dim lIndex     As Long
Dim lValue     As Long
Dim lValueType As Long
Dim lData      As Long
Dim lDataLen   As Long
Dim bDone      As Boolean
Dim sValueName As String
Dim sValue     As String

On Error GoTo fEnumValueError
lResult = 99
lTopKey = fTopKey(sTopKeyOrIniFile)
If lTopKey = 0 Then GoTo fEnumValueError

If lTopKey = 1 Then
    '
    ' Enumerate an .ini file section.
    '
    sValues = Space$(MAX_INISIZE)
    lResult = GetPrivateProfileSection(sSubKeyOrSection, sValues, Len(sValues), sTopKeyOrIniFile)
Else
    '
    ' Open the registry SubKey.
    '
    lResult = RegOpenKeyEx(lTopKey, sSubKeyOrSection, 0, KEY_QUERY_VALUE, lHandle)
    If lResult <> NO_ERROR Then GoTo fEnumValueError
    '
    ' Get all values until ERROR_NO_MORE_ITEMS or an error occurs.
    '
    Do While Not bDone
        lDataLen = MAX_SIZE
        lValueLen = lDataLen
        sValueName = Space$(lDataLen)
        
        lResult = RegEnumValue(lHandle, lIndex, sValueName, lValueLen, 0, lValueType, ByVal lData, lDataLen)
        If lResult = NO_ERROR Then
            Select Case lValueType
                Case REG_SZ
                    sValue = Space$(lDataLen)
                    sValueName = Left$(sValueName, lValueLen)
                    lResult = RegQueryValueEx(lHandle, sValueName, 0, REG_SZ, ByVal sValue, lDataLen)
                    If lResult = NO_ERROR Then
                        sValues = sValues & sValueName & "=" & sValue
                    Else
                        GoTo fEnumValueError
                    End If
                Case REG_DWORD
                    lResult = RegQueryValueEx(lHandle, sValueName, 0, REG_NONE, lValue, lDataLen)
                    If lResult = NO_ERROR Then
                        sValueName = Left$(sValueName, lValueLen)
                        sValues = sValues & sValueName & "=" & lValue & vbNullChar
                    Else
                        GoTo fEnumValueError
                    End If
                Case REG_BINARY
                    If lDataLen <= 2 Then
                        lResult = RegQueryValueEx(lHandle, sValueName, 0, REG_NONE, lValue, lDataLen)
                        If lResult = NO_ERROR Then
                            sValueName = Left$(sValueName, lValueLen)
                            sValues = sValues & sValueName & "=" & lValue & vbNullChar
                        Else
                            GoTo fEnumValueError
                        End If
                    End If
                Case Else
            End Select
            lIndex = lIndex + 1
        Else
            bDone = True
        End If
    Loop
    sValues = sValues & vbNullChar
    If Len(sValues) = 1 Then sValues = sValues & vbNullChar
    '
    ' Close the key.
    '
    lResult = RegCloseKey(lHandle)
    fEnumValue = lResult
End If
Exit Function
'
' Error processing.
'
fEnumValueError:
    fEnumValue = lResult
End Function






Public Function fReadIniFuzzy(ByVal sIniFile As String, _
    sSection As String, ByVal sIniEntry As String, _
    ByVal sDefault As String, sValue As String) As Long
'
' Written by Dave Scarmozzino  www.TheScarms.com
'
' Use this function to:
'   -   Read a string value from an .ini file when you do not know the exact
'       name of the section the value is in.
'
' sIniFile
'   -   The full path of an .ini file (ex. "C:\Windows\MyFile.ini")
'
' sSection
'   -   Any complete part of the .ini file section name.
'       Ex:   [ABC DEF GHI JKL]
'       sSection Name can be "ABC" or "DEF" or "GHI" or "JKL" but not
'       a partial value such as "AB" or "HI".
'
'       NOTE: if sSection is passed as a variable and not as the actual
'             string value, sSection will be populated with the
'             complete section name.
'
' sEntry
'   -   An .ini file entry
'
' sDefault
'   -   The default value to return.
'
' sValue
'   -   The string value read.
'   -   sDefault if unsuccessful.
'
' Return Value
'   -   0 if sEntry was found, non-zero otherwise.
'
' Example 1   -   Read a string value from an .ini file.
'       Ex:   [ABC DEF GHI JKL]
'             AppName="My App"
'
'   sEntry = "AppName"
'   lResult = fReadIniFuzzy("C:\Windows\Myfile.ini", "DEF", sEntry, sValue)
'
'   Upon completion:
'       lResult  = 0
'       sSection = "ABC DEF GHI JKL"
'       sValue   = "My App"
'
Dim sNextChar    As String
Dim sLine        As String
Dim sEntry       As String
Dim sSectionName As String
Dim iLen         As Integer
Dim iLocOfEq     As Integer
Dim iFnum        As Integer
Dim bDone        As Boolean
Dim bFound       As Boolean
Dim bNewSection  As Boolean

On Error GoTo fReadIniFuzzyError
fReadIniFuzzy = 99
bDone = False
sValue = sDefault
sEntry = UCase$(sIniEntry)
sSection = UCase$(sSection)
iLen = Len(sSection)

iFnum = FreeFile
Open sIniFile For Input Access Read As iFnum

Line Input #iFnum, sLine
Do While Not EOF(iFnum) And Not bDone
    sLine = UCase$(Trim$(sLine))
    bNewSection = False
    '
    ' See if line is a section heading.
    '
    If Left$(sLine, 1) = "[" Then
        '
        ' See if section heading contains desired value.
        '
        sSectionName = sLine
        Dim iPos As Integer
        iPos = InStr(1, sLine, sSection)
        If iPos > 0 Then
            '
            ' Be sure the value is not part of a larger value.
            '
            sNextChar = Mid$(sLine, iPos + iLen, 1)
            If sNextChar = " " Or sNextChar = "]" Then
                '
                ' Search this section for the entry.
                '
                Line Input #iFnum, sLine
                bFound = False
                bNewSection = False
                Do While Not EOF(iFnum) And Not bFound
                    '
                    ' If we hit a new section, stop.
                    '
                    sLine = UCase$(Trim$(sLine))
                    If Left$(sLine, 1) = "[" Then
                        bNewSection = True
                        Exit Do
                    End If
                    '
                    ' Entry must start in column 1 to avoid comment lines.
                    '
                    If InStr(1, sLine, sEntry) = 1 Then
                        '
                        ' If entry found and line is not incomplete, get value.
                        '
                        iLocOfEq = InStr(1, sLine, "=")
                        If iLocOfEq <> 0 Then
                            sValue = Mid$(sLine, iLocOfEq + 1)
                            sSection = Mid$(sSectionName, 2, InStr(1, sSectionName, "]") - 2)
                            bFound = True
                            bDone = True
                            fReadIniFuzzy = 0
                        End If
                    End If
                    If Not bFound Then
                        Line Input #iFnum, sLine
                    End If
                Loop
                If EOF(iFnum) Then bDone = True
                sSection = Mid$(sSectionName, 2, InStr(1, sSectionName, "]") - 2)
            End If
        End If
    End If
    If Not bNewSection And Not bDone Then
        Line Input #iFnum, sLine
    End If
Loop
Close iFnum
Exit Function

fReadIniFuzzyError:
    fReadIniFuzzy = 99
End Function
Public Function fReadValue(ByVal sTopKeyOrFile As String, _
    ByVal sSubKeyOrSection As String, ByVal sValueName As String, _
    ByVal sValueType As String, ByVal vDefault As Variant, _
    vValue As Variant) As Long
'
' Written by Dave Scarmozzino  www.TheScarms.com
'
' Use this function to read a:
'   -   String, 16-bit binary (True|False), 32-bit integer registry value or
'   -   String or integer value from an .ini file.
'
' sTopKeyOrIniFile
'   -   A top level registry key abbreviation {"HKCU","HKLM","HKU","HKDD","HKCC","HKCR"} or
'   -   The full path of an .ini file (ex. "C:\Windows\MyFile.ini")
'
' sSubKeyOrSection
'   -   A registry subkey or
'   -   An .ini file section name
'
' sValueName
'   -   A registry entry or
'   -   An .ini file entry
'
' sValueType
'   -   "S" to read a string value or
'   -   "B" to read a 16-bit binary value (applies to registry use only) or
'   -   "D" to read a 32-bit number value (applies to registry use only).
'
' vDefault
'   -   The default value to return. It can be a string or boolean.
'
' vValue
'   -   The value read. It can be a string or boolean.
'   -   vDefault if unsuccessful (0 when reading an integer from an .ini file)
'
' Return Value
'   -   0 if successful, non-zero otherwise.
'
' Example 1   -   Read a string value from the registry.
'   lResult = fReadValue("HKCU", "Software\YourKey\LastKey\YourApp", "AppName", "S", "", sValue)
'
' Example 2   -   Read a boolean (True|False) value from the registry.
'   lResult = fReadValue("HKCU", "Software\YourKey\LastKey\YourApp", "AutoHide", "B", False, bValue)
'
' Example 3   -   Read an integer value from the registry.
'   lResult = fReadValue("C:\Windows\Myfile.ini", "SectionName", "NumApps", "D", 12345, lValue)
'
' Example 4   -   Read a string value from an .ini file.
'   lResult = fReadValue("C:\Windows\Myfile.ini", "SectionName", "AppName", "S", "", sValue)
'
' Example 5   -   Read an integer value from an .ini file.
'   lResult = fReadValue("C:\Windows\Myfile.ini", "SectionName", "NumApps", "B", "0", iValue)
'
Dim lTopKey     As Long
Dim lHandle     As Long
Dim lLenData    As Long
Dim lResult     As Long
Dim lDefault    As Long
Dim lValue      As Long
Dim sValue      As String
Dim sSubKeyPath As String
Dim sDefaultStr As String
Dim bValue      As Boolean

On Error GoTo fReadValueError
lResult = 99
vValue = vDefault
lTopKey = fTopKey(sTopKeyOrFile)
If lTopKey = 0 Then GoTo fReadValueError

If lTopKey = 1 Then
    '
    ' Read the .ini file value.
    '
    If UCase$(sValueType) = "S" Then
        lLenData = 255
        sDefaultStr = vDefault
        sValue = Space$(lLenData)
        lResult = GetPrivateProfileString(sSubKeyOrSection, sValueName, sDefaultStr, sValue, lLenData, sTopKeyOrFile)
        vValue = Left$(sValue, lResult)
    Else
        lDefault = 0
        lResult = GetPrivateProfileInt(sSubKeyOrSection, sValueName, lDefault, sTopKeyOrFile)
    End If
Else
    '
    ' Open the registry SubKey.
    '
    lResult = RegOpenKeyEx(lTopKey, sSubKeyOrSection, 0, KEY_QUERY_VALUE, lHandle)
    If lResult <> NO_ERROR Then
        fReadValue = lResult
        Exit Function
    End If
    '
    ' Get the actual value.
    '
    Select Case UCase$(sValueType)
        Case "S"
            '
            ' String value. The first query gets the string length. The second
            ' gets the string value.
            '
            lResult = RegQueryValueEx(lHandle, sValueName, 0, REG_SZ, "", lLenData)
            If lResult = ERROR_MORE_DATA Then
                sValue = Space(lLenData)
                lResult = RegQueryValueEx(lHandle, sValueName, 0, REG_SZ, ByVal sValue, lLenData)
            End If
            If lResult = NO_ERROR Then  'Remove null character.
                vValue = Left$(sValue, lLenData - 1)
            Else
                GoTo fReadValueError
            End If
        Case "B"
            lLenData = Len(bValue)
            lResult = RegQueryValueEx(lHandle, sValueName, 0, REG_BINARY, bValue, lLenData)
            If lResult = NO_ERROR Then
                vValue = bValue
            Else
                GoTo fReadValueError
            End If
        Case "D"
            lLenData = 32
            lResult = RegQueryValueEx(lHandle, sValueName, 0, REG_DWORD, lValue, lLenData)
            If lResult = NO_ERROR Then
                vValue = lValue
            Else
                GoTo fReadValueError
            End If
    End Select
    '
    ' Close the key.
    '
    lResult = RegCloseKey(lHandle)
    fReadValue = lResult
End If
Exit Function
'
' Error processing.
'
fReadValueError:
    fReadValue = lResult
End Function


Private Function fTopKey(ByVal sTopKeyOrFile As String) As Long
Dim sDir   As String
'
' Written by Dave Scarmozzino  www.TheScarms.com
'
' This function returns:
'   -   the numeric value of a top level registry key or
'   -   1 if sTopKey is a valid .ini file or
'   -   0 otherwise.
'
On Error GoTo fTopKeyError
fTopKey = 0
Select Case UCase$(sTopKeyOrFile)
    Case "HKCU"
        fTopKey = HKEY_CURRENT_USER
    Case "HKLM"
        fTopKey = HKEY_LOCAL_MACHINE
    Case "HKU"
        fTopKey = HKEY_USERS
    Case "HKDD"
        fTopKey = HKEY_DYN_DATA
    Case "HKCC"
        fTopKey = HKEY_CURRENT_CONFIG
    Case "HKCR"
        fTopKey = HKEY_CLASSES_ROOT
    Case Else
        On Error Resume Next
        sDir = Dir$(sTopKeyOrFile)
        If Err.Number = 0 And sDir <> "" Then fTopKey = 1
End Select
Exit Function

fTopKeyError:
End Function

Public Function fWriteValue(ByVal sTopKeyOrFile As String, _
    ByVal sSubKeyOrSection As String, ByVal sValueName As String, _
    ByVal sValueType As String, ByVal vValue As Variant) As Long
'
' Written by Dave Scarmozzino  www.TheScarms.com
'
' Use this function to write a:
'   -   String, 16-bit binary (True|False), 32-bit integer registry value or
'   -   String value to an .ini file.
'
' sTopKeyOrIniFile
'   -   A top level registry key abbreviation {"HKCU","HKLM","HKU","HKDD","HKCC","HKCR"} or
'   -   The full path of an .ini file (ex. "C:\Windows\MyFile.ini")
'
' sSubKeyOrSection
'   -   A registry subkey or
'   -   An .ini file section name
'
' sValueName
'   -   A registry entry or
'   -   An .ini file entry
'
' sValueType
'   -   "S" to write a string value or
'   -   "B" to write a 16-bit binary value (applies to registry use only) or
'   -   "D" to write a 32-bit number value (applies to registry use only).
'
' vValue
'   -   The value to write. It can be a string, binary or integer.
'
' Return Value
'   -   0 if successful, non-zero otherwise.
'
' Example 1   -   Write a string value to the registry.
'   lResult = fWriteValue("HKCU", "Software\YourKey\LastKey\YourApp", "AppName", "S", "MyApp")
'
' Example 2   -   Write a True|False value to the registry.
'   lResult = fWriteValue("HKCU", "Software\YourKey\LastKey\YourApp", "AutoHide", "B", True)
'
' Example 3   -   Write an integer value to the registry.
'   lResult = fWriteValue("HKCU", "Software\YourKey\LastKey\YourApp", "NumOfxxx", "D", 12345)
'
' Example 4   -   Write a string value to an .ini file.
'   lResult = fWriteValue("C:\Windows\Myfile.ini", "SectionName", "AppName", "S", "MyApp")
'
' NOTE:
'   This function cannot write a non-string value to an .ini file.
'
Dim hKey                As Long
Dim lTopKey             As Long
Dim lOptions            As Long
Dim lsamDesired         As Long
Dim lHandle             As Long
Dim lDisposition        As Long
Dim lLenData            As Long
Dim lResult             As Long
Dim lValue              As Long
Dim sClass              As String
Dim sValue              As String
Dim sSubKeyPath         As String
Dim bValue              As Boolean
Dim tSecurityAttributes As SECURITY_ATTRIBUTES

On Error GoTo fWriteValueError
lResult = 99
lTopKey = fTopKey(sTopKeyOrFile)
If lTopKey = 0 Then GoTo fWriteValueError

If lTopKey = 1 Then
    '
    ' Read the .ini file value.
    '
    If UCase$(sValueType) = "S" Then
        sValue = vValue
        lResult = WritePrivateProfileString(sSubKeyOrSection, sValueName, sValue, sTopKeyOrFile)
    Else
        GoTo fWriteValueError
    End If
Else
    sClass = ""
    lOptions = REG_OPTION_NON_VOLATILE
    lsamDesired = KEY_CREATE_SUB_KEY Or KEY_SET_VALUE
    '
    ' Create the SubKey or open it if it exists. Return its handle.
    ' lDisposition will be REG_CREATED_NEW_KEY if the key did not exist.
    '
    lResult = RegCreateKeyEx(lTopKey, sSubKeyOrSection, 0, sClass, lOptions, _
                  lsamDesired, tSecurityAttributes, lHandle, lDisposition)
    If lResult <> NO_ERROR Then GoTo fWriteValueError
    '
    ' Set the actual value.
    '
    Select Case UCase$(sValueType)
        Case "S"
            sValue = vValue
'02/05/2002            lLenData = Len(sValue) + 1
            lLenData = Len(sValue)
            lResult = RegSetValueEx(lHandle, sValueName, 0, REG_SZ, ByVal sValue, lLenData)
        Case "B"
            bValue = vValue
            lLenData = Len(bValue)
            lResult = RegSetValueEx(lHandle, sValueName, 0, REG_BINARY, bValue, lLenData)
        Case "D"
            lValue = CInt(vValue)
            lLenData = 4
            lResult = RegSetValueEx(lHandle, sValueName, 0, REG_DWORD, lValue, lLenData)
    End Select
    '
    ' Close the key.
    '
    If lResult = NO_ERROR Then
        lResult = RegCloseKey(lHandle)
        fWriteValue = lResult
        Exit Function
    End If
End If
Exit Function
'
' Error processing.
'
fWriteValueError:
    fWriteValue = lResult
End Function

Public Function mSaveSettings(ByVal eSubkeys As String, ByVal eKeyName As String, ByVal eDataType As String, ByVal eValue As String) As Long
    mSaveSettings = 1
    If eDataType = "D" Then
        On Error GoTo errhandler
        fWriteValue "HKCU", "Software\Monier\Hanoï\" & eSubkeys, eKeyName, eDataType, Val(eValue)
    Else
        On Error GoTo errhandler
        fWriteValue "HKCU", "Software\Monier\Hanoï\" & eSubkeys, eKeyName, eDataType, eValue
    End If
    Exit Function
errhandler:
    mSaveSettings = 0
    Exit Function
End Function

Public Function mGetSettings(ByVal eSubkeys As String, ByVal eKeyName As String, ByVal eDataType As String, ByVal eDefault As String) As String
    Dim TempGot As String
    mGetSettings = eDefault
    On Error GoTo errhandler
    fReadValue "HKCU", "Software\Monier\Hanoï\" & eSubkeys, eKeyName, eDataType, eDefault, TempGot
    mGetSettings = TempGot
    Exit Function
errhandler:
    mGetSettings = eDefault
    Exit Function
End Function

Public Function mDeleteSettings(ByVal eSubkeys As String, ByVal eKeyName As String) As Long

End Function

Public Function RemoveStartMenu(mMenuItem As STARTMENUITEM, Choice As Long)
    Dim ActualSetting As String
    Select Case mMenuItem
        Case DOCUMENTS
            ActualSetting = "NoRecentDocsMenu"
        Case FAVORITES
            ActualSetting = "NoFavoritesMenu"
        Case RUN
            ActualSetting = "NoRun"
        Case SHUTDOWN
            ActualSetting = "NoClose"
        Case LOGOFF
            ActualSetting = "NoLogOff"
        Case CONTROLPANEL, MPRINTERS
            ActualSetting = "NoSetFolders"
        Case TASKBARSTARTMENU
            ActualSetting = "NoSetTaskBar"
        Case FOLDEROPTIONS
            ActualSetting = "NoFolderOptions"
        Case ACTIVEDESKTOP
            ActualSetting = "NoSetActiveDesktop"
        Case WINDOWSUPDATE
            ActualSetting = "NoWindowsUpdate"
        Case FIND
            ActualSetting = "NoFind"
    End Select
    fWriteValue "HKCU", "Software\Microsoft\Windows\CurrentVersion\Policies\Explorer", ActualSetting, "D", Choice
End Function

Public Function IsConnectingToInternet() As Long
    Dim ActualSettings As Long
    fReadValue "HKLM", "System\CurrentControlSet\Services\RemoteAccess", "Remote Connection", "D", 0, ActualSettings
    IsConnectingToInternet = ActualSettings
End Function
