在VB中怎樣操作注冊表.

在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