关于写注册表（真的很急）

Question

把 下面的  放入 模块中.
=====================================
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, ByVal lpData As String, lpcbData As Long) As Long
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
Declare Function RegSetValueEx 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
Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
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
    #If Win32 Then
        
        Public Const HKEY_CLASSES_ROOT = &H80000000
        Public Const HKEY_CURRENT_USER = &H80000001
        Public Const HKEY_LOCAL_MACHINE = &H80000002
        Public Const HKEY_USERS = &H80000003
        Public Const KEY_ALL_ACCESS = &H3F
        Public Const REG_OPTION_NON_VOLATILE = 0&
        Public Const REG_CREATED_NEW_KEY = &H1
        Public Const REG_OPENED_EXISTING_KEY = &H2
        Public Const ERROR_SUCCESS = 0&
        Public Const REG_SZ = (1)
    #End If
Type SECURITY_ATTRIBUTES
    
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Boolean
    End TypePublic Function bSetRegValue(ByVal hKey As Long, ByVal lpszSubKey As String, ByVal sSetValue As String, ByVal sValue As String) As Boolean
    
    On Error Resume Next
    Dim phkResult As Long
    Dim lResult As Long
    Dim SA As SECURITY_ATTRIBUTES
    Dim lCreate As Long
    RegCreateKeyEx hKey, lpszSubKey, 0, "", REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, SA, phkResult, lCreate
    lResult = RegSetValueEx(phkResult, sSetValue, 0, REG_SZ, sValue, CLng(Len(sValue) + 1))
    RegCloseKey phkResult
    bSetRegValue = (lResult = ERROR_SUCCESS)
    
End Function
Public Function bGetRegValue(ByVal hKey As Long, ByVal sKey As String, ByVal sSubKey As String) As String
    
    Dim lResult As Long
    Dim phkResult As Long
    Dim dWReserved As Long
    Dim szBuffer As String
    Dim lBuffSize As Long
    Dim szBuffer2 As String
    Dim lBuffSize2 As Long
    Dim lIndex As Long
    Dim lType As Long
    Dim sCompKey As String
    
    lIndex = 0
    lResult = RegOpenKeyEx(hKey, sKey, 0, 1, phkResult)
    Do While lResult = ERROR_SUCCESS And Not (bFound)
        szBuffer = Space(255)
        lBuffSize = Len(szBuffer)
        szBuffer2 = Space(255)
        lBuffSize2 = Len(szBuffer2)
        lResult = RegEnumValue(phkResult, lIndex, szBuffer, lBuffSize, dWReserved, lType, szBuffer2, lBuffSize2)
        If (lResult = ERROR_SUCCESS) Then
            sCompKey = Left(szBuffer, lBuffSize)
            If (sCompKey = sSubKey) Then
                bGetRegValue = Left(szBuffer2, lBuffSize2 - 1)
            End If
        End If
        lIndex = lIndex + 1
        
    Loop
    RegCloseKey phkResult
End Function

Answer 1

抄 别人的. 这会 该 多给分了吧 :)
=====================================
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'Open/Create Options
Private Const REG_OPTION_NON_VOLATILE = 0&
Private Const REG_OPTION_VOLATILE = &H1'Key creation/open disposition
Private Const REG_CREATED_NEW_KEY = &H1
Private Const REG_OPENED_EXISTING_KEY = &H2'masks for the predefined standard access types
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const SPECIFIC_RIGHTS_ALL = &HFFFF'Define severity codes
Private Const ERROR_SUCCESS = 0&
Private Const ERROR_ACCESS_DENIED = 5
Private Const ERROR_INVALID_DATA = 13&
Private Const ERROR_MORE_DATA = 234 '  dderror
Private Const ERROR_NO_MORE_ITEMS = 259
'Structures Needed For Registry Prototypes
Private Type SECURITY_ATTRIBUTES
  nLength As Long
  lpSecurityDescriptor As Long
  bInheritHandle As Boolean
