cregistry.cls

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

    Dim lRet         As Long
    Dim sData        As String
    Dim sName        As String
    
    Count = 0
    Erase ValueNames()
    
    lIndex = 0
    lRet = RegOpenKeyEx(m_RootKey, KeyName, 0, KEY_QUERY_VALUE, hKey)
    
    If (lRet = ERROR_SUCCESS) Then
        
        lRet = RegQueryInfoKey(hKey, "", cJunk, 0, cJunk, cJunk, cJunk, cJunk, cNameMax, cJunk, cJunk, ft)
        
        Do While lRet = ERROR_SUCCESS
            
            lNameSize = cNameMax + 1
            sName = String$(lNameSize, 0)
            
            If (lNameSize = 0) Then lNameSize = 1
            lRet = RegEnumValue(hKey, lIndex, sName, lNameSize, 0&, 0&, 0&, 0&)
            
            If (lRet = ERROR_SUCCESS) Then
                sName = Left$(sName, lNameSize)
                Count = Count + 1
                ReDim Preserve ValueNames(1 To Count) As String
                ValueNames(Count) = sName
            End If
            
            lIndex = lIndex + 1
        
        Loop
    
    End If
    
    If (hKey <> 0) Then RegCloseKey hKey
    GetAllValueNames = Count

    Exit Function

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


'*****************************************************************************************
'* Function    : GetValue
'* Notes       : Returns the value for the specified value name stored in a registry key.
'*               If there is no value stored in that key the Default value is returned.
'*****************************************************************************************
Public Function GetValue(ByVal KeyName As String, ByVal ValueName As String, ByVal Default As Variant) As Variant
    On Error GoTo hComponentFailure
    
    Dim abData()     As Byte
    Dim cData        As Long
    Dim dwData       As Long
    Dim hKey         As Long
    Dim lData        As Long
    Dim lRet         As Long
    Dim ordType      As Long
    Dim sData        As String
    Dim vValue       As Variant
    
    vValue = Default

    lRet = RegOpenKeyEx(m_RootKey, KeyName, 0, KEY_QUERY_VALUE, hKey)
    lRet = RegQueryValueExLong(hKey, ValueName, 0&, ordType, 0&, cData)
    
    If lRet And lRet <> ERROR_MORE_DATA Then
        GetValue = vValue
        Exit Function
    End If
    
    Select Case ordType
        
        Case eRegValue_DWord, eRegValue_DWordLittleEndian
            lRet = RegQueryValueExLong(hKey, ValueName, 0&, ordType, lData, cData)
            vValue = CLng(lData)
        
        Case eRegValue_DWordBigEndian
            lRet = RegQueryValueExLong(hKey, ValueName, 0&, ordType, dwData, cData)
            vValue = SwapEndian(dwData)
        
        Case eRegValue_Sz, eRegValue_MultiSz
            sData = String$(cData - 1, 0)
            lRet = RegQueryValueExStr(hKey, ValueName, 0&, ordType, sData, cData)
            vValue = sData
        
        Case eRegValue_ExpandSz
            sData = String$(cData - 1, 0)
            lRet = RegQueryValueExStr(hKey, ValueName, 0&, ordType, sData, cData)
            vValue = ExpandEnvStr(sData)
        
        Case Else
            ReDim abData(cData)
            lRet = RegQueryValueExByte(hKey, ValueName, 0&, ordType, abData(0), cData)
            vValue = abData
    
    End Select
    
    GetValue = vValue

    Exit Function

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


'*****************************************************************************************
'* Function    : KeyExists
'* Notes       : Returns true if the specified registry key exists, false otherwise.
'*****************************************************************************************
Public Function KeyExists(KeyName As String) As Boolean
    On Error GoTo hComponentFailure
    
    ' Returns:  true if the key exists.
    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
    
    If RegOpenKeyEx(m_RootKey, KeyName, 0, 1, hKey) = ERROR_SUCCESS Then
        KeyExists = True
        RegCloseKey hKey
    Else
        KeyExists = False
    End If

    Exit Function

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


