cregistry.cls

Antivirus Description: It s a working antivirus or worm remover for most common virus. It dosen t

VERSION 1.0 CLASS
BEGIN
  MultiUse = 0   'False
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CRegistry"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'* Description : Class for working with the system registry.

Option Explicit

' Error handling definitions
Private Const E_ERR_BASE = 18000 + vbObjectError
Public Enum EErrRegistry
    eErrRegistry_InvalidKeyName = E_ERR_BASE + 1
    eErrRegistry_InvalidValueName
    eErrRegistry_ComponentFailure
End Enum
Private Const S_ERR_InvalidKeyName = "Invalid KeyName value"
Private Const S_ERR_InvalidValueName = "Invalid value name"
Private Const S_ERR_ComponentFailure = "CRegistry component failure"

' Public class enums
Public Enum ERegRoot
    eRegRoot_HKeyClassesRoot = &H80000000
    eRegRoot_HKeyCurrentUser = &H80000001
    eRegRoot_HKeyLocalMachine = &H80000002
    eRegRoot_HKeyUsers = &H80000003
    eRegRoot_HKeyCurrentConfig = &H80000005
    eRegRoot_HKeyDynData = &H80000006
End Enum

Public Enum ERegValue
    eRegValue_None = 0
    eRegValue_Sz = 1
    eRegValue_ExpandSz = 2
    eRegValue_Binary = 3
    eRegValue_DWord = 4
    eRegValue_DWordLittleEndian = 4
    eRegValue_DWordBigEndian = 5
    eRegValue_Link = 6
    eRegValue_MultiSz = 7
    eRegValue_ResourceList = 8
    eRegValue_FullResourceDescriptor = 9
    eRegValue_ResourceRequirementsList = 10
End Enum

' Private class constants
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private Const KEY_ALL_ACCESS = &H3F
Private Const REG_OPTION_NON_VOLATILE = 0&
Private Const REG_OPTION_VOLATILE = &H1
Private Const REG_CREATED_NEW_KEY = &H1
Private Const REG_OPENED_EXISTING_KEY = &H2
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const SPECIFIC_RIGHTS_ALL = &HFFFF
Private Const ERROR_SUCCESS = 0&
Private Const ERROR_ACCESS_DENIED = 5
Private Const ERROR_INVALID_DATA = 13&
Private Const ERROR_MORE_DATA = 234
Private Const ERROR_NO_MORE_ITEMS = 259
Private Const MAX_PATH = 256

' Private class type definitions
Private Type SECURITY_ATTRIBUTES
    nLength                  As Long
    lpSecurityDescriptor     As Long
    bInheritHandle           As Boolean
End Type
Private Type FILETIME
    dwLowDateTime    As Long
    dwHighDateTime   As Long
End Type

' Private class API function declarations
Private Declare Function RegOpenKeyEx Lib "advapi32" 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 RegSetValueExStr 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
Private Declare Function RegSetValueExLong Lib "advapi32" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, szData As Long, ByVal cbData As Long) As Long
Private Declare Function RegSetValueExByte Lib "advapi32" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, szData As Byte, ByVal cbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
Private Declare Function RegQueryValueExStr Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal szData As String, ByRef lpcbData As Long) As Long
Private Declare Function RegQueryValueExLong Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, szData As Long, ByRef lpcbData As Long) As Long
Private Declare Function RegQueryValueExByte Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, szData As Byte, ByRef lpcbData As Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32" 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 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 RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) 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, ByVal lpType As Long, ByVal lpData As Long, ByVal lpcbData As Long) As Long
Private Declare Function RegEnumValueLong 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 Long, lpcbData As Long) As Long
Private Declare Function RegEnumValueStr 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, ByVal lpData As String, lpcbData As Long) As Long
Private Declare Function RegEnumValueByte 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 RegQueryInfoKey Lib "advapi32.dll" Alias "RegQueryInfoKeyA" (ByVal hKey As Long, ByVal lpClass As String, lpcbClass As Long, ByVal 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 Any) 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 Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy 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 variables to hold property values
Private m_RootKey As ERegRoot


'*****************************************************************************************
'* Function    : Init
'* Notes       : Use this routine for basic object initialization.
'*****************************************************************************************
Public Function Init(RootKey As ERegRoot)
    On Error GoTo hComponentFailure
    
    m_RootKey = RootKey

    Exit Function

hComponentFailure:
    Err.Raise eErrRegistry_ComponentFailure, App.EXEName & ".CRegistry", S_ERR_ComponentFailure
End Function


'*****************************************************************************************
'* Property    : RootKey
'* Notes       : Returns or sets the key that will be used as root key.
'*****************************************************************************************
Public Property Get RootKey() As ERegRoot
    On Error GoTo hComponentFailure
    
    RootKey = m_RootKey

    Exit Property

hComponentFailure:
    Err.Raise eErrRegistry_ComponentFailure, App.EXEName & ".CRegistry", S_ERR_ComponentFailure
End Property

Public Property Let RootKey(ByVal eKey As ERegRoot)
    On Error GoTo hComponentFailure
    
    m_RootKey = eKey

    Exit Property

hComponentFailure:
    Err.Raise eErrRegistry_ComponentFailure, App.EXEName & ".CRegistry", S_ERR_ComponentFailure
End Property


