"C:\Program Files\Microsoft Visual Studio\VB98\Template\Code\注册表访问.bas"

解决方案 »

  1.   

    ' 这个模块用于读和写注册表关键字。
    ' 不同于VB 的内部注册表访问方法,它可以
    ' 通过字符串的值来读和写任何注册表关键字。
    Option Explicit
    '---------------------------------------------------------------
    '-注册表 API 声明...
    '---------------------------------------------------------------
    Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey 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, ByRef lpSecurityAttributes As SECURITY_ATTRIBUTES, ByRef phkResult As Long, ByRef lpdwDisposition As Long) As Long
    Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
    Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
    Private Declare Function RegSetValueEx Lib "advapi32" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long'---------------------------------------------------------------
    '- 注册表 Api 常数...
    '---------------------------------------------------------------
    ' Reg Data Types...
    Const REG_SZ = 1                         ' Unicode空终结字符串
    Const REG_EXPAND_SZ = 2                  ' Unicode空终结字符串
    Const REG_DWORD = 4                      ' 32-bit 数字' 注册表创建类型值...
    Const REG_OPTION_NON_VOLATILE = 0       ' 当系统重新启动时,关键字被保留' 注册表关键字安全选项...
    Const READ_CONTROL = &H20000
    Const KEY_QUERY_VALUE = &H1
    Const KEY_SET_VALUE = &H2
    Const KEY_CREATE_SUB_KEY = &H4
    Const KEY_ENUMERATE_SUB_KEYS = &H8
    Const KEY_NOTIFY = &H10
    Const KEY_CREATE_LINK = &H20
    Const KEY_READ = KEY_QUERY_VALUE + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + READ_CONTROL
    Const KEY_WRITE = KEY_SET_VALUE + KEY_CREATE_SUB_KEY + READ_CONTROL
    Const KEY_EXECUTE = KEY_READ
    Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
                           KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
                           KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
                         
    ' 注册表关键字根类型...
    Const HKEY_CLASSES_ROOT = &H80000000
    Const HKEY_CURRENT_USER = &H80000001
    Const HKEY_LOCAL_MACHINE = &H80000002
    Const HKEY_USERS = &H80000003
    Const HKEY_PERFORMANCE_DATA = &H80000004' 返回值...
    Const ERROR_NONE = 0
    Const ERROR_BADKEY = 2
    Const ERROR_ACCESS_DENIED = 8
    Const ERROR_SUCCESS = 0'---------------------------------------------------------------
    '- 注册表安全属性类型...
    '---------------------------------------------------------------
    Private Type SECURITY_ATTRIBUTES
        nLength As Long
        lpSecurityDescriptor As Long
        bInheritHandle As Boolean
    End Type'-------------------------------------------------------------------------------------------------
    'sample usage - Debug.Print UpodateKey(HKEY_CLASSES_ROOT, "keyname", "newvalue")
    '-------------------------------------------------------------------------------------------------
    Public Function UpdateKey(KeyRoot As Long, KeyName As String, SubKeyName As String, SubKeyValue As String) As Boolean
        Dim rc As Long                                      ' 返回代码
        Dim hKey As Long                                    ' 处理一个注册表关键字
        Dim hDepth As Long                                  '
        Dim lpAttr As SECURITY_ATTRIBUTES                   ' 注册表安全类
      

  2.   


        
        lpAttr.nLength = 50                                 ' 设置安全属性为缺省值...
        lpAttr.lpSecurityDescriptor = 0                     ' ...
        lpAttr.bInheritHandle = True                        ' ...    '------------------------------------------------------------
        '- 创建/打开注册表关键字...
        '------------------------------------------------------------
        rc = RegCreateKeyEx(KeyRoot, KeyName, _
                            0, REG_SZ, _
                            REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, lpAttr, _
                            hKey, hDepth)                   ' 创建/打开//KeyRoot//KeyName
        
        If (rc <> ERROR_SUCCESS) Then GoTo CreateKeyError   ' 错误处理...
        
        '------------------------------------------------------------
        '- 创建/修改关键字值...
        '------------------------------------------------------------
        If (SubKeyValue = "") Then SubKeyValue = " "        ' 要让RegSetValueEx() 工作需要输入一个空格...
        
        ' 创建/修改关键字值
        rc = RegSetValueEx(hKey, SubKeyName, _
                           0, REG_SZ, _
                           SubKeyValue, LenB(StrConv(SubKeyValue, vbFromUnicode)))
                           
        If (rc <> ERROR_SUCCESS) Then GoTo CreateKeyError   ' 错误处理
        '------------------------------------------------------------
        '- 关闭注册表关键字...
        '------------------------------------------------------------
        rc = RegCloseKey(hKey)                              ' 关闭关键字
        
        UpdateKey = True                                    ' 返回成功
        Exit Function                                       ' 退出
    CreateKeyError:
        UpdateKey = False                                   ' 设置错误返回代码
        rc = RegCloseKey(hKey)                              ' 试图关闭关键字
    End Function'-------------------------------------------------------------------------------------------------
    'sample usage - Debug.Print GetKeyValue(HKEY_CLASSES_ROOT, "COMCTL.ListviewCtrl.1\CLSID", "")
    '-------------------------------------------------------------------------------------------------
    Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String) As String
        Dim i As Long                                           ' 循环计数器
        Dim rc As Long                                          ' 返回代码
        Dim hKey As Long                                        ' 处理打开的注册表关键字
        Dim hDepth As Long                                      '
        Dim sKeyVal As String
        Dim lKeyValType As Long                                 ' 注册表关键字数据类型
        Dim tmpVal As String                                    ' 注册表关键字的临时存储器
        Dim KeyValSize As Long                                  ' 注册表关键字变量尺寸
        
        ' 在 KeyRoot {HKEY_LOCAL_MACHINE...} 下打开注册表关键字
        '------------------------------------------------------------
        rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' 打开注册表关键字
        
        If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' 处理错误...
        
        tmpVal = String$(1024, 0)                             ' 分配变量空间
        KeyValSize = 1024                                       ' 标记变量尺寸
        
        '------------------------------------------------------------
        ' 检索注册表关键字的值...
        '------------------------------------------------------------
        rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
                             lKeyValType, tmpVal, KeyValSize)    ' 获得/创建关键字的值
                            
        If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' 错误处理
          
        tmpVal = Left$(tmpVal, InStr(tmpVal, Chr(0)) - 1)    '------------------------------------------------------------
        ' 决定关键字值的转换类型...
        '------------------------------------------------------------
        Select Case lKeyValType                                  ' 搜索数据类型...
        Case REG_SZ, REG_EXPAND_SZ                              ' 字符串注册表关键字数据类型
            sKeyVal = tmpVal                                     ' 复制字符串的值
        Case REG_DWORD                                          ' 四字节注册表关键字数据类型
            For i = Len(tmpVal) To 1 Step -1                    ' 转换每一位
                sKeyVal = sKeyVal + Hex(Asc(Mid(tmpVal, i, 1)))   ' 一个字符一个字符地生成值。
            Next
            sKeyVal = Format$("&h" + sKeyVal)                     ' 转换四字节为字符串
        End Select
        
        GetKeyValue = sKeyVal                                   ' 返回值
        rc = RegCloseKey(hKey)                                  ' 关闭注册表关键字
        Exit Function                                           ' 退出
        
    GetKeyError:    ' 错误发生过后进行清除...
        GetKeyValue = vbNullString                              ' 设置返回值为空字符串
        rc = RegCloseKey(hKey)                                  ' 关闭注册表关键字
    End Function
      

  3.   

    VB操作注册表--所用函数收录
    梦里水乡 VB操作注册表--所用函数收录RegOpenKey--取得SubKey的HkeyVB声明 Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" 
    (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long 
    参数类型及说明:
    hKey:Key Handle
    lpSubKey:SubKey名称或路径
    phkResult:若RegOpenKey执行成功,则这一参数返回Subkey的hKey.返回值: =0,表示成功;≠0,表示失败。[注意这一点与别的API函数不太一样]e.g:
    ret = RegOpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft", hKey) *************************************************************************RegCreateKey函数:建立SubKey
    VB声明 Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" 
    (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
    它的参数用法与RegOpenKey一样。所不同的是RegOpenKey只能打开已经有的SubKey,而RegCreateKey则可以建立SubKey,比较特别的是,如果调用RegCreateKey所建立的SubKey是一个已经存在的SubKey,则它的功能和RegOpenKey相同。由于RegCreateKey的这种特性,有的程序员干脆不用RegOpenKey,而用RegCreateKey来统一代替RegOpenKey。
    e.g:
    ret = RegCreateKey(HKEY_LOCAL_MACHINE, "SOFTWARE\Hongqt", hKey)************************************************************************* RegClose函数:关闭SubKey
    Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long 
    当我们不再存取Registry时,将打开或建立的SubKey关闭是一个比较好的习惯,就正如我们在使用C语言的文件打开函数后必须要关闭一样。
    e.g:
    ret = RegOpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft", hKey) 
    ....
    RegClose hkey
    *************************************************************************RegQueryValue--读取某Key的默认值(default value)VB声明
    Declare Function RegQueryValue Lib "advapi32.dll" Alias "RegQueryValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpValue As String, lpcbValue As Long) As Long 
    hKey: Key Handle
    lpSubKey:SubKey名称路径
    lpValue:返回读取的Default Value
    lpcbValue:传入lpValue参数的长度,若成功读取了默认值default value,则返回default value字符串的长度(含chr(0))这个和C语言中字符串的处理相似,都是以chr(0)作为结束符。返回值: =0,表示成功;≠0,表示失败。
    e.g:
    ret = RegQueryValue(hKey, Subkey, "", lenS) ************************************************************************* RegSetValue--删除某Key的默认值(default value)VB声明
    Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long 
    hKey:Key Handle
    lpSubKey:Subkey名称或路径
    dwType:数据类型,但在这里只能接受REG_SZ[字符串类型]
    lpData:所设置的字符串
    cbData:lpData字符串的长度,这一长度包括chr(0)字符。
    关于dwType的可能取值
    Enum ValueType 
    REG_NONE = 0 
    REG_SZ = 1 
    REG_EXPAND_SZ = 2 
    REG_BINARY = 3 
    REG_DWORD = 4 
    REG_DWORD_BIG_ENDIAN = 5 
    REG_MULTI_SZ = 7 
    End Enum e.g:
    Function SetDefaultValue(ByVal hKey As Long, ByVal Subkey As String, ByVal Value As String) As Boolean 
    Dim ret As Long, lenS As Long, S As String 
    ret = RegSetValue(hKey, Subkey, REG_SZ, Value, LenB(StrConv(Value, vbFromUnicode)) + 1) SetDefaultValue = (ret = 0) 
    End Function ************************************************************************* RegQueryValueEx--读取某Key的特定名称的值(Value)
    Vb声明和参数解释:
    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 
    hkey:Key Handle
    lpValueName:Value Name
    lpReserved:保留参数,调用时设置为0即可
    lpType:返回读取的数据类型
    lpData:返回读取的数据
    lpcbData:传入lpData数据的长度,若成功读取数据,则返回所读取的数据的长度。
    返回值: =0,表示成功;≠0,表示失败。
    说明:
    1、 这一函数除了可读取指定名称的值之外,也可以读取default value。如果要读取default value,只需要将
    参数lpValueName设置为""[空字符串]即可。
    2、lpType 的可能取值
    Enum ValueType 
    REG_NONE = 0 
    REG_SZ = 1 -->字符串
    REG_EXPAND_SZ = 2 -->可展开式字符串
    REG_BINARY = 3 -->Binary数据
    REG_DWORD = 4 -->长整数
    REG_DWORD_BIG_ENDIAN = 5 -->BIG_ENDIAN长整数
    REG_MULTI_SZ = 7 -->多重字符串
    End Enum e.g:
    Dim hKey As Long, ret As Long, lenData As Long, typeData As Long 
    Dim Name As String
    '读取HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run的internat.exe的value.
    Name="internat.exe"
    ret=RegOpenKey(HKEY_LOCAL_MACHINE,"Software\Microsoft\Windows\CurrentVersion\Run", hKey) 
    if ret=0 then
    ret = RegQueryValueEx(hKey, Name, 0, typeData, ByVal vbNullString, lenData)'注意ByVal千万别忘了
    end if
      

  4.   

    *************************************************************************RegEnumValue--列出某Key的所有名称的值Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long 
    '以下的两个函数是经过王国荣老师改编过的函数,与此相关,也一并列出.并且在我们的例子程序中要用到它们。RegEnumValueAsAny可以传入长整数和字符串;RegEnumValueAsAny2中lpData参数被改成Any后,可以使用Byte数组,由于Byte数组是采用”传地址方式来传递参数的,可以省下复制字符串数据的时间,使得程序变得更加高效。
    Declare Function RegEnumValueAsAny Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long Declare Function RegEnumValueAsAny2 Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, lpValueName As Any, lpcbValueName As Long, lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
    参数说明:
    hKey:Key Handle
    dwIndex:欲读取之名称的顺序
    lpValueName:返回所读取的名称
    lpcbValueName:传入lpValueName参数的长度,返回所读取的名称的长度,注意这一长度不含chr(0)
    lpReserved:保留参数,实际使用时传入ByVal 0即可
    lpType:返回所读取的数据类型
    lpData:返回所读取的数据
    lpcbData:传入lpData,返回所读取的数据长度
    返回值: =0,表示成功;≠0,表示失败。 
    调用例子:
    ret=0
    myindex=0
    while ret=0
    ret=RegEnumValue(hkey,myindex,Name,ByVal 0, typeData, ByVal vbNullString, lenData)
    myindex=myindex+1
    wend *************************************************************************RegSetValueEx--设置某Key特定名称的值(Value)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,表示失败。
    e.g:
    Dim hKey As Long 
    Dim L As Long 
    L = 99999 
    RegCreateKey HKEY_CURRENT_USER, "Software\SetValue", hKey 
    RegSetValueEx hKey, "LongData", 0, REG_DWORD, L, 4 
    ************************************************************************* RegDeleteValue--删除某Key的某一名称Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long 
    参数:
    hKey:Key Handle
    lpValueName: Value名称,如果想删除默认值的话,传入""[空字符串]即可。 
    返回值: =0,表示成功;≠0,表示失败。
    函数调用例:
    '我们假设在HKEY_CURRENT_USER\Software\SetValue有:
    '预设值--VB操作注册表
    'str1--我爱我的祖国
    '我们要删除这两个Value 
    ret = RegOpenKey(HKEY_CURRENT_USER, "Software\SetValue", hKey) 
    If ret = 0 Then 
    RegDeleteValue hKey, "Str1" 
    MsgBox "已删除HKCU\Software\SetValueSubKeyStr1Value" 
    RegDeleteValue hKey, "" 
    MsgBox "已删除HKCU\Software\SetValueSubKey‘预设值’" 
    End If*************************************************************************RegEnumKey--列出某Key的所有SubKeyDeclare 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 
    参数说明:
    hKey:Key Handle
    dwIndex:欲读取的SubKey的顺序
    lpName:返回所读取的SubKey的名称
    cbName:传入lpName的字符串长度。
    返回值: =0,表示成功;≠0,表示失败。
    调用例:
    Dim hKey As Long, ret As Long, Name As String, Idx As Long 
    List1.Clear 
    Idx = 0 
    Name = String(256, Chr(0)) 
    Do 
    ret = RegEnumKey(HKEY_CURRENT_USER, Idx, Name, Len(Name)) 
    If ret = 0 Then 
    List1.AddItem Left(Name, InStr(Name, Chr(0)) - 1) 
    Idx = Idx + 1 
    End If 
    Loop Until ret <> 0 *************************************************************************RegDeleteKey--删除Key或者SubKeyDeclare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
    参数:
    hKey:Key Handle
    lpSubKey:SubKey名称或者路径,若传入""[空字符串],表示删除Key本身。
    返回值: =0,表示成功;≠0,表示失败。 eg:
    Dim hKey,ret As Long 
    ret = RegCreateKey(HKEY_LOCAL_MACHINE, "SOFTWARE\Hongqt\xiaoyuer", hKey) 
    ret = RegOpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE\Hongqt", hKey)
    ret = RegDeleteKey(hKey, "xiaoyuer")'删除HKEY_LOCAL_MACHINE\SOFTWARE\Hongqt\xiaoyuer
    注意: 
    如果我们利用RegDeleteKey函数删除一个含有SubKey的Key时,对于Windows98和Winnt来讲是不一样的。比如我们把上面的删除调用改成ret = RegDeleteKey(hKey, ""),则在windows98下,它会连hongqt下的xiaoyuer一起删除,而在winnt下则会报错。
      

  5.   

    注册表关键字安全选项...
    的解释在msdn找不到.