registrykey.cls

这是一个在vb下实现的各种加密程序,可以实现一般的文本加密和文件加密,但是很多算法都是已经被人破解过的.

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "RegistryKey"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'    CopyRight (c) 2005 Kelly Ethridge
'
'    This file is part of VBCorLib.
'
'    VBCorLib is free software; you can redistribute it and/or modify
'    it under the terms of the GNU Library General Public License as published by
'    the Free Software Foundation; either version 2.1 of the License, or
'    (at your option) any later version.
'
'    VBCorLib is distributed in the hope that it will be useful,
'    but WITHOUT ANY WARRANTY; without even the implied warranty of
'    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'    GNU Library General Public License for more details.
'
'    You should have received a copy of the GNU Library General Public License
'    along with Foobar; if not, write to the Free Software
'    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
'
'    Module: RegistryKey
'

''
' Represents a key level node inside the Windows Registry.
'
' @remarks This class allows for easy access and manipulation of keys and key values
' within the Windows Registry. By using a key naming convention similar to folders the
' keys and values can be traversed and modified.
' <p>There a set of Root nodes that separate the Registry to common areas for specific
' needs. The Root nodes are the starting place for any keys in the registry. A key name
' could look like 'HKEY_LOCAL_MACHINE\Software'.
' <pre>
' Iterate the values found in a registry key.
'
' Private Sub Main()
'     Dim rk As RegistryKey
'     Dim names() As String
'     Dim i As Long
'
'     '' Open a registry subkey for enumeration.
'     Set rk = Registry.LocalMachine.OpenSubKey("software\microsoft\windows\currentversion\run")
'
'     '' Retrieve all names for the values in the key.
'     names = rk.GetValueNames
'
'     '' enumerate the names and get the value for each,
'     '' displaying the pair as [name] = [value].
'     For i = 0 To UBound(names)
'         Console.WriteLine "{0} = {1}", names(i), rk.GetValue(names(i))
'     Next i
'
'     '' Close the registry key.
'     rk.CloseKey
'
'     '' Wait for user to hit return.
'     Console.ReadLine
' End Sub
'
' ''This code produces the following output.
' ''The list will vary from machine to machine.
'
' ''CplBCL50 = C:\Program Files\EzButton\CplBCL50.EXE
' ''ccApp = "C:\Program Files\Common Files\Symantec Shared\ccApp.exe"
' ''Symantec NetDriver Monitor = C:\PROGRA~1\SYMNET~1\SNDMon.exe
' </pre>
'
' @see Registry
' @see RegistryKeyStatic
'
Option Explicit
Implements IObject
Implements IEnumerable


Private Const REG_OPTION_NON_VOLATILE       As Long = 0
Private Const MAX_KEY_LENGTH                As Long = 255
Private Const DEFAULT_VALUE_NAME            As String = ""


''
' The value types that can be set and retrieved from the Registry.
'
' @param UnknownKind Determines the value type based on the variable type or registry setting.
' @param StringKind Attempts to set or retrieve the value as a string.
' @param DWordKind Attempts to set or retrieve the value as a DWord (Long).
' @param BinaryKind Attempts to set or retrieve the value as a Byte array.
' @param MultiStringKind Attempts to set or retrieve the value as a String array.
' @param ExpandStringKind Attempts to set or retrieve the value as an expandable string.
' @param QWordKind Attempts to set or retrieve the value as a 64-bit value.
'
Public Enum RegistryValueKind
    UnknownKind = 0
    StringKind = 1
    DWordKind = 4
    BinaryKind = 3
    MultiStringKind = 7
    ExpandStringKind = 2
    QWordKind = 11
End Enum

Public Enum RegistryValueOptions
    None = 0
    DoNotExpandEnvironmentVariables = 1
End Enum


Private mHKey       As Long
Private mName       As String
Private mWritable   As Boolean



''
' Returns the name of the key.
'
' @return The name of the key.
'
Public Property Get Name() As String
    Call VerifyHandle
    Name = mName
End Property

