在VB中怎样操作注册表.

原创 2001年06月28日 14:41:00

在VB中系统提供了对注册表操作的两个函数.但它们只可以操作特定的键.使用起来往往不能满足需要.下面的这个函数可以实现对注册表的所有操作.并且具有标准VB函数的通用性和易用性.请指点..

Public Function SysRegControl(Optional ByVal RootKey As RegRootKey = regHKEY_LOCAL_MACHINE, Optional ByVal SubKey As String = "", Optional ByVal Key As String = "QiLin", Optional ByRef KeyValue As Variant = "", Optional regKeyType As regKeyTypes = regTypeString, Optional ByVal id As RegControlID = regSetKeyValue) As Boolean
Attribute SysRegControl.VB_Description = "'setregkey 函数/r/n'功能:/r/n'   对注册表中指定键键进行操作/r/n'参数:/r/n'   RootKey     根键/r/n'RootKey 说明/r/n'{       regHKEY_CLASSES_ROOT       = &H80000000/r/n'        regHKEY_CURRENT_USER       = &H80000001/r/n'        regHKEY_LOCAL_MACHINE      = &H80000002/r/n'        regHKEY_USERS          = &H80000003/r/n'        regHKEY_PERFORMANCE_DATA   = &H80000004/r/n'        regHKEY_CURRENT_CONFIG     = &H80000005/r/n'        regHKEY_DYN_DATA       = &H80000006/r/n'}/r/n'   SubKey      子键路径/r/n'   Key     设置的键名/r/n'   KeyValue    设置的键值/r/n'   regKeyType  指定键值的类型/r/n'regKeyType说明:/r/n'{/r/n'        regTypeBinary          =&H00000001     'Binary/r/n'        regTypeDword           =&H00000002 'DWORD/r/n'        regTypeString          =&H00000003 'String/r/n'}/r/n'   ID      函数操作功能号/r/n'功能ID说明:/r/n'{       regSetKeyValue         =111    '设置键值/r/n'        regGetKeyValue         =112    '取键值/r/n'        regCreatKey            =113"
'***************************************************************************************
'setregkey 函数
'功能:
'   对注册表中指定键键进行操作
'参数:
'   RootKey     根键
'RootKey 说明
'{       regHKEY_CLASSES_ROOT       = &H80000000
'        regHKEY_CURRENT_USER       = &H80000001
'        regHKEY_LOCAL_MACHINE      = &H80000002
'        regHKEY_USERS          = &H80000003
'        regHKEY_PERFORMANCE_DATA   = &H80000004
'        regHKEY_CURRENT_CONFIG     = &H80000005
'        regHKEY_DYN_DATA       = &H80000006
'}
'   SubKey      子键路径
'   Key     设置的键名
'   KeyValue    设置的键值
'   regKeyType  指定键值的类型
'regKeyType说明:
'{
'        regTypeBinary          =&H00000001     'Binary
'        regTypeDword           =&H00000002 'DWORD
'        regTypeString          =&H00000003 'String
'}
'   ID      函数操作功能号
'功能ID说明:
'{       regSetKeyValue         =111    '设置键值
'        regGetKeyValue         =112    '取键值
'        regCreatKey            =113    '创建子键
'        regDeleteKeys          =114    '删除末级子键
'        regDelAllKey           =115    '删除非末级子键
'        regDeleteValues        =116    '删除键值
'        regOther           =120    '保留操作ID
'}
'返回值:
'   TRUE        操作成功
'   FALSE       操作失败
'   (C)2001.3.2
'*****************************************************************************************
Dim i As Long
On Error GoTo RegOptionError
'if RootKey then


    Select Case id
'=========================================================================================
        Case regSetKeyValue '=111   '设置键值
'=========================================================================================
            rtn = RegOpenKeyEx(RootKey, SubKey, 0, KEY_WRITE, hKey)
            If rtn = ERROR_SUCCESS Then
'{

            Select Case regKeyType
'----------------------------------------------------------------------------------------
            Case regTypeBinary      '=&H00000001        'Binary

'此模式下参数KeyValue须以字符串形式传入,调用实例:
'SysRegControl regHKEY_LOCAL_MACHINE, "jadgekylin/jklpos", "pos", "jadgekylin01@yesky.com", regTypeBinary, regSetKeyValue
'----------------------------------------------------------------------------------------
                  If VarType(KeyValue) <> vbString Then  '参数不合法
                    rtn = ERROR_SUCCESS + 1
                    'exit select
                  Else
                  lDataSize = Len(KeyValue)
                  ReDim ByteArray(lDataSize)
                  For i = 1 To lDataSize
                      ByteArray(i) = Asc(Mid$(KeyValue, i, 1))
                  Next
                  rtn = RegSetValueExB(hKey, Key, 0, REG_BINARY, ByteArray(1), lDataSize) 'write the value
                  End If
'----------------------------------------------------------------------------------------
            Case regTypeDword   '=&H00000002    'DWORD

'调用实例:
'SysRegControl regHKEY_LOCAL_MACHINE, "jadgekylin/jklpos", "pos", 1, regTypeDword, regSetKeyValue
'----------------------------------------------------------------------------------------

                If VarType(KeyValue) <> vbLong And VarType(KeyValue) <> vbInteger Then
                    rtn = ERROR_SUCCESS + 1
                    'exit select
                Else
                rtn = RegSetValueExA(hKey, Key, 0, REG_DWORD, KeyValue, 4) 'write the value
                End If
'----------------------------------------------------------------------------------------
            Case regTypeString  '=&H00000003    'String

'调用实例:
'SysRegControl regHKEY_LOCAL_MACHINE, "jadgekylin/jklpos", "pos", "1", regTypeString, regSetKeyValue
'----------------------------------------------------------------------------------------

                  If VarType(KeyValue) <> vbString Then  '参数不合法
                    rtn = ERROR_SUCCESS + 1
                    'exit select
                  Else
                rtn = RegSetValueEx(hKey, Key, 0, REG_SZ, ByVal KeyValue, Len(KeyValue)) 'write the value
                  End If
'----------------------------------------------------------------------------------------
            End Select
'}
            If Not rtn = ERROR_SUCCESS Then   'if the was an error writting the value
                rtn = RegCloseKey(hKey)
                SysRegControl = False '调用失败
                Exit Function
            End If
            rtn = RegCloseKey(hKey) 'close the key

            End If 'rtn = ERROR_SUCCESS
'=========================================================================================
        Case regGetKeyValue '=112   '取键值
'=========================================================================================
            rtn = RegOpenKeyEx(RootKey, SubKey, 0, KEY_READ, hKey)
            If rtn = ERROR_SUCCESS Then 'if the key could be opened
'{

            Select Case regKeyType
'----------------------------------------------------------------------------------------
            Case regTypeBinary      '=&H00000001        'Binary
'KeyValue作为传值变量获得键值,调用示例:
'Dim a As String
'SysRegControl regHKEY_LOCAL_MACHINE, "jadgekylin/jklpos", "pos", a, regTypeBinary, regGetKeyValue
'----------------------------------------------------------------------------------------
                  rtn = RegQueryValueEx(hKey, Key, 0, REG_BINARY, 0, lBufferSize) 'get the value from the registry
                 sBuffer = Space(lBufferSize)
                 rtn = RegQueryValueEx(hKey, Key, 0, REG_BINARY, sBuffer, lBufferSize) 'get the value from the registry
            If Not rtn = ERROR_SUCCESS Then   'if the was an error writting the value
                rtn = RegCloseKey(hKey)
                SysRegControl = False '调用失败
                Exit Function
            Else
                KeyValue = sBuffer
               
            End If
            rtn = RegCloseKey(hKey) 'close the key

'----------------------------------------------------------------------------------------
            Case regTypeDword   '=&H00000002    'DWORD
'
'KeyValue作为传值变量获得键值,调用示例:
'Dim a As Long
'SysRegControl regHKEY_LOCAL_MACHINE, "jadgekylin/jklpos", "pos", a, regTypeString, regGetKeyValue
'----------------------------------------------------------------------------------------
                  rtn = RegQueryValueExA(hKey, Key, 0, REG_DWORD, lBuffer, 4) 'get the value from the registry
            If Not rtn = ERROR_SUCCESS Then   'if the was an error writting the value
                rtn = RegCloseKey(hKey)
                SysRegControl = False '调用失败
                Exit Function
            Else
                KeyValue = lBuffer
            End If
            rtn = RegCloseKey(hKey) 'close the key

'----------------------------------------------------------------------------------------
            Case regTypeString  '=&H00000003    'String

'KeyValue作为传值变量获得键值,调用示例:
'Dim a As String
'SysRegControl regHKEY_LOCAL_MACHINE, "jadgekylin/jklpos", "pos1", a, regTypeString, regGetKeyValue
'----------------------------------------------------------------------------------------
                  sBuffer = Space(255)     'make a buffer
                      lBufferSize = Len(sBuffer)
                  rtn = RegQueryValueEx(hKey, Key, 0, REG_SZ, sBuffer, lBufferSize) 'get the value from the registry
                  sBuffer = Trim(sBuffer)
                      sBuffer = Left(sBuffer, Len(sBuffer) - 1) 'return the value to the user
            If Not rtn = ERROR_SUCCESS Then   'if the was an error writting the value
                rtn = RegCloseKey(hKey)
                SysRegControl = False '调用失败
                Exit Function
            Else
                KeyValue = sBuffer
               
            End If
            rtn = RegCloseKey(hKey) 'close the key

'----------------------------------------------------------------------------------------

            End Select
'}
   
            End If 'rtn = ERROR_SUCCESS


'=========================================================================================
        Case regCreatKey    '=113   '创建子键

'SubKey 是创建对象,Key,KeyValue为保留字,调用示例:
'SysRegControl regHKEY_LOCAL_MACHINE, "jadgekylin/jklpos/pos", "", 0, regTypeDword, regCreatKey
'=========================================================================================

           rtn = RegCreateKey(RootKey, SubKey, hKey) 'create the key
           If Not rtn = ERROR_SUCCESS Then 'if the key was created then
              rtn = RegCloseKey(hKey)  'close the key
              SysRegControl = False
              Exit Function
           End If

'=========================================================================================
        Case regDeleteKeys  '=114   '删除末级子键同regDelAllKey

'此处Key指定为SubKey下一级子键即被删除子键,SubKey可以为"",key若为"",则删除SubKey子键
'调用示例:
'SysRegControl regHKEY_LOCAL_MACHINE, "", "jadgekylin", "", regTypeBinary, regDeleteKeys
'SysRegControl regHKEY_LOCAL_MACHINE, "jadgekylin", "", "", regTypeBinary, regDeleteKeys
'SysRegControl regHKEY_LOCAL_MACHINE, "" , "jadgekylin", "", regTypeBinary, regDeleteKeys
'=========================================================================================
        rtn = RegOpenKeyEx(RootKey, SubKey, 0, KEY_WRITE, hKey) 'open the key
        If rtn = ERROR_SUCCESS Then 'if the key could be opened then
                rtn = RegDeleteKey(hKey, Key) 'delete the key
        Else
            rtn = RegCloseKey(hKey)  'close the key
            SysRegControl = False
            Exit Function
        End If

'=========================================================================================
        Case regDelAllKey   '=115   '删除非末级子键,暂时同RegDeleteKeys
'=========================================================================================
        rtn = RegOpenKeyEx(RootKey, SubKey, 0, KEY_WRITE, hKey) 'open the key
        If rtn = ERROR_SUCCESS Then 'if the key could be opened then
                rtn = RegDeleteKey(hKey, Key) 'delete the key
        Else
            rtn = RegCloseKey(hKey)  'close the key
            SysRegControl = False
            Exit Function
        End If
'=========================================================================================
        Case regDeleteValues    '=116   '删除键值
'
'此处KeyValue,regKeyType为保留字,可以设为任意值,调用示例:
'SysRegControl regHKEY_LOCAL_MACHINE, "jadgekylin/jklpos", "pos", 0, regTypeDword, regDeleteValues
'=========================================================================================

        rtn = RegOpenKeyEx(RootKey, SubKey, 0, KEY_WRITE, hKey) 'open the key
        If rtn = ERROR_SUCCESS Then
            rtn = RegDeleteValue(hKey, Key)
        Else
            rtn = RegCloseKey(hKey)
            SysRegControl = False
            Exit Function
        End If
'=========================================================================================
        Case regOther       '=120   '保留操作ID
'=========================================================================================
'在此处添加自己的处理            
           
'=========================================================================================
        Case Else
'=========================================================================================
            SysRegControl = False
            Exit Function
    End Select
'end if  'RootKey
On Error GoTo 0
SysRegControl = True
Exit Function

RegOptionError:  '错误处理过程在此文中未调用,有必要的可以自己加上处理.
'If an error does accurr, and the user wants error messages displayed, then
'display one of the following error messages

Dim lErrorCode As Long
Dim GetErrorMsg As String
lErrorCode = Err()
Select Case lErrorCode
       Case 1009, 1015
            GetErrorMsg = "The Registry Database is corrupt!"
       Case 2, 1010
            GetErrorMsg = "Bad Key Name"
       Case 1011
            GetErrorMsg = "Can't Open Key"
       Case 4, 1012
            GetErrorMsg = "Can't Read Key"
       Case 5
            GetErrorMsg = "Access to this key is denied"
       Case 1013
            GetErrorMsg = "Can't Write Key"
       Case 8, 14
            GetErrorMsg = "Out of memory"
       Case 87
            GetErrorMsg = "Invalid Parameter"
       Case 234
            GetErrorMsg = "There is more data than the buffer has been allocated to hold."
       Case Else
            GetErrorMsg = Chr(13) & Chr(10) & Error(Err())
End Select
MsgBox "Error: " & Err() & GetErrorMsg
Exit Function
Resume

End Function

上面这个函数是我作的一个OCX的其中一个方法,有兴趣的朋友可以向我索取此控件..

jadgekylin01@yesky.com

 

 

VB 注册表操作

'*****下面先声明一些常量****************************************** Public Const HKEY_CLASSES_ROOT = &H800000...
  • lbuskeep
  • lbuskeep
  • 2012年12月06日 02:24
  • 1070

VB6读取注册表

Dim WshShell, bKey Set WshShell = CreateObject("Wscript.Shell") bKey = WshShell.RegRead("HKEY_CU...
  • karl_han
  • karl_han
  • 2014年05月13日 11:15
  • 1818

VB中使用API操作注册表

使用 Windows API 注册表函数    所谓 API(Application Programing Interface) 是 Windows 提供的一个32位环境下的应用程序编程接口,其中包括...
  • longhui666888
  • longhui666888
  • 2005年12月24日 11:03
  • 5018

如何用vb将值写入注册表

Option Explicit     注册表的入口常量     Public Const HKEY_CLASSES_ROOT = &H80000000     Public Const HKEY_C...
  • liyingju
  • liyingju
  • 2007年06月14日 16:48
  • 965

在VB中怎样操作注册表.

  • zgqtxwd
  • zgqtxwd
  • 2008年05月01日 05:28
  • 147

VB注册表操作

将下面代码保存为CLS文件 ,然后在工程中引用就可以了。 Attribute VB_Name = "BasRegisty" Option Explicit 读写注册表任何地方的函数 用法见下面 摘...
  • YeHeng
  • YeHeng
  • 2007年08月30日 16:51
  • 4229

用VB操作注册表

用VB操作注册表(一)梦里水乡 认识登录数据库(Registry)我们在这里主要通过由Windows系统本身提供的注册表编辑器regedit.exe来认识登录数据库(Registry)1、Key和Su...
  • Suprman
  • Suprman
  • 2006年12月23日 20:25
  • 2751

一个好用的 VB 注册表操作类模块

具体使用一看就明白了,来自 CSDNOption ExplicitPrivate Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory"...
  • snlmgytO
  • snlmgytO
  • 2005年09月25日 20:06
  • 1617

使用wscript对象实现注册表操作

wscript注册表 大名鼎鼎的WSH听说过吗? 它就是Windows Script Host的缩写形式,WSH是Windows平台的脚本指令,它的功能十分强大,并且它还是利...
  • s04023083
  • s04023083
  • 2012年07月20日 10:52
  • 686

.net下对注册表的各种操作

vs.net提供了microsoft.win32类,下面有三个子类,全是针对注册表的,Microsoft.Win32.RegistryKey、Microsoft.Win32.Registry、Micr...
  • liusylon
  • liusylon
  • 2006年12月28日 20:41
  • 991
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:在VB中怎样操作注册表.
举报原因:
原因补充:

(最多只允许输入30个字)