Option Explicit
' =========================================================
' Class:      cRegistry
' Author:     Fatant Studio.
' Progenitor: Steve McMahon (21 Feb 1997) [http://vbaccelerator.com]
' Date  :     12 Feb 2001
' ---------------------------------------------------------'Registry Specific Access Rights
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

解决方案 »

  1.   

    发邮件给我:[email protected],给你操作注册表的DLL(含源码)。
      

  2.   

       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 至于类里就不用管拉。
      

  3.   

    http://www.csdn.net/expert/topic/376/376724.shtm
    用法:
        CreateKey "HKEY_CURRENT_USER\Software\School\Test\Settings"
    SetStringValue "HKEY_CURRENT_USER\Software\School\Test\Settings", "LastUser", "I"
        GetLastUser = GetStringValue("HKEY_CURRENT_USER\Software\School\Test\Settings", "LastUser")
      

  4.   

    To:Amoon(阿木) 
    能否把你的操作注册表的DLL(含源码)给我一份呢?
    我的信箱:[email protected]
      

  5.   


      再给你一个好东东:http://www.sqreg.com/file/vb/reg_01.htm
      

  6.   

    to uguess(uguess):嘿嘿,又跑来拆我的台?
      

  7.   

    to hlf() : 发了,收吧。 :)
      

  8.   

    Microsoft原本就有reg处理的dll,
    请在project中加入"registry access control"的组件,
    再按"F2", 从列表中选择"regtool5",即可看到MS提供的function.
      

  9.   

    to 阿愚:您的标准模块中,CreateKey、SetStringValue、GetStringValue这三个函数的功能很好用,但我用DeleteKey却删不掉用CreateKey创建的子键,不知是为何?而我还有另外两个小需求也无法实现:
    1、如果我不想删子键,只想删该子键下的键值名与键值数据呢?
    2、怎样判断某个子键是否存在?to uguess: 我按您写的做了个cRegistry.cls后,
        把代码段"Dim cReg As New cRegistry
        cReg.ClassKey = HKEY_CURRENT_USER
        cReg.ValueType = REG_SZ
        cReg.SectionKey = "Software\AAA"  "放入窗体的通用说明中,(AAA用某子键代替)
        再在按钮的CLICK中输入" If cReg.KeyExists Then
            cReg.SectionKey = "Software\AAA\系统配置信息"
            cReg.ValueKey = "缓存路径"
            astr = cReg.Value
        end if "   "后,运行时,系统提示"要求对象",黄色光带指向If cReg.KeyExists Then这一句。不知是为何?而且说实话,我并不知道上面的IF ....END IF 段是在做什么?它能实现我需要的"创建、获取、删除、是否存在某个键或键值"功能吗?   另外很感谢您给的那个网址。to 阿木:我给您发了几次邮件,不知何故,都被系统退了回来,故在此写上我的邮箱:[email protected].
        如果您能发DLL过来的话,请就使用方法略加说明几句好吗?to shiyang: 我不知道您的"请在project中加入"registry access control"的组件"是指在哪儿加入?我在工程-部件与引用中 都没找到registry access control这一项。感谢各位高手的帮助,请继续指点!
      

  10.   

    to shiyang:  虽然在写这个东西的时候没有写设计文档,但在源码(我的东西全都是免费的。:))里有详细的注释,你肯定看得懂的。:)好了,收邮件吧,:)
      

  11.   

    啊,搞错对象啦~~~!幻想者() 我已经给你发过去了。hehe ...................
      

  12.   


      是这样的,如果你需要定义全局或是局部的变量,就把 Dim cReg As New cRegistry
    放在通用声明段,其余的
        cReg.ClassKey = HKEY_CURRENT_USER
        cReg.ValueType = REG_SZ
        cReg.SectionKey = "Software\AAA"  
        是放在具体的代码里的。
        
        这个  cReg.KeyExists 就是判断某个键是否存在的;
        创建一个键只须 先将键名赋值,然后用 cReg.CreateKey 即可,如:
        cReg.SectionKey = "Software\AAA" 
        cReg.CreateKey 
        这样就创建了一个键AAA。
        同样,删除一个键只须 先将键名赋值,然后用 cReg.DeleteKey 即可,如:
        cReg.SectionKey = "Software\AAA" 
        cReg.DeleteKey 
        这样就删除了一个键AAA。    其它的使用方法都类似。不过如果你对VB的类的使用没有经验的话,最好找一本基础的书看看相关的内容。    说实在的,这是目前我见过的最好的处理注册表相关操作的代码,功能非常强大,你需要慢慢领会。    
       
      

  13.   

    to uguess(uguess):顺便问一下,它都有哪些功能啊?
      

  14.   


    老 U 啊,跑哪儿去啦,我再等你回话呐!  老 U 啊,跑哪儿去啦,我再等你回话呐!老 U 啊,跑哪儿去啦,我再等你回话呐!  老 U 啊,跑哪儿去啦,我再等你回话呐!  老 U 啊,跑哪儿去啦,我再等你回话呐!  老 U 啊,跑哪儿去啦,我再等你回话呐!  
      

  15.   

    to 老u、阿愚:  谢指点,我受益不少。
    to 阿木:感谢您寄来的DLL,您的程序写得很严谨,注释也很详细,
    然而不好意思的是我确实从没在程序中直接调用过DLL,因此老是出错,现以在HKEY_CLASSES_ROOT\.art下创建一个test子键为例,把我的做法写在下面,
    请您指出错在哪些地方,好吗?1、新建一个窗体,在其上放一个按钮。
    2、在"工程--引用"中把AMN Regitry 1.00前面的方框选中,
    3、在"通用--声明"中定义两个变量:Dim newreg As New Registry
             Dim a As Long
    4、在按钮的CLICK中加入一句代码:
       a = newreg.REG_CreateKey(HKEY_CLASSES_ROOT\.art, test, REG_OPTION_RESERVED, KEY_ALL_ACCESS)
    可运行时,系统提示:"无效的引用"或"byref参数类型不符"等,我便加了几个引号,变成:
       a =newreg.REG_CreateKey"HKEY_CLASSES_ROOT\.art", "test",REG_OPTION_RESERVED, KEY_ALL_ACCESS)
    运行时,系统又提示:"类型不匹配"
    请就创建、删除子键举一至两例。得到解答后,我将尽快结帐,以谢各位!
      

  16.   

    回复人: ww28(ww28) (2001-11-25 22:05:10)  得0分 
    '操作注册彪函数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 ERROR_SUCCESS = 0&' Registry API prototypesDeclare Function RegCloseKey Lib "advapi32.DLL" (ByVal hKey As Long) As Long
    Declare Function RegCreateKey Lib "advapi32.DLL" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
    Declare Function RegDeleteKey Lib "advapi32.DLL" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
    Declare Function RegDeleteValue Lib "advapi32.DLL" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
    Declare Function RegOpenKey Lib "advapi32.DLL" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
    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
    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
    Public Const REG_SZ = 1                        ' Unicode nul terminated string
    Public Const REG_DWORD = 4                      ' 32-bit numberPublic Sub savekey(hKey As Long, strPath As String)
    Dim keyhand&
    r = RegCreateKey(hKey, strPath, keyhand&)
    r = RegCloseKey(keyhand&)
    End SubPublic Function getstring(hKey As Long, strPath As String, strValue As String)Dim keyhand As Long
    Dim datatype As Long
    Dim lResult As Long
    Dim strBuf As String
    Dim lDataBufSize As Long
    Dim intZeroPos As Integer
    r = RegOpenKey(hKey, strPath, keyhand)
    lResult = RegQueryValueEx(keyhand, strValue, 0&, lValueType, ByVal 0&, lDataBufSize)
    If lValueType = REG_SZ Then
        strBuf = String(lDataBufSize, " ")
        lResult = RegQueryValueEx(keyhand, strValue, 0&, 0&, ByVal strBuf, lDataBufSize)
        If lResult = ERROR_SUCCESS Then
            intZeroPos = InStr(strBuf, Chr$(0))
            If intZeroPos > 0 Then
                getstring = Left$(strBuf, intZeroPos - 1)
            Else
                getstring = strBuf
            End If
        End If
    End If
    End Function
    Public Sub savestring(hKey As Long, strPath As String, strValue As String, strdata As String)
    Dim keyhand As Long
    Dim r As Long
    r = RegCreateKey(hKey, strPath, keyhand)
    r = RegSetValueEx(keyhand, strValue, 0, REG_SZ, ByVal strdata, reglen)
    'r = RegSetValueEx(keyhand, strValue, 0, REG_SZ, ByVal strdata, Len(strdata))r = RegCloseKey(keyhand)
    End Sub
    Function getdword(ByVal hKey As Long, ByVal strPath As String, ByVal strValueName As String) As Long
    Dim lResult As Long
    Dim lValueType As Long
    Dim lBuf As Long
    Dim lDataBufSize As Long
    Dim r As Long
    Dim keyhand As Longr = RegOpenKey(hKey, strPath, keyhand)' Get length/data type
    lDataBufSize = 4
        
    lResult = RegQueryValueEx(keyhand, strValueName, 0&, lValueType, lBuf, lDataBufSize)If lResult = ERROR_SUCCESS Then
        If lValueType = REG_DWORD Then
            getdword = lBuf
        End If
    'Else
    '    Call errlog("GetDWORD-" & strPath, False)
    End Ifr = RegCloseKey(keyhand)
        
    End FunctionFunction SaveDword(ByVal hKey As Long, ByVal strPath As String, ByVal strValueName As String, ByVal lData As Long)
        Dim lResult As Long
        Dim keyhand As Long
        Dim r As Long
        r = RegCreateKey(hKey, strPath, keyhand)
        lResult = RegSetValueEx(keyhand, strValueName, 0&, REG_DWORD, lData, 4)
        'If lResult <> error_success Then Call errlog("SetDWORD", False)
        r = RegCloseKey(keyhand)
    End FunctionPublic Function DeleteKey(ByVal hKey As Long, ByVal strKey As String)
    Dim r As Long
    r = RegDeleteKey(hKey, strKey)
    End FunctionPublic Function DeleteValue(ByVal hKey As Long, ByVal strPath As String, ByVal strValue As String)
    Dim keyhand As Long
    r = RegOpenKey(hKey, strPath, keyhand)
    r = RegDeleteValue(keyhand, strValue)
    r = RegCloseKey(keyhand)
    End Function'调用
    Call savestring(HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\explorer\Advanced\Folder", "a\b", 2)Call SaveDword ……写2进制健getdword 得到2进制健getstring得到字符串健
     
      

  17.   

    我有控件要不要?
    [email protected]