End TypePrivate Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type'Registry Function Prototypes
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 LongPrivate 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 LongPrivate Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As LongPrivate 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 LongPrivate 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 LongPrivate 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 LongPrivate 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 LongPrivate Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" _
  (ByVal hKey As Long, ByVal lpSubKey As String) As LongPrivate Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" _
  (ByVal hKey As Long, ByVal lpValueName As String) As Long' Other declares:
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
Public Enum ERegistryClassConstants
    HKEY_CLASSES_ROOT = &H80000000
    HKEY_CURRENT_USER = &H80000001
    HKEY_LOCAL_MACHINE = &H80000002
    HKEY_USERS = &H80000003
End EnumPublic Enum ERegistryValueTypes
'Predefined Value Types
    REG_NONE = (0)                        'No value type
    REG_SZ = (1)                          'Unicode nul terminated string
    REG_EXPAND_SZ = (2)                    'Unicode nul terminated string w/enviornment var
    REG_BINARY = (3)                      'Free form binary
    REG_DWORD = (4)                        '32-bit number
'    REG_DWORD_LITTLE_ENDIAN = (4)          '32-bit number (same as REG_DWORD)
'    REG_DWORD_BIG_ENDIAN = (5)            '32-bit number
'    REG_LINK = (6)                        'Symbolic Link (unicode)
    REG_MULTI_SZ = (7)                    'Multiple Unicode strings
'    REG_RESOURCE_LIST = (8)                'Resource list in the resource map
'    REG_FULL_RESOURCE_DESCRIPTOR = (9)    'Resource list in the hardware description
'    REG_RESOURCE_REQUIREMENTS_LIST = (10)
End EnumPrivate Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const LANG_NEUTRAL = &H0
Private Const SUBLANG_DEFAULT = &H1
Private Const ERROR_BAD_USERNAME = 2202&
Private Declare Function GetLastError Lib "Kernel32" () As Long
Private Declare Function FormatMessage Lib "Kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long
Private m_hClassKey As Long
Private m_sSectionKey As String
Private m_sValueKey As String
Private m_vValue As Variant
Private m_sSetValue As String
Private m_vDefault As Variant
Private m_eValueType As ERegistryValueTypes
Private sError As StringPublic Property Get KeyExists() As Boolean    Dim hKey As Long
    If RegOpenKeyEx(m_hClassKey, m_sSectionKey, 0, 1, hKey) = ERROR_SUCCESS Then
        KeyExists = True
        RegCloseKey hKey
    Else
        KeyExists = False
    End If
    
End PropertyPublic Function CreateKey() As Long    Dim tSA As SECURITY_ATTRIBUTES
    Dim hKey As Long
    Dim lCreate As Long
    
    'Open or Create the key
    CreateKey = RegCreateKeyEx(m_hClassKey, m_sSectionKey, 0, "", REG_OPTION_NON_VOLATILE, _
                KEY_ALL_ACCESS, tSA, hKey, lCreate)
    If CreateKey Then
        sError = GetErrorDescription(CreateKey)
    Else
        'Close the key
        RegCloseKey hKey
    End If
    
End FunctionPublic Function DeleteKey() As Long    DeleteKey = RegDeleteKey(m_hClassKey, m_sSectionKey)
    If DeleteKey Then
        sError = GetErrorDescription(DeleteKey)
    End If
    
End FunctionPublic Function DeleteValue() As Long    Dim e As Long
    Dim hKey As Long    DeleteValue = RegOpenKeyEx(m_hClassKey, m_sSectionKey, 0, KEY_ALL_ACCESS, hKey)
    If DeleteValue Then
        sError = GetErrorDescription(DeleteValue)
    Else
        DeleteValue = RegDeleteValue(hKey, m_sValueKey)
        If DeleteValue Then
            sError = GetErrorDescription(DeleteValue)
        End If
    End IfEnd FunctionPublic Property Get Value() As Variant    Dim vValue As Variant
    Dim cData As Long, sData As String, ordType As Long, e As Long
    Dim hKey As Long    e = RegOpenKeyEx(m_hClassKey, m_sSectionKey, 0, KEY_QUERY_VALUE, hKey)
    
    e = RegQueryValueExLong(hKey, m_sValueKey, 0&, ordType, 0&, cData)
    If e And e <> ERROR_MORE_DATA Then
        Value = m_vDefault
        Exit Property
    End If
    
    m_eValueType = ordType
    Select Case ordType
        Case REG_DWORD ', REG_DWORD_LITTLE_ENDIAN
            Dim iData As Long
            e = RegQueryValueExLong(hKey, m_sValueKey, 0&, ordType, iData, cData)
            vValue = CLng(iData)
            