''
' Returns a <b>RegistryKey</b> of the requested SubKey with the write permission specified.
'
' @param Name The name of the SubKey to be opened. Any slashes will will be trimmed from both ends.
' @param Writable The permission to modify the opened SubKey.
' @return A new <b>RegistryKey</b> of the opened SubKey.
' @remarks The requested SubKey is opened starting at the location of the current <b>RegistryKey</b>
' node within the Registry.
' <p>If the requested SubKey was not found, then <b>Nothing</b> is returned. No error is thrown.</p>
'
Public Function OpenSubKey(ByVal Name As String, Optional ByVal Writable As Boolean = False) As RegistryKey
    Call VerifyHandle
    
    Name = cString.Trim(Name, "\")
    Call VerifyKey(Name)
    
    Dim Access As Long
    If mWritable Then
        Access = KEY_ALL_ACCESS
    Else
        Access = KEY_READ
    End If
    
    Dim Result As Long
    Dim NewKey As Long
    Result = API.RegOpenKeyEx(mHKey, Name, 0, Access, NewKey)
    If Result <> ERROR_SUCCESS Then Exit Function

    Set OpenSubKey = Cor.NewRegistryKey(NewKey, Path.Combine(mName, Name), Writable)
End Function

''
' Closes the <b>RegistryKey</b> object.
'
' @remarks When the key is closed, then it can no longer be manipulated using the <b>RegistryKey</b>
' <p>If the <b>RegistryKey</b> is a system root key, then it will not be closed.</p>
'
Public Sub CloseKey()
    If (Not IsSystemKey) And (mHKey <> vbNullPtr) Then
        Call RegCloseKey(mHKey)
        mHKey = vbNullPtr
    End If
End Sub

''
' Flushes any changes to the Windows Registry back to disk.
'
' @remarks Generally this does not need to be called. Windows writes back to the disk Registry
' at regular intervals and when the system shuts down. values of other keys written to the
' Registry may also be flushed back to disk as well.
' <p>Only call this function if it is absolutely necessary to be sure the data has been written
' to the Registry. Excessive calls to this function can impact system performance.</p>
'
Public Sub Flush()
    Call VerifyHandle
    
    Dim Result As Long
    Result = RegFlushKey(mHKey)
    If Result <> ERROR_SUCCESS Then IOError Result, "RegistryKey.Flush"
End Sub

''
' Creates a new Windows Registry node.
'
' @param SubKey The name of the new node to be created. Any slashes will be trimmed from the ends.
' @return A <b>RegistryKey</b> to manipulate the new Registry node.
' @remarks If the Registry node already exists, then it is returned.
'
Public Function CreateSubKey(ByVal SubKey As String) As RegistryKey
    Call VerifyHandle
    Call VerifyWritable
    
    SubKey = cString.Trim(SubKey, "\")
    Call VerifyKey(SubKey)
    
    Dim Result As Long
    Dim NewKey As Long
    Result = API.RegCreateKeyEx(mHKey, SubKey, 0, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0, NewKey, 0)
    If Result <> ERROR_SUCCESS Then IOError Result, "RegistryKey"
    
    Set CreateSubKey = Cor.NewRegistryKey(NewKey, Path.Combine(mName, SubKey), True)
End Function

''
' Deletes a node from the Windows Registry.
'
' @param SubKey The node to be deleted.
' @param ThrowOnMissingSubKey Whether to throw an exception if the node was not found.
' @remarks The key node must be empty to be deleted. No sub keys or values are deleted.
' To delete all SubKeys use the <b>DeleteSubKeyTree</b> to recursively delete SubKeys
' and values.
'
Public Sub DeleteSubKey(ByVal SubKey As String, Optional ByVal ThrowOnMissingSubKey As Boolean = True)
    Call VerifyHandle
    Call VerifyWritable
    
    Dim rk As RegistryKey
    Set rk = Me.OpenSubKey(SubKey)
    
    If rk Is Nothing Then
        If ThrowOnMissingSubKey Then _
            Throw Cor.NewArgumentException("The specified SubKey was not found.", "SubKey")
    Else
        If rk.SubKeyCount > 0 Then _
            Throw Cor.NewInvalidOperationException("Cannot delete. SubKey contains keys.")
        
        Dim Result As Long
        Result = API.RegDeleteKey(mHKey, SubKey)
        If Result <> ERROR_SUCCESS Then IOError Result, "RegistryKey"
        rk.CloseKey
    End If
End Sub

''
' Deletes all SubKeys within the specified SubKey to delete.
'
' @param SubKey The Registry node to be deleted.
' @remarks All subkeys and values are deleted recursively. Caution should be used.
'
Public Sub DeleteSubKeyTree(ByVal SubKey As String)
    Call VerifyHandle
    Call VerifyWritable
    
    SubKey = cString.Trim(SubKey, "\")
    Call VerifyKey(SubKey)
    
    Dim rk As RegistryKey
    Set rk = Me.OpenSubKey(SubKey, True)
    
    Dim SubKeys() As String
    SubKeys = rk.GetSubKeyNames
    If cArray.GetLength(SubKeys) > 0 Then
        Dim i As Long
        For i = 0 To UBound(SubKeys)
            Call rk.DeleteSubKeyTree(SubKeys(i))
        Next i
    End If
    Call rk.CloseKey
    
    Dim Result As Long
    Result = API.RegDeleteKey(mHKey, SubKey)
    If Result <> ERROR_SUCCESS Then IOError Result, "RegistryKey.DeleteSubKeyTree"
End Sub

''
' Returns a list of SubKey names within the current SubKey.
'
' @return The list of SubKeys.
' @remarks Values within the SubKey are not included in the list.
' <p>If no SubKeys exist then a zero-length array is returned.</p>
'
Public Function GetSubKeyNames() As String()
    Call VerifyHandle
    
    Dim Buf As String
    Buf = String$(MAX_KEY_LENGTH + 1, 0)
    
    Dim KeyCount As Long
    KeyCount = Me.SubKeyCount
    
    Dim Ret() As String
    Ret = cArray.CreateInstance(ciString, KeyCount)
    
    Do While KeyCount > 0
        KeyCount = KeyCount - 1
        
        Dim BufferSize As Long
        BufferSize = MAX_KEY_LENGTH + 1
        
        Dim Result As Long
        Result = API.RegEnumKeyEx(mHKey, KeyCount, Buf, BufferSize, 0, vbNullString, 0, 0@)
        If Result <> ERROR_SUCCESS Then IOError Result, "GetSubKeyNames"
        
        Ret(KeyCount) = Left$(Buf, BufferSize)
    Loop

    GetSubKeyNames = Ret
End Function

''
' Returns a list of value names within the current SubKey.
'
' @return The list of value names.
' @remarks SubKeys within the SubKey are not included in the list.
'
' <p>Bad Spec: The MSDN says that if a default value exists, it will
' not be included as part of the names returned. However, a simple
' test in Dot NET shows that the default is included in the list.
' An empty string is the name of the default value. We include
' the default name ("") in the returned list.</p>
'
Public Function GetValueNames() As String()
    Call VerifyHandle
    
    Dim Buf As String
    Buf = String$(Registry.MaxValueNameLength, 0)
    
    Dim ValueCount As Long
    ValueCount = Me.ValueCount
    
    Dim Ret() As String
    Ret = cArray.CreateInstance(ciString, ValueCount)
    
    Do While ValueCount > 0
        ValueCount = ValueCount - 1
        
        Dim BufferSize As Long
        BufferSize = Len(Buf)
        
        Dim Result As Long
        Result = API.RegEnumValue(mHKey, ValueCount, Buf, BufferSize, 0, 0, 0, 0)
        If Result <> ERROR_SUCCESS Then IOError Result, "GetValueNames"
        
        Ret(ValueCount) = Left$(Buf, BufferSize)
    Loop
    
    GetValueNames = Ret
End Function

''
' Sets the value of a key value within the SubKey.
'
' @param Name The name of the value to set, or an empty string to set the key default value.
' @param Value The value to write to the Registry.
' @param ValueKind The type of value to be written to the registry.
' @remarks The registry can hold several types of data. <b>RegistryKey</b> supports
' many data types.<br>
' REG_DWORD (Integer numbers)<br>
' REG_QWORD (64-bit integer)<br>
' REG_BINARY (Byte arrays)<br>
' REG_SZ (Strings)<br>
' REG_MULTI_SZ (String arrays)<br>
' REG_EXPAND_SZ (Expandable string)<br>
' <p>Another value type is any class that implements the <b>cObject</b> interface. The
' <i>ToString</i> method is used to write the string representation to the Registry. This
' makes it easy to write such values as <b>cDateTime</b> with ease.</p>
' <p>If saving as a <b>REG_QWORD</b> then numeric values passed in may be adjusted to
' and mapped to an internal vbCurrency datatype to represent the 64-bit value accurately
' in the registry. If a vbLong value of 1 is passed in, then it will be set to a vbCurrency
' value of 0.0001. This will give the proper bit alignment with the 64-bit registry value.
' In order to avoid having the value mapped to a vbCurrency, pass the value in as a vbCurrency.
' In this case, the value is not changed and the 64-bits are saved to the registry as is.
' A vbCurrency of 1 will be saved to the registry as is, not as 0.0001.</p>
'
Public Sub SetValue(ByVal Name As String, ByRef Value As Variant, Optional ByVal ValueKind As RegistryValueKind = UnknownKind)
    Call VerifyWritable
    Call VerifyHandle
    
    If Len(Name) > Registry.MaxValueNameLength Then _
        Throw Cor.NewArgumentException("Registry Value name must not exceed " & Registry.MaxValueNameLength & " characters.", "Name")

    Call ClearException
    On Error GoTo errTrap
    
    Dim Result As Long
    If ValueKind = UnknownKind Then
        Result = SetValueDirect(Name, Value)
    Else
        Result = SetValueWithConvert(Name, Value, ValueKind)
    End If
    On Error GoTo 0
    
    If Result <> ERROR_SUCCESS Then IOError Result
    Exit Sub

errTrap:
    Dim Ex As Exception
    If Catch(Ex) Then
        Throw Ex
    Else