在VB中读写注册表函数源码

原创 2001年06月28日 15:01:00

在以下地址贴中有乱码,

http://www.csdn.net/develop/article/8/8562.shtm

 现补充如下:

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
'***************************************************************************************
'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", "jadgekylin@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

在VB中读写注册表函数源码

  • zgqtxwd
  • zgqtxwd
  • 2008年05月01日 05:29
  • 152

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中如何实现注册表的读写

毫不夸张的说,注册表相当于Windows的“心”,几乎所有的Windows应用程序都毫不例外的要在这里边“安家筑巢”,如果你也用VB编写了一个程序,是不是也想在注册表里占有一席之地呢(即使刚才没有,现...
  • pingyou
  • pingyou
  • 2005年05月26日 19:51
  • 1335

VB 读写注册表

图片:1.jpg[删除] 打开Visual Studio.NET,选择“新建项目”,在项目类型窗口中选择“Visual Basic项目”,在模板窗口中选择“Windows...
  • FeiJiXiong
  • FeiJiXiong
  • 2013年01月30日 00:12
  • 325

VB中使用API操作注册表

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

[原创]VB的注册表处理函数

由于VB没直接新建注册表的函数,所以本人写了四个API函数,用于直接对注册表操作,请指教!我的QQ:328266362EMAIL:stmp@163.com-----------------------...
  • itman2005
  • itman2005
  • 2005年08月04日 22:27
  • 553

Windows驱动编程 文件读写 以及注册表操作

3.3 文件的读写操作 打开文件之后,最重要的操作是对文件的读写。读与写的方法是对称的。只是参数输入与输出的方向不同。读取文件内容一般用ZwReadFile,写文件一般使用ZwWriteFile。 ...
  • zacklin
  • zacklin
  • 2012年04月16日 11:34
  • 5111

VB.NET中访问注册表

  vb.net中访问注册表变得非常的简单。我们可以用  microsoft.Win32 名称空间的 下的 registry 类 和  registryKey 类。 另外 My.Computer.Re...
  • precipitant
  • precipitant
  • 2006年12月27日 19:43
  • 2831

VB 注册表操作

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

windows API 操作注册表函数

如今修改注册表成为继超频之后的又一大热点,许多CFAN通过对注册表的修改使Win98显得更加个性化,诸多报刊杂志也纷纷扯起注册表这面旗帜,令人遗憾的是,在介绍注册表修改的众多的文章中,大都以手工修改为...
  • B_H_L
  • B_H_L
  • 2012年07月19日 20:38
  • 6021
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:在VB中读写注册表函数源码
举报原因:
原因补充:

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