'        Case REG_DWORD_BIG_ENDIAN  ' Unlikely, but you never know
'            Dim dwData As Long
'            e = RegQueryValueExLong(hKey, m_sValueKey, 0&, ordType, dwData, cData)
'            vValue = SwapEndian(dwData)
            
        Case REG_SZ, REG_MULTI_SZ ' Same thing to Visual Basic
            If cData <= 0 Then
                vValue = ""
            Else
                sData = String$(cData - 1, 0)
                e = RegQueryValueExStr(hKey, m_sValueKey, 0&, ordType, sData, cData)
                vValue = StripTerminator(sData)
            End If
            
'        Case REG_EXPAND_SZ
'            If cData <= 0 Then
'                vValue = ""
'            Else
'                sData = String$(cData - 1, 0)
'                e = RegQueryValueExStr(hKey, m_sValueKey, 0&, ordType, sData, cData)
'                vValue = ExpandEnvStr(sData)
'            End If
            
        Case Else ' Catch REG_BINARY and anything else
            Dim abData() As Byte
            ReDim abData(cData)
            e = RegQueryValueExByte(hKey, m_sValueKey, 0&, ordType, abData(0), cData)
            vValue = abData
    End Select
    Value = vValue
    
End PropertyPublic Property Let Value(ByVal vValue As Variant)    Dim ordType As Long
    Dim c As Long
    Dim hKey As Long
    Dim e As Long
    Dim lCreate As Long
    Dim tSA As SECURITY_ATTRIBUTES    'Open or Create the key
    e = RegCreateKeyEx(m_hClassKey, m_sSectionKey, 0, "", REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, tSA, hKey, lCreate)
    
    If e Then
        sError = GetErrorDescription(e)
    Else        Select Case m_eValueType
        Case REG_BINARY
            If (VarType(vValue) = vbArray + vbByte) Then
                Dim ab() As Byte
                ab = vValue
                ordType = REG_BINARY
                c = UBound(ab) - LBound(ab) - 1
                e = RegSetValueExByte(hKey, m_sValueKey, 0&, ordType, ab(0), c)
            Else
                sError = GetErrorDescription(26001)
            End If
        Case REG_DWORD ', REG_DWORD_BIG_ENDIAN, REG_DWORD_LITTLE_ENDIAN
            If (VarType(vValue) = vbInteger) Or (VarType(vValue) = vbLong) Then
                Dim i As Long
                i = CLng(vValue)
                ordType = REG_DWORD
                e = RegSetValueExLong(hKey, m_sValueKey, 0&, ordType, i, 4)
            End If
        Case REG_SZ, REG_EXPAND_SZ
            Dim s As String, iPos As Long
            s = vValue
            If s = "" Then s = " "
            ordType = REG_SZ
            ' Assume anything with two non-adjacent percents is expanded string
            iPos = InStr(s, "%")
            If iPos Then
                If InStr(iPos + 2, s, "%") Then ordType = REG_EXPAND_SZ
            End If
            c = LenB(s) + 1
            e = RegSetValueExStr(hKey, m_sValueKey, 0&, ordType, s, c)
            
        ' User should convert to a compatible type before calling
        Case Else
            e = ERROR_INVALID_DATA
            
        End Select
        
        If Not e Then
            m_vValue = vValue
        Else
            sError = GetErrorDescription(vbObjectError + 1048 + 26001)
        End If
        
        'Close the key
        RegCloseKey hKey
    
    End If
    
End PropertyPublic Function EnumerateValues(ByRef sKeyNames() As String, ByRef iKeyCount As Long) As Long
    
    Dim lResult As Long
    Dim hKey As Long
    Dim sName As String
    Dim lIndex As Long
  
    iKeyCount = 0
    Erase sKeyNames()
    
    lIndex = 0
    lResult = RegOpenKeyEx(m_hClassKey, m_sSectionKey, 0, KEY_QUERY_VALUE, hKey)
    
    If (lResult = ERROR_SUCCESS) Then
        Do
            'Set buffer space
            sName = String$(255, 0)
            'Get value name:
            lResult = RegEnumValue(hKey, lIndex, sName, 255, 0&, 0&, 0&, 0&)
            If (lResult = ERROR_SUCCESS) Then
                sName = StripTerminator(sName)
                iKeyCount = iKeyCount + 1
                ReDim Preserve sKeyNames(1 To iKeyCount) As String
                sKeyNames(iKeyCount) = sName
            Else
              Exit Do
            End If
            lIndex = lIndex + 1
        Loop
        EnumerateValues = 0
        RegCloseKey hKey
    Else
        EnumerateValues = lResult
        sError = GetErrorDescription(EnumerateValues)
    End If
    