'*****************************************************************************************
'* Function    : CreateKey
'* Notes       : Creates the specified registry key.
'*               Returns true if the key was created, false otherwise.
'*****************************************************************************************
Public Function CreateKey(KeyName As String) As Boolean
    On Error GoTo hComponentFailure
    
    Dim tSA      As SECURITY_ATTRIBUTES
    Dim hKey     As Long
    Dim lCreate  As Long
    Dim lRet     As Long
    
    If Len(KeyName) = 0 Then
        On Error GoTo 0
        Err.Raise eErrRegistry_InvalidKeyName, App.EXEName & ".CRegistry", S_ERR_InvalidKeyName
    End If

    lRet = RegCreateKeyEx(m_RootKey, KeyName, 0, "", REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, tSA, hKey, lCreate)
    If lRet = ERROR_SUCCESS Then RegCloseKey hKey
    
    CreateKey = (lRet = ERROR_SUCCESS)

    Exit Function

hComponentFailure:
    Err.Raise eErrRegistry_ComponentFailure, App.EXEName & ".CRegistry", S_ERR_ComponentFailure
End Function


'*****************************************************************************************
'* Function    : DeleteKey
'* Notes       : Deletes  the specified registry key.
'*               Returns true if the key was deleted, false otherwise.
'*****************************************************************************************
Public Function DeleteKey(KeyName As String) As Boolean
    On Error GoTo hComponentFailure
    
    Dim lRet As Long
    
    If Len(KeyName) = 0 Then
        On Error GoTo 0
        Err.Raise eErrRegistry_InvalidKeyName, App.EXEName & ".CRegistry", S_ERR_InvalidKeyName
    End If
    
    lRet = RegDeleteKey(m_RootKey, KeyName)
    DeleteKey = (lRet = ERROR_SUCCESS)

    Exit Function

hComponentFailure:
    Err.Raise eErrRegistry_ComponentFailure, App.EXEName & ".CRegistry", S_ERR_ComponentFailure
End Function


'*****************************************************************************************
'* Function    : DeleteValue
'* Notes       : Removes a named value from the specified registry key.
'*               Returns true if the key was deleted, false otherwise.
'*****************************************************************************************
Public Function DeleteValue(ByVal KeyName As String, ByVal ValueName As String) As Boolean
    On Error GoTo hComponentFailure
    
    Dim lRet As Long
    Dim hKey As Long
    
    If Len(KeyName) = 0 Then
        On Error GoTo 0
        Err.Raise eErrRegistry_InvalidKeyName, App.EXEName & ".CRegistry", S_ERR_InvalidKeyName
    End If
    
    DeleteValue = False

    lRet = RegOpenKeyEx(m_RootKey, KeyName, 0, KEY_ALL_ACCESS, hKey)
    
    If lRet = ERROR_SUCCESS Then
        lRet = RegDeleteValue(hKey, ValueName)
        DeleteValue = (lRet = ERROR_SUCCESS)
    End If

    Exit Function

hComponentFailure:
    Err.Raise eErrRegistry_ComponentFailure, App.EXEName & ".CRegistry", S_ERR_ComponentFailure
End Function


'*****************************************************************************************
'* Function    : GetAllSubKeys
'* Notes       : Retrieves all the subkeys belonging to a registry key.
'*               Returns a long integer value containing the number of retrieved subkeys.
'*****************************************************************************************
Public Function GetAllSubKeys(ByVal KeyName As String, ByRef SubKeys() As String) As Long
    On Error GoTo hComponentFailure
    
    Dim Count        As Long
    Dim dwReserved   As Long
    Dim hKey         As Long
    Dim iPos         As Long
    Dim lenBuffer    As Long
    Dim lIndex       As Long
    Dim lRet         As Long
    Dim lType        As Long
    Dim sCompKey     As String
    Dim szBuffer     As String
        
    Erase SubKeys
    
    Count = 0
    lIndex = 0

    lRet = RegOpenKeyEx(m_RootKey, KeyName, 0, KEY_ENUMERATE_SUB_KEYS, hKey)
    
    Do While lRet = ERROR_SUCCESS
        
        szBuffer = String$(MAX_PATH, 0)
        lenBuffer = Len(szBuffer)
        
        lRet = RegEnumKey(hKey, lIndex, szBuffer, lenBuffer)
        
        If (lRet = ERROR_SUCCESS) Then
            
            Count = Count + 1
            
            ReDim Preserve SubKeys(1 To Count) As String
            iPos = InStr(szBuffer, Chr$(0))
            
            If (iPos > 0) Then
                SubKeys(Count) = Left$(szBuffer, iPos - 1)
            Else
                SubKeys(Count) = Left$(szBuffer, lenBuffer)
            End If
        
        End If
        
        lIndex = lIndex + 1
    
    Loop
    
    If (hKey <> 0) Then RegCloseKey hKey
    GetAllSubKeys = Count

    Exit Function

hComponentFailure:
    If (hKey <> 0) Then RegCloseKey hKey
    GetAllSubKeys = 0
    Err.Raise eErrRegistry_ComponentFailure, App.EXEName & ".CRegistry", S_ERR_ComponentFailure
End Function


'*****************************************************************************************
'* Function    : GetAllValueNames
'* Notes       : Retrieves all the  value names belonging to a registry key.
'*               Returns a long integer containing the number of retrieved names.
'*****************************************************************************************
Public Function GetAllValueNames(ByVal KeyName As String, ByRef ValueNames() As String) As Long
    On Error GoTo hComponentFailure
    
    Dim ft           As Currency
    Dim cJunk        As Long
    Dim cNameMax     As Long
    Dim Count        As Long
    Dim hKey         As Long
    Dim lIndex       As Long
    Dim lNameSize    As Long