'*****************************************************************************************
'* Function    : SetValue
'* Notes       : Sets the value for the specified value name stored in a registry key.
'*               Returns true if the value is set, false otherwise.
'*****************************************************************************************
Public Function SetValue(ByVal KeyName As String, ByVal ValueName As String, ByVal Value As Variant, Optional ValueType As ERegValue = eRegValue_Sz) As Boolean
    On Error GoTo hComponentFailure
    
    Dim ab()         As Byte
    Dim C            As Long
    Dim i            As Long
    Dim iPos         As Long
    Dim hKey         As Long
    Dim lCreate      As Long
    Dim lRet         As Long
    Dim ordType      As Long
    Dim tSA          As SECURITY_ATTRIBUTES
    Dim s            As String
    
    If Len(KeyName) = 0 Then
        On Error GoTo 0
        Err.Raise eErrRegistry_InvalidKeyName, App.EXEName & ".CRegistry", S_ERR_InvalidKeyName
    End If
    
    SetValue = False

    lRet = RegCreateKeyEx(m_RootKey, KeyName, 0, "", REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, tSA, hKey, lCreate)
    
    If lRet = ERROR_SUCCESS Then
        
        Select Case ValueType
            
            Case eRegValue_Binary
                If (VarType(Value) = vbArray + vbByte) Then
                    ab = Value
                    ordType = eRegValue_Binary
                    C = UBound(ab) - LBound(ab) - 1
                    
                    lRet = RegSetValueExByte(hKey, ValueName, 0&, ordType, ab(0), C)
                End If
            
            Case eRegValue_DWord, eRegValue_DWordBigEndian, eRegValue_DWordLittleEndian
                If (VarType(Value) = vbInteger) Or (VarType(Value) = vbLong) Then
                    i = Value
                    ordType = eRegValue_DWord
                    
                    lRet = RegSetValueExLong(hKey, ValueName, 0&, ordType, i, 4)
                End If
            
            Case eRegValue_Sz, eRegValue_ExpandSz
                s = Value
                ordType = eRegValue_Sz
                iPos = InStr(s, "%")
                
                If iPos Then
                    If InStr(iPos + 2, s, "%") Then ordType = eRegValue_ExpandSz
                End If
                
                If Len(s) > 0 Then
                    C = Len(s) + 1
                Else
                    s = vbNullChar
                    C = Len(s)
                End If
                
                lRet = RegSetValueExStr(hKey, ValueName, 0&, ordType, s, C)
            
            Case Else
                lRet = ERROR_INVALID_DATA
        
        End Select
        
        If lRet = ERROR_SUCCESS Then SetValue = True
        
        RegCloseKey hKey
    
    End If

    Exit Function

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


'*****************************************************************************************
'* Function    : ValueType
'* Notes       : Returns a number containing the type of the value stored under the
'*               specified name in a registry key.
'*****************************************************************************************
Public Function ValueType(ByVal KeyName As String, ByVal ValueName As String) As ERegValue
    On Error GoTo hComponentFailure
    
    Dim cData    As Long
    Dim hKey     As Long
    Dim lRet     As Long
    Dim ordType  As Long
    Dim sData    As String
    Dim vValue   As Variant
    
    If Len(KeyName) = 0 Then
        On Error GoTo 0
        Err.Raise eErrRegistry_InvalidKeyName, App.EXEName & ".CRegistry", S_ERR_InvalidKeyName
    End If
    
    lRet = RegOpenKeyEx(m_RootKey, KeyName, 0, KEY_QUERY_VALUE, hKey)

    lRet = RegQueryValueExLong(hKey, ValueName, 0&, ordType, 0&, cData)
    If lRet And lRet <> ERROR_MORE_DATA Then
        ValueType = eRegValue_None
    Else
        ValueType = ordType
    End If

    Exit Function

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


'*****************************************************************************************
'* Function    : ExpandEnvStr
'* Notes       : Expands environment-variable strings and replaces them with their defined
'*               values.
'*****************************************************************************************
Private Function ExpandEnvStr(sData As String) As String
    On Error GoTo hComponentFailure
    
    Dim lRet     As Long
    Dim sTemp    As String
    
    sTemp = ""
    lRet = ExpandEnvironmentStrings(sData, sTemp, lRet)
    sTemp = String$(lRet - 1, 0)
    lRet = ExpandEnvironmentStrings(sData, sTemp, lRet)
    
    ExpandEnvStr = sTemp

    Exit Function

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


'*****************************************************************************************
'* Function    : SwapEndian
'* Notes       : Swaps the highest byte with the lowest byte for the BIG_ENDIAN format.
'*****************************************************************************************
Private Function SwapEndian(ByVal dw As Long) As Long
    On Error GoTo hComponentFailure
    
    CopyMemory ByVal VarPtr(SwapEndian) + 3, dw, 1
    CopyMemory ByVal VarPtr(SwapEndian) + 2, ByVal VarPtr(dw) + 1, 1
    CopyMemory ByVal VarPtr(SwapEndian) + 1, ByVal VarPtr(dw) + 2, 1
    CopyMemory SwapEndian, ByVal VarPtr(dw) + 3, 1

    Exit Function

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


'*****************************************************************************************
'* Sub         : Class_Initialize
'* Notes       : Class data space initialization.
'*****************************************************************************************
Private Sub Class_Initialize()
    On Error GoTo hComponentFailure
    
    m_RootKey = eRegRoot_HKeyClassesRoot

    Exit Sub

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