End FunctionPublic Function EnumerateSections(ByRef sSect() As String, ByRef iSectCount As Long) As Long
    
    Dim lResult As Long
    Dim hKey As Long
    Dim szBuffer As String
    Dim lIndex As Long  iSectCount = 0
  Erase sSect
  lIndex = 0  lResult = RegOpenKeyEx(m_hClassKey, m_sSectionKey, 0, KEY_ENUMERATE_SUB_KEYS, hKey)
  
  If lResult = ERROR_SUCCESS Then
        Do While lResult = ERROR_SUCCESS
            'Set buffer space
            szBuffer = String$(255, 0)
          'Get next value
            lResult = RegEnumKey(hKey, lIndex, szBuffer, 255)
                                  
            If (lResult = ERROR_SUCCESS) Then
                iSectCount = iSectCount + 1
                ReDim Preserve sSect(1 To iSectCount)
                sSect(iSectCount) = StripTerminator(szBuffer)
            End If
            lIndex = lIndex + 1
        Loop
        RegCloseKey hKey
        EnumerateSections = 0
    Else
        EnumerateSections = lResult
        sError = GetErrorDescription(EnumerateSections)
    End If
    
End FunctionPublic Property Get RegError() As String
    RegError = sError
End PropertyPublic Property Get ValueType() As ERegistryValueTypes
    ValueType = m_eValueType
End Property
Public Property Let ValueType(ByVal eValueType As ERegistryValueTypes)
    m_eValueType = eValueType
End Property
Public Property Get ClassKey() As ERegistryClassConstants
    ClassKey = m_hClassKey
End Property
Public Property Let ClassKey(ByVal eKey As ERegistryClassConstants)
    m_hClassKey = eKey
End Property
Public Property Get SectionKey() As String
    SectionKey = m_sSectionKey
End Property
Public Property Let SectionKey(ByVal sSectionKey As String)
    m_sSectionKey = sSectionKey
End Property
Public Property Get ValueKey() As String
    ValueKey = m_sValueKey
End Property
Public Property Let ValueKey(ByVal sValueKey As String)
    m_sValueKey = sValueKey
End Property
Public Property Get Default() As Variant
    Default = m_vDefault
End Property
Public Property Let Default(ByVal vDefault As Variant)
    m_vDefault = vDefault
End PropertyPrivate Function SwapEndian(ByVal dw As Long) As Long
    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
End FunctionPrivate Function ExpandEnvStr(sData As String) As String
    Dim c As Long, s As String
    ' Get the length
    s = "" ' Needed to get around Windows 95 limitation
    c = ExpandEnvironmentStrings(sData, s, c)
    ' Expand the string
    s = String$(c - 1, 0)
    c = ExpandEnvironmentStrings(sData, s, c)
    ExpandEnvStr = s
    
End FunctionPrivate Function StripTerminator(sInput As String) As String
    Dim ZeroPos As Integer
    'Search the first chr$(0)
    ZeroPos = InStr(1, sInput, vbNullChar)
    If ZeroPos > 0 Then
        StripTerminator = Left$(sInput, ZeroPos - 1)
    Else
        StripTerminator = sInput
    End If
End FunctionPrivate Function GetErrorDescription(lErr As Long) As String    Dim Buffer As String
    Dim l As Long
    'Create a string buffer
    Buffer = Space(255)
    'Format the message string
    l = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, lErr, LANG_NEUTRAL, Buffer, 255, ByVal 0&)
    If l = 0 Then
        GetErrorDescription = GetErrorDescription(GetLastError)
    Else
        GetErrorDescription = StripTerminator(Buffer)
    End If
    
