VB:操作注册表类模块

作者:admin 日期:2008-06-01

字体大小: 小中大

'以下存为clsRegistry.cls

VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "clsRegistry"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'**功能描述：操作注册表的模块
'**丹心
'**QQ:121877114

Const STANDARD_RIGHTS_ALL = &H1F0000
Const SYNCHRONIZE = &H100000

Public Enum RegKeyOption
    REG_OPTION_BACKUP_RESTORE = 4   ' open for backup or restore
    REG_OPTION_Create_LINK = 2    ' Created key is a symbolic link
    REG_OPTION_NON_VOLATILE = 0    ' Key is preserved when system is rebooted
    REG_OPTION_OPEN_LINK = (&H8)
    REG_OPTION_RESERVED = 0      ' Parameter is reserved
    REG_OPTION_VOLATILE = 1      ' Key is not preserved when system is rebooted
End Enum

Public Enum RegDataTypes
    REG_DWORD = 4    ' 32-bit number
    REG_BINARY = 3   ' Free form binary
    REG_SZ = 1       ' Unicode nul terminated string
End Enum

Public Enum RegHKey
    HKEY_CLASSES_ROOT = &H80000000
    HKEY_CURRENT_USER = &H80000001
    HKEY_LOCAL_MACHINE = &H80000002
    HKEY_USERS = &H80000003
    HKEY_CURRENT_CONFIG = &H80000005
    HKEY_DYN_DATA = &H80000006
End Enum

Public Enum RegKeyAccess
    KEY_Create_LINK = &H20
    KEY_Create_SUB_KEY = &H4
    KEY_ENUMERATE_SUB_KEYS = &H8
    KEY_NOTIFY = &H10
    KEY_QUERY_VALUE = &H1
    KEY_SET_VALUE = &H2
    KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL or KEY_QUERY_VALUE or KEY_SET_VALUE or KEY_Create_SUB_KEY or KEY_ENUMERATE_SUB_KEYS or KEY_NOTIFY or KEY_Create_LINK) And (Not SYNCHRONIZE))
End Enum

'----< REG >----
Private Declare Function RegCloseKey _
Lib "advapi32.dll" ( _
    ByVal HKey As Long _
) As Long

Private 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 Any, _
    phkResult As Long, _
    lpdwDisposition As Long _
) As Long

Private Declare Function RegDeleteKey _
Lib "advapi32.dll" Alias "RegDeleteKeyA" ( _
    ByVal HKey As Long, _
    ByVal lpSubKey As String _
) As Long

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

Private 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

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 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
'----< END REG >----

Public Function GetString(ByVal HKey As RegHKey, ByVal KeyPath As String, ByVal KeyName As String, Optional ByVal KeyAccess As RegKeyAccess = KEY_ALL_ACCESS, Optional Error As Long) As String
    Dim Result As Long
    Dim QueryResult As Long
    Dim ValueType As Long
    Dim BufferSize As Long
    Dim Buffer As String

    Error = 0
    RegOpenKeyEx HKey, KeyPath, 0, KeyAccess, Result

    'Retrieve information about the key
    QueryResult = RegQueryValueEx(Result, KeyName, 0, ValueType, ByVal 0, BufferSize)
    If QueryResult = 0 And ValueType = REG_SZ Then
        'Create a buffer
        Buffer = String(BufferSize, Chr(0))
        'Retrieve the key's content
        QueryResult = RegQueryValueEx(Result, KeyName, 0, 0, ByVal Buffer, BufferSize)
        If QueryResult = 0 Then
            'Remove the unnecessary Chr(0)'s
            If Buffer <> "" And InStr(1, Buffer, Chr(0)) <> 0 Then GetString = Left(Buffer, InStr(1, Buffer, Chr(0)) - 1)
        Else
            Error = -1
        End If
    Else
        Error = -1
    End If

    'Close the key
    RegCloseKey Result
End Function

