分享
 
 
 

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

王朝vb·作者佚名  2006-01-08
窄屏简体版  字體: |||超大  

在以下地址贴中有乱码,

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

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有