clsreg.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 = "clsReg"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False

Option Explicit

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

Private Type FILETIME
 dwLowDateTime          As Long
 dwHighDateTime         As Long
End Type

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 RegCloseKey Lib "advapi32.dll" (ByVal hKey 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
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 SECURITY_ATTRIBUTES, 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 RegEnumKeyEx 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
Private 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 Byte, lpcbData As Long) As Long
Private Declare Function RegConnectRegistry Lib "advapi32.dll" Alias "RegConnectRegistryA" (ByVal lpMachineName As String, ByVal hKey As Long, phkResult As Long) As Long
Private Declare Function ExpandEnvironmentStrings Lib "kernel32" Alias "ExpandEnvironmentStringsA" (ByVal lpSrc As String, ByVal lpDst As String, ByVal nSize As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, Source As Any, ByVal numBytes As Long)

Const REG_OPTION_VOLATILE = 1
Const REG_OPTION_NON_VOLATILE = 0
Const SYNCHRONIZE = &H100000
Const READ_CONTROL = &H20000
Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Const STANDARD_RIGHTS_ALL = &H1F0000
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
Const KEY_EXECUTE = (KEY_READ)
Const 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))
Const ERROR_MORE_DATA = 234
Const ERROR_NO_MORE_ITEMS = &H103
Const ERROR_KEY_NOT_FOUND = &H2

Enum DataType
 REG_SZ = &H1
 REG_EXPAND_SZ = &H2
 REG_BINARY = &H3
 REG_DWORD = &H4
 REG_MULTI_SZ = &H7
End Enum

Enum hKey
 HKEY_CLASSES_ROOT = &H80000000
 HKEY_Current_User = &H80000001
 HKEY_LOCAL_MACHINE = &H80000002
 HKEY_USERS = &H80000003
 HKEY_PERFORMANCE_DATA = &H80000004
 HKEY_CURRENT_CONFIG = &H80000005
 HKEY_DYN_DATA = &H80000006
End Enum

Dim mvarhKeySet As Long
Dim mvarKeyRoot As String
Dim mvarSubKey As String
Dim Security As SECURITY_ATTRIBUTES

Public Property Get hKey() As hKey
 hKey = mvarhKeySet
End Property

Public Property Let hKey(ByVal vData As hKey)
 mvarhKeySet = vData
End Property

Public Property Get KeyRoot() As String
 KeyRoot = mvarKeyRoot
End Property

Public Property Let KeyRoot(ByVal vData As String)
 mvarKeyRoot = vData
End Property

Public Property Get Subkey() As String
 Subkey = mvarSubKey
End Property

Public Property Let Subkey(ByVal vData As String)
 mvarSubKey = vData
End Property

Public Function KeyExists() As Boolean
Dim handle As Long
Dim ret As Long
 If RegOpenKeyEx(mvarhKeySet, mvarKeyRoot & "\" & mvarSubKey, 0, KEY_READ, handle) Then
  KeyExists = False
  Exit Function
 End If
 KeyExists = True
End Function

Public Function CreateKey(Optional KeyName As Variant) As String
Dim handle As Long
Dim disp As Long
Dim retVal As Long
 KeyName = IIf(IsMissing(KeyName), mvarSubKey, CStr(KeyName))
 retVal = RegCreateKeyEx(mvarhKeySet, mvarKeyRoot & "\" & KeyName, 0, "", REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, Security, handle, disp)
 If retVal Then Exit Function
 RegCloseKey (handle)
 CreateKey = retVal
End Function

Public Function DeleteKey(KeyName As String) As Long
Dim retVal As Long
Dim handle As Long
 retVal = RegDeleteKey(mvarhKeySet, mvarKeyRoot & "\" & KeyName)
 If retVal Then Exit Function
 RegCloseKey (handle)
 DeleteKey = retVal
End Function

Public Function DeleteValue(ValueName As String) As Long
Dim retVal As Long
Dim handle As Long
 retVal = RegOpenKeyEx(mvarhKeySet, mvarKeyRoot & "\" & mvarSubKey, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, handle)
 If retVal <> 0 Then
  DeleteValue = retVal
  Exit Function
 End If
 DeleteValue = RegDeleteValue(handle, ValueName)
 RegCloseKey (handle)
End Function

Public Function EnumRegistryKeys(ByVal hKey As hKey, ByVal KeyName As String) As Collection
Dim handle As Long
Dim Length As Long
Dim Index As Long
Dim subkeyName As String
Dim fFiletime As FILETIME
 Set EnumRegistryKeys = New Collection
 If Len(KeyName) Then
  If RegOpenKeyEx(hKey, KeyName, 0, KEY_READ, handle) Then Exit Function
  hKey = handle
 End If
 Do
  Length = 260
  subkeyName = Space$(Length)
  If RegEnumKeyEx(hKey, Index, subkeyName, Length, 0, "", vbNull, fFiletime) = ERROR_NO_MORE_ITEMS Then Exit Do
  subkeyName = Left$(subkeyName, InStr(subkeyName, vbNullChar) - 1)
  EnumRegistryKeys.Add subkeyName, subkeyName
  Index = Index + 1
 Loop
 If handle Then RegCloseKey handle
End Function

Function EnumRegistryValues(ByVal hKey As hKey, ByVal KeyName As String) As Collection
Dim handle As Long
Dim Index As Long
Dim valueType As Long
Dim name As String
Dim nameLen As Long
Dim resLong As Long
Dim resString As String
Dim Length As Long
Dim valueInfo(0 To 1) As Variant
Dim retVal As Long
Dim i As Integer
Dim vTemp As Variant
 Set EnumRegistryValues = New Collection
 If Len(KeyName) Then
  If RegOpenKeyEx(hKey, KeyName, 0, KEY_READ, handle) Then Exit Function
  hKey = handle
 End If
 Do
  nameLen = 260
  name = Space$(nameLen)
  Length = 4096
  ReDim resBinary(0 To Length - 1) As Byte
  retVal = RegEnumValue(hKey, Index, name, nameLen, ByVal 0&, valueType, resBinary(0), Length)
  If retVal = ERROR_MORE_DATA Then
   ReDim resBinary(0 To Length - 1) As Byte
   retVal = RegEnumValue(hKey, Index, name, nameLen, ByVal 0&, valueType, resBinary(0), Length)
  End If
  If retVal Then Exit Do
  valueInfo(0) = Left$(name, nameLen)
  Select Case valueType
   Case REG_DWORD
    CopyMemory resLong, resBinary(0), 4
    valueInfo(1) = resLong
   Case REG_SZ
    If Length <> 0 Then
     resString = Space$(Length - 1)
     CopyMemory ByVal resString, resBinary(0), Length - 1
     valueInfo(1) = resString
    Else
     valueInfo(1) = ""
    End If
   Case REG_EXPAND_SZ
    If Length <> 0 Then
     resString = Space$(Length - 1)