Public Sub SetString(ByVal HKey As RegHKey, ByVal KeyPath As String, ByVal KeyName As String, ByVal Value As String, Optional ByVal KeyOption As RegKeyOption = REG_OPTION_NON_VOLATILE, Optional ByVal KeyAccess As RegKeyAccess = KEY_ALL_ACCESS)
    Dim Result As Long
    Dim Ret As Long

    RegCreateKeyEx HKey, KeyPath, 0, "REG_SZ", KeyOption, KeyAccess, ByVal 0&, Result, Ret
    RegSetValueEx Result, KeyName, 0, REG_SZ, ByVal Value, Len(Value)

    'close the key
    RegCloseKey Result
End Sub

Public Function CheckString(ByVal HKey As RegHKey, ByVal KeyPath As String, ByVal KeyName As String, Optional ByVal KeyAccess As RegKeyAccess = KEY_ALL_ACCESS) As Long
    Dim Result As Long
    Dim QueryResult As Long
    Dim ValueType As Long
    Dim BufferSize As Long
    Dim Buffer As String

    RegOpenKeyEx HKey, KeyPath, 0, KeyAccess, Result

    'Retrieve information about the key
    QueryResult = RegQueryValueEx(Result, KeyName, 0, ValueType, ByVal 0, BufferSize)
    If QueryResult = 0 And ValueType = REG_SZ Then
        'Create a buffer
        Buffer = String(BufferSize, Chr(0))
        'Retrieve the key's content
        QueryResult = RegQueryValueEx(Result, KeyName, 0, 0, ByVal Buffer, BufferSize)
        If QueryResult <> 0 Then
            CheckString = -1
            Exit Function
        End If
    Else
        CheckString = -1
        Exit Function
    End If

    'Close the key
    RegCloseKey Result
End Function

Public Function GetLong(ByVal HKey As RegHKey, ByVal KeyPath As String, ByVal KeyName As String, Optional ByVal KeyAccess As RegKeyAccess = KEY_ALL_ACCESS, Optional Error As Long) As Long
    Dim Result As Long
    Dim QueryResult As Long
    Dim ValueType As Long
    Dim BufferSize As Long
    Dim Buffer As Long

    Error = 0
    RegOpenKeyEx HKey, KeyPath, 0, KeyAccess, Result

    'Retrieve information about the key
    QueryResult = RegQueryValueEx(Result, KeyName, 0, ValueType, ByVal 0, BufferSize)
    'QueryResult = RegQueryValueEx(Result, KeyName, 0, REG_DWORD, Buffer, 4)
    If QueryResult = 0 And ValueType = REG_DWORD Then
        'Retrieve the key's content
        QueryResult = RegQueryValueEx(Result, KeyName, 0, ValueType, Buffer, BufferSize)
        If QueryResult = 0 Then
            GetLong = Buffer
        Else
            Error = -1
        End If
    Else
        Error = -1
    End If

    'Close the key
    RegCloseKey Result
End Function

Public Sub SetLong(ByVal HKey As RegHKey, ByVal KeyPath As String, ByVal KeyName As String, ByVal Value As Long, Optional ByVal KeyOption As RegKeyOption = REG_OPTION_NON_VOLATILE, Optional ByVal KeyAccess As RegKeyAccess = KEY_ALL_ACCESS)
    Dim Buffer As Long
    Dim Result As Long
    Dim Ret As Long

    RegCreateKeyEx HKey, KeyPath, 0, "REG_DWORD", KeyOption, KeyAccess, ByVal 0&, Result, Ret
    RegSetValueEx Result, KeyName, 0, REG_DWORD, Value, 4

    'close the key
    RegCloseKey Result
End Sub

Public Function CheckLong(ByVal HKey As RegHKey, ByVal KeyPath As String, ByVal KeyName As String, Optional ByVal KeyAccess As RegKeyAccess = KEY_ALL_ACCESS) As Long
    Dim Result As Long
    Dim QueryResult As Long
    Dim ValueType As Long
    Dim BufferSize As Long
    Dim Buffer As Long

    RegOpenKeyEx HKey, KeyPath, 0, KeyAccess, Result

    'Retrieve information about the key
    QueryResult = RegQueryValueEx(Result, KeyName, 0, ValueType, ByVal 0, BufferSize)
    'QueryResult = RegQueryValueEx(Result, KeyName, 0, REG_DWORD, Buffer, 4)
    If QueryResult = 0 And ValueType = REG_DWORD Then
        'Retrieve the key's content
        QueryResult = RegQueryValueEx(Result, KeyName, 0, ValueType, Buffer, BufferSize)
        If QueryResult <> 0 Then
            CheckLong = -1
            Exit Function
        End If
    Else
        CheckLong = -1
        Exit Function
    End If

    'Close the key
    RegCloseKey Result