End Function把上面的代码存为cRegistry.cls,使用是示例如下：
    Dim cReg As New cRegistry
    cReg.ClassKey = HKEY_CURRENT_USER
    cReg.ValueType = REG_SZ
    cReg.SectionKey = "Software\AAA"
    If cReg.KeyExists Then
        cReg.SectionKey = "Software\AAA\系统配置信息"
        cReg.ValueKey = "缓存路径"
        astr = cReg.Value
    end if 

Answer 2

为什么要这样麻烦！
你直接搞到 VB&VBA Setting 下面不就行了！

Answer 3

登录数据库Registry的Value的存取--写入某个Key指定名称的值要完成Value的写入，需要用到API函数RegSetValueEx。下面是它的一些说明。
VB声明
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
参数：
hKey:Key Handle
lpValueName:Value名称
Reserved:保留参数，具体使用时置为0即可
dwType:数据类型
lpData:所设置的数据，注意这一参数被定义成lpData As Any，所以要传入字符串数据时别忘了在参数前加保留字ByVal
cbData:数据的长度。注意：如果写入的数据属于REG_SZ、REG_EXPAND_SZ、REG_MULTI_SZ类型时，则这个长度应该包含chr(0)字符。
返回值: =0,表示成功；≠0,表示失败。由于RegSetValueEx的参数和RegQueryValueEx完全一样，他们的使用方式也差不多，因此，在这里我只是举出下面的例子来简略地说一下就行。
'下面的例子在HKEY_CURRENT_USER\Software\SetValue下建立
'Default Value-->REG_SZ "VB操作注册表"
'str1 -->REG_SZ "我爱我的祖国"
'str2 -->REG_EXPAND_SZ "%WinDir%Command"
'str3 -->REG_MULTI_SZ "hongqt" + Chr(0) + "lstc" + Chr(0) + "edu" + Chr(0) + "cn" + Chr(0) + Chr(0) 
'LongData -->REG_DWORD 99999
'BinaryData -->REG_BINARY 11,22,33,44,aa,bb,cc,dd
'*******************setvalue.bas ************************Option Explicit 
Public Const HKEY_CLASSES_ROOT = &H80000000 
Public Const HKEY_CURRENT_USER = &H80000001 
Public Const HKEY_LOCAL_MACHINE = &H80000002 
Public Const HKEY_USERS = &H80000003 
Public Const HKEY_PERFORMANCE_DATA = &H80000004 
Public Const HKEY_CURRENT_CONFIG = &H80000005 
Public Const HKEY_DYN_DATA = &H80000006 Public Const REG_NONE = 0 
Public Const REG_SZ = 1 
Public Const REG_EXPAND_SZ = 2 
Public Const REG_BINARY = 3 
Public Const REG_DWORD = 4 
Public Const REG_DWORD_BIG_ENDIAN = 5 
Public Const REG_MULTI_SZ = 7 
'注意下面的函数声明要在一行内写完 
Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long 
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long 
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 Sub Main() 
Dim hKey As Long 
RegCreateKey HKEY_CURRENT_USER, "Software\SetValue", hKey 
RegSetValueEx hKey, "", 0, REG_SZ, ByVal "VB操作注册表", 13 
RegSetValueEx hKey, "Str1", 0, REG_SZ, ByVal "我爱我的祖国", 13 
RegSetValueEx hKey, "Str2", 0, REG_EXPAND_SZ, ByVal "%WinDir%Command", 16 
Dim S As String 
S = "hongqt" + Chr(0) + "lstc" + Chr(0) + "edu" + Chr(0) + "cn" + Chr(0) + Chr(0) 
RegSetValueEx hKey, "Str3", 0, REG_MULTI_SZ, ByVal S, 20 Dim L As Long 
L = 99999 
RegSetValueEx hKey, "LongData", 0, REG_DWORD, L, 4 Dim bArr(0 To 7) As Byte 
bArr(0) = &H11: bArr(1) = &H22: bArr(2) = &H33: bArr(3) = &H44 
bArr(4) = &HAA: bArr(5) = &HBB: bArr(6) = &HCC: bArr(7) = &HDD 
RegSetValueEx hKey, "BinaryData", 0, REG_BINARY, bArr(0), 8 MsgBox "已完成 RegSetValueEx! 请检查 HKEY_CURRENT_USER\Software\SetValue 的内容。" 
RegCloseKey hKey End Sub