在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", "[email protected]", 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的其中一个方法,有兴趣的朋友可以向我索取此控件..
[email protected]

|