End Function

Public Function GetBinary(ByVal HKey As RegHKey, ByVal KeyPath As String, ByVal KeyName As String, Optional ByVal KeyAccess As RegKeyAccess = KEY_ALL_ACCESS, Optional Error As Long) As String
    Dim Result As Long
    Dim QueryResult As Long
    Dim ValueType As Long
    Dim BufferSize As Long
    Dim Buffer As String

    Error = 0
    RegOpenKeyEx HKey, KeyPath, 0, KeyAccess, Result

    'Retrieve information about the key
    QueryResult = RegQueryValueEx(Result, KeyName, 0, ValueType, ByVal 0, BufferSize)
    If QueryResult = 0 And ValueType = REG_BINARY Then
        'Create a buffer
        Buffer = String(BufferSize, Chr(0))
        'Retrieve the key's content
        QueryResult = RegQueryValueEx(Result, KeyName, 0, 0, ByVal Buffer, BufferSize)
        If QueryResult = 0 Then
            GetBinary = Buffer
        Else
            Error = -1
        End If
    Else
        Error = -1
    End If

    'Close the key
    RegCloseKey Result
End Function

Public Sub SetBinary(ByVal HKey As RegHKey, ByVal KeyPath As String, ByVal KeyName As String, ByVal Value As String, Optional ByVal KeyOption As RegKeyOption = REG_OPTION_NON_VOLATILE, Optional ByVal KeyAccess As RegKeyAccess = KEY_ALL_ACCESS)
    Dim Result As Long
    Dim Ret As Long
    Dim Buffer() As Byte
    Dim i As Long

    ReDim Preserve Buffer(Len(Value))
    For i = 1 To Len(Value)
        Buffer(i) = Asc(Mid(Value, i, 1))
    Next i

    RegCreateKeyEx HKey, KeyPath, 0, "REG_BINARY", KeyOption, KeyAccess, ByVal 0&, Result, Ret
    RegSetValueEx Result, KeyName, 0, REG_BINARY, Buffer(1), Len(Value)

    'close the key
    RegCloseKey Result
End Sub

Public Function CheckBinary(ByVal HKey As RegHKey, ByVal KeyPath As String, ByVal KeyName As String, Optional ByVal KeyAccess As RegKeyAccess = KEY_ALL_ACCESS) As Long
    Dim Result As Long
    Dim QueryResult As Long
    Dim ValueType As Long
    Dim BufferSize As Long
    Dim Buffer As String

    RegOpenKeyEx HKey, KeyPath, 0, KeyAccess, Result

    'Retrieve information about the key
    QueryResult = RegQueryValueEx(Result, KeyName, 0, ValueType, ByVal 0, BufferSize)
    If QueryResult = 0 And ValueType = REG_BINARY Then
        'Create a buffer
        Buffer = String(BufferSize, Chr(0))
        'Retrieve the key's content
        QueryResult = RegQueryValueEx(Result, KeyName, 0, 0, ByVal Buffer, BufferSize)
        If QueryResult <> 0 Then
            CheckBinary = -1
            Exit Function
        End If
    Else
        CheckBinary = -1
        Exit Function
    End If

    'Close the key
    RegCloseKey Result
End Function

Public Function GetUnknown(ByVal HKey As RegHKey, ByVal KeyPath As String, ByVal KeyName As String, Optional ValueDataType As RegDataTypes, Optional ByVal KeyAccess As RegKeyAccess = KEY_ALL_ACCESS, Optional Error As Long) As Variant
    Dim Result As Long
    Dim QueryResult As Long
    Dim ValueType As Long
    Dim BufferSize As Long
    Dim Buffer As String
    Dim lBuffer As Long

    Error = 0
    RegOpenKeyEx HKey, KeyPath, 0, KeyAccess, Result

    'Retrieve information about the key
    QueryResult = RegQueryValueEx(Result, KeyName, 0, ValueType, ByVal 0, BufferSize)
    If QueryResult = 0 Then
        If ValueType = REG_SZ Then
            Buffer = String(BufferSize, Chr(0))
            QueryResult = RegQueryValueEx(Result, KeyName, 0, 0, ByVal Buffer, BufferSize)
            If QueryResult = 0 Then
                'Remove the unnecessary Chr(0)'s
                If Buffer <> "" And InStr(1, Buffer, Chr(0)) <> 0 Then GetUnknown = CStr(Left(Buffer, InStr(1, Buffer, Chr(0)) - 1))
                ValueDataType = REG_SZ
            Else
                Error = -1
            End If
        ElseIf ValueType = REG_DWORD Then
            QueryResult = RegQueryValueEx(Result, KeyName, 0, 0, lBuffer, BufferSize)
            If QueryResult = 0 Then
                GetUnknown = lBuffer
                ValueDataType = REG_DWORD
            Else
                Error = -1
            End If
        ElseIf ValueType = REG_BINARY Then
            Buffer = String(BufferSize, Chr(0))
            QueryResult = RegQueryValueEx(Result, KeyName, 0, 0, ByVal Buffer, BufferSize)
            If QueryResult = 0 Then
                GetUnknown = CStr(Buffer)
                ValueDataType = REG_BINARY
            Else
                Error = -1
            End If
        Else
            Error = -1
        End If
    Else
        Error = -1
    End If

    'Close the key
    RegCloseKey Result
End Function

Public Function CheckUnknown(ByVal HKey As RegHKey, ByVal KeyPath As String, ByVal KeyName As String, Optional ValueDataType As RegDataTypes, Optional ByVal KeyAccess As RegKeyAccess = KEY_ALL_ACCESS) As Long
    Dim Result As Long
    Dim QueryResult As Long
    Dim ValueType As Long
    Dim BufferSize As Long
    Dim Buffer As String
    Dim lBuffer As Long

    RegOpenKeyEx HKey, KeyPath, 0, KeyAccess, Result

    'Retrieve information about the key
    QueryResult = RegQueryValueEx(Result, KeyName, 0, ValueType, ByVal 0, BufferSize)
    If QueryResult = 0 Then
        If ValueType = REG_SZ Then
            Buffer = String(BufferSize, Chr(0))
            QueryResult = RegQueryValueEx(Result, KeyName, 0, 0, ByVal Buffer, BufferSize)
            If QueryResult <> 0 Then
                CheckUnknown = -1
                Exit Function
            End If
        ElseIf ValueType = REG_DWORD Then
            QueryResult = RegQueryValueEx(Result, KeyName, 0, 0, lBuffer, BufferSize)
            If QueryResult <> 0 Then
                CheckUnknown = -1
                Exit Function
            End If
        ElseIf ValueType = REG_BINARY Then
            Buffer = String(BufferSize, Chr(0))
            QueryResult = RegQueryValueEx(Result, KeyName, 0, 0, ByVal Buffer, BufferSize)
            If QueryResult <> 0 Then
                CheckUnknown = -1
                Exit Function
            End If
        Else
            CheckUnknown = -1
            Exit Function
        End If
    Else
        CheckUnknown = -1
        Exit Function
    End If

    'Close the key
    RegCloseKey Result
End Function

Public Sub DeleteKey(ByVal HKey As RegHKey, ByVal KeyPath As String, Optional ByVal KeyAccess As RegKeyAccess = KEY_ALL_ACCESS)
    Dim Result As Long

    RegOpenKeyEx HKey, KeyPath, 0, KeyAccess, Result
    RegDeleteKey Result, ""

    'close the key
    RegCloseKey Result
End Sub

Public Sub DeleteValue(ByVal HKey As RegHKey, ByVal KeyPath As String, ByVal KeyName As String, Optional ByVal KeyAccess As RegKeyAccess = KEY_ALL_ACCESS)
    Dim Result As Long

    RegOpenKeyEx HKey, KeyPath, 0, KeyAccess, Result
    RegDeleteValue Result, KeyName

    'close the key
    RegCloseKey Result
End Sub

'引用自http://hi.baidu.com/starwork/blog/item/199d38f42da4056dddc4749f.html