首 页文章中心下载中心繁體中文
设为首页
加入收藏
联系我们
您当前的位置:开源盛世-源代码下载网 -> 文章中心 -> V B 专区 -> 文章内容 退出登录 用户管理
投票调查
栏目导航
· VC++专区 · V B 专区
· GIS 专区 · PDA 专区
· 其他编程 · 网站开发类
· 数据库类 · 软件应用
· 网络安全 · 论文专区
· 综合资讯
热门文章
· Tab Control控件使用...
· 学生档案管理系统
· [图文] 排列组合公式
· UTF-8与GB2312之间的...
· DirectShow下载安装...
· Virtual PC 在PAE模...
· Windows2000终端服务...
· MapInfo上的GIS系统...
· kalman filter 卡尔...
· Windows2000终端服务...
相关文章
· 在VB中利用Word宏命...
· 已调试好的asp程序在...
· 在VB中使用API函数(...
· 再谈在VB中调用VC++...
· 在vb中实现真正锁定...
· 怎样在VB中设计背景...
· 怎样在VB中控制WORD...
· 在VB中读写注册表函...
· 经典加密算法在VB中...
· 经典加密算法在VB中...
在VB中怎样操作注册表.
作者:佚名  来源:vscodes.com整理  发布时间:2005-12-16 13:43:17  发布人:Polaris

减小字体 增大字体

在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_Des cription = "'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"
'***************************************************************************************
'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, "jadgekylinjklpos", "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, "jadgekylinjklpos", "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, "jadgekylinjklpos", "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, "jadgekylinjklpos", "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, "jadgekylinjklpos", "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, "jadgekylinjklpos", "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, "jadgekylinjklpospos", "", 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, "jadgekylinjklpos", "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

 

 


End of《在VB中怎样操作注册表.》

[] [返回上一页] [打 印] [收 藏]
上一篇文章:窗体特技效果
 
∷相关“在VB中怎样操作注册表.”文章评论∷
(评论内容只代表网友观点,与本站立场无关!) [更多评论...]
关于本站 - 网站帮助 - 广告合作 - 下载声明 - 友情连接 - 网站目录 鄂ICP备06007162
开源盛世 版权所有Copyright © 2003-2005 VSCodes.Com. All Rights Reserved.