registry.bas

多种图表的绘制及其运用

Attribute VB_Name = "Registry"
' =========================================================
'  === Project of Data-flow Visual Programming Language ===
' =========================================================
' Copyright Emu8086, Inc. Free Code !
'
'
' URL: http://www.emu8086.com/vb/



' [e-mail]
' =========================================================
' Module for registry access
' =========================================================

Option Explicit

'-------------------------------------------------------------------------
' Registry Class data.
'-------------------------------------------------------------------------
'
Type SECURITY_ATTRIBUTES
    nLength              As Long
    lpSecurityDescriptor As Long
    bInheritHandle       As Boolean
End Type

Type FILETIME
    dwLowDateTime  As Long
    dwHighDateTime As Long
End Type

' 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_SUCCESS = 0&
Public Const ERROR_FILE_NOT_FOUND = 2&
Public Const ERROR_MORE_DATA = 234

' 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_SZ = 1
Public Const REG_BINARY = 3

' Registry security attributes
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_SET_VALUE = &H2
Public Const KEY_CREATE_SUB_KEY = &H4

Declare Function RegEnumValue Lib "advapi32.dll" _
        Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, _
        ByVal lpValueName As String, lpcbValueName As Long, lpReserved As Long, _
        lpType As Long, lpData As Byte, lpcbData As Long) As Long

Declare Function RegQueryInfoKey Lib "advapi32.dll" _
        Alias "RegQueryInfoKeyA" (ByVal hKey As Long, ByVal lpClass As String, _
        lpcbClass As Long, lpReserved As Long, lpcSubKeys As Long, _
        lpcbMaxSubKeyLen As Long, lpcbMaxClassLen As Long, lpcValues As Long, _
        lpcbMaxValueNameLen As Long, lpcbMaxValueLen As Long, _
        lpcbSecurityDescriptor As Long, lpftLastWriteTime As FILETIME) 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

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
'
' Use this function to:
'   -   Delete a registry key.
'
' sTopKey
'   -   A top level registry key abbreviation {"HKCU","HKLM","HKU","HKDD","HKCC","HKCR"} or
'
' 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 = ERROR_SUCCESS Then
    lResult = RegDeleteKey(lHandle, sKeyName)
End If

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

fDeleteKeyError:
    MsgBox "Unable to delete registry key.", vbExclamation, "fDeleteKey"
    fDeleteKey = lResult
End Function

Public Function fDeleteValue(ByVal sTopKeyOrFile As String, ByVal sSubKeyOrSection As String, ByVal sValueName As String) As Long
'
' 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 = ERROR_SUCCESS Then
        lResult = RegDeleteValue(lHandle, sValueName)
    End If
    
    If lResult = ERROR_SUCCESS Or lResult = ERROR_FILE_NOT_FOUND Then
        fDeleteValue = ERROR_SUCCESS
    Else
        fDeleteValue = lResult
    End If
End If
Exit Function

fDeleteValueError:
    MsgBox "Unable to delete registry or .ini file value.", vbExclamation, "fDeleteValue"
    fDeleteValue = lResult
End Function

Public Function fEnumValue(ByVal sTopKeyOrIniFile As String, ByVal sSubKeyOrSection As String, sValues As String) As Long
'
' 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 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 keys, the key must not contain any subkeys and
'   may contain only string or binary values.
'
Dim lTopKey     As Long
Dim lHandle     As Long
Dim lResult     As Long
Dim lMaxLen     As Long
Dim lLenData    As Long
Dim lActualLen  As Long
Dim lValues     As Long
Dim lIndex      As Long
Dim lValueType  As Long
Dim sValueName  As String
Dim sValue      As String
Dim bValue      As Boolean
Dim tFileTime   As FILETIME

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$(8192)
    lResult = GetPrivateProfileSection(sSubKeyOrSection, sValues, Len(sValues), sTopKeyOrIniFile)
Else
    '
    ' Open the registry SubKey.
    '
    lResult = RegOpenKeyEx(lTopKey, sSubKeyOrSection, 0, KEY_QUERY_VALUE, lHandle)
    If lResult <> ERROR_SUCCESS Then GoTo fEnumValueError
    
    lResult = RegQueryInfoKey(lHandle, "", 0, 0, 0, 0, 0, lValues, lLenData, 0, 0, tFileTime)
    If lResult <> ERROR_SUCCESS Then GoTo fEnumValueError
    lMaxLen = lLenData + 1
    
    Do While lIndex <= lValues - 1
        sValueName = Space$(lMaxLen)
        lActualLen = lMaxLen
        '
        ' Query the value's type, size and length.
        '
        Call RegEnumValue(lHandle, lIndex, sValueName, lActualLen, 0, lValueType, ByVal 0, 0)
        '
        ' Get the actual value.
        '
        If lValueType = REG_SZ Then
            '
            ' String value. The first query gets the string length.
            ' The second gets the string value.
            '
            sValueName = Left$(sValueName, lActualLen)
            lLenData = 0
            
            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)
                If lResult = ERROR_SUCCESS Then
                    sValues = sValues & sValueName & "=" & sValue
                Else
                    GoTo fEnumValueError
                End If
            Else
                GoTo fEnumValueError
            End If
        Else
            '
            ' Boolean value.
            '
            lLenData = Len(bValue)
            lResult = RegQueryValueEx(lHandle, sValueName, 0, 0, bValue, lLenData)
            If lResult = ERROR_SUCCESS Then
                sValueName = Left$(sValueName, lActualLen)
                sValues = sValues & sValueName & "=" & bValue & vbNullChar
            Else
                GoTo fEnumValueError
            End If
        End If
        lIndex = lIndex + 1
    Loop
    sValues = sValues & vbNullChar
    '
    ' Close the key.
    '
    lResult = RegCloseKey(lHandle)
    fEnumValue = lResult
End If
Exit Function
'
' Error processing.
'
fEnumValueError:
    MsgBox "Unable to enumerate registry or .ini file values.", vbExclamation, "fEnumValue"
    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
'
' 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.