请教:VB的注册表操作,包括创主键、写值!(最好是源代码之类,提供网址也行!)
解决方案 »
- 怎么获得自定义类型数组的元素个数 急啊 有大虾在吗??
- 我想做泡泡堂外挂,如何得到1P或者2P的坐标位置?
- 简单问题高手进!谢谢!(在线等,小鸟一个)
- 图标大小转换
- 在安装了打包好的文件卸载后再安装,运行时会报找不到模块???头痛
- 666()过来拿分
- 求助
- 几个常用算法,帮忙调试一下,在线等候,立即给分!不够在加(每题20分,还有2000多分)
- VB 用webbrowser怎么取框架网页中指定网页 控件值 或控制其中提定网页
- 请问如何将本地的一个文件复制到局域网上的另一台主机的一个共享目录中?
- 请问:vb6中要使用一个.dll库中的方法,是使用添加引用呢,还是declare呢?
- 怎样使工作区变宽?
' 这个模块用于读和写注册表关键字。
' 不同于VB 的内部注册表访问方法,它可以
' 通过字符串的值来读和写任何注册表关键字。
Option Explicit
'---------------------------------------------------------------
'-注册表 API 声明...
'---------------------------------------------------------------
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByRef lpSecurityAttributes As SECURITY_ATTRIBUTES, ByRef phkResult As Long, ByRef lpdwDisposition As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long'---------------------------------------------------------------
'- 注册表 Api 常数...
'---------------------------------------------------------------
' Reg Data Types...
Const REG_SZ = 1 ' Unicode空终结字符串
Const REG_EXPAND_SZ = 2 ' Unicode空终结字符串
Const REG_DWORD = 4 ' 32-bit 数字' 注册表创建类型值...
Const REG_OPTION_NON_VOLATILE = 0 ' 当系统重新启动时,关键字被保留' 注册表关键字安全选项...
Const READ_CONTROL = &H20000
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_READ = KEY_QUERY_VALUE + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + READ_CONTROL
Const KEY_WRITE = KEY_SET_VALUE + KEY_CREATE_SUB_KEY + READ_CONTROL
Const KEY_EXECUTE = KEY_READ
Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
' 注册表关键字根类型...
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_PERFORMANCE_DATA = &H80000004' 返回值...
Const ERROR_NONE = 0
Const ERROR_BADKEY = 2
Const ERROR_ACCESS_DENIED = 8
Const ERROR_SUCCESS = 0'---------------------------------------------------------------
'- 注册表安全属性类型...
'---------------------------------------------------------------
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Boolean
End Type
'sample usage - Debug.Print UpodateKey(HKEY_CLASSES_ROOT, "keyname", "newvalue")
'-------------------------------------------------------------------------------------------------
Public Function UpdateKey(KeyRoot As Long, KeyName As String, SubKeyName As String, SubKeyValue As String) As Boolean
Dim rc As Long ' 返回代码
Dim hKey As Long ' 处理一个注册表关键字
Dim hDepth As Long '
Dim lpAttr As SECURITY_ATTRIBUTES ' 注册表安全类型
lpAttr.nLength = 50 ' 设置安全属性为缺省值...
lpAttr.lpSecurityDescriptor = 0 ' ...
lpAttr.bInheritHandle = True ' ... '------------------------------------------------------------
'- 创建/打开注册表关键字...
'------------------------------------------------------------
rc = RegCreateKeyEx(KeyRoot, KeyName, _
0, REG_SZ, _
REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, lpAttr, _
hKey, hDepth) ' 创建/打开//KeyRoot//KeyName
If (rc <> ERROR_SUCCESS) Then GoTo CreateKeyError ' 错误处理...
'------------------------------------------------------------
'- 创建/修改关键字值...
'------------------------------------------------------------
If (SubKeyValue = "") Then SubKeyValue = " " ' 要让RegSetValueEx() 工作需要输入一个空格...
' 创建/修改关键字值
rc = RegSetValueEx(hKey, SubKeyName, _
0, REG_SZ, _
SubKeyValue, LenB(StrConv(SubKeyValue, vbFromUnicode)))
If (rc <> ERROR_SUCCESS) Then GoTo CreateKeyError ' 错误处理
'------------------------------------------------------------
'- 关闭注册表关键字...
'------------------------------------------------------------
rc = RegCloseKey(hKey) ' 关闭关键字
UpdateKey = True ' 返回成功
Exit Function ' 退出
CreateKeyError:
UpdateKey = False ' 设置错误返回代码
rc = RegCloseKey(hKey) ' 试图关闭关键字
End Function'-------------------------------------------------------------------------------------------------
'sample usage - Debug.Print GetKeyValue(HKEY_CLASSES_ROOT, "COMCTL.ListviewCtrl.1\CLSID", "")
'-------------------------------------------------------------------------------------------------
Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String) As String
Dim i As Long ' 循环计数器
Dim rc As Long ' 返回代码
Dim hKey As Long ' 处理打开的注册表关键字
Dim hDepth As Long '
Dim sKeyVal As String
Dim lKeyValType As Long ' 注册表关键字数据类型
Dim tmpVal As String ' 注册表关键字的临时存储器
Dim KeyValSize As Long ' 注册表关键字变量尺寸
' 在 KeyRoot {HKEY_LOCAL_MACHINE...} 下打开注册表关键字
'------------------------------------------------------------
rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' 打开注册表关键字
If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' 处理错误...
tmpVal = String$(1024, 0) ' 分配变量空间
KeyValSize = 1024 ' 标记变量尺寸
'------------------------------------------------------------
' 检索注册表关键字的值...
'------------------------------------------------------------
rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
lKeyValType, tmpVal, KeyValSize) ' 获得/创建关键字的值
If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' 错误处理
tmpVal = Left$(tmpVal, InStr(tmpVal, Chr(0)) - 1) '------------------------------------------------------------
' 决定关键字值的转换类型...
'------------------------------------------------------------
Select Case lKeyValType ' 搜索数据类型...
Case REG_SZ, REG_EXPAND_SZ ' 字符串注册表关键字数据类型
sKeyVal = tmpVal ' 复制字符串的值
Case REG_DWORD ' 四字节注册表关键字数据类型
For i = Len(tmpVal) To 1 Step -1 ' 转换每一位
sKeyVal = sKeyVal + Hex(Asc(Mid(tmpVal, i, 1))) ' 一个字符一个字符地生成值。
Next
sKeyVal = Format$("&h" + sKeyVal) ' 转换四字节为字符串
End Select
GetKeyValue = sKeyVal ' 返回值
rc = RegCloseKey(hKey) ' 关闭注册表关键字
Exit Function ' 退出
GetKeyError: ' 错误发生过后进行清除...
GetKeyValue = vbNullString ' 设置返回值为空字符串
rc = RegCloseKey(hKey) ' 关闭注册表关键字
End Function
太多了!
我现问题是:
retValue = RegCreateKey(HKEY_LOCAL_MACHINE, Mykey, keyid)
If retValue = 0 Then
retValue = RegSetValueEx(keyid, "DBQ", 0, REG_SZ, MyStr, bufSize)
End if
但就是DBQ和REG_SZ可写入,MyStr就是写不进去!我找不出原因!请教!
另:我写一个十六进制的数时,将REG_SZ换成REG_DWORD外,我的MyStr就当是变为什么?(如写0x25)
Const REG_BINARY = 3 ' Free form binary
Const HKEY_CURRENT_USER = &H80000001
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Function RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String) As String
Dim lResult As Long, lValueType As Long, strBuf As String, lDataBufSize As Long
'retrieve nformation about the key
lResult = RegQueryValueEx(hKey, strValueName, 0, lValueType, ByVal 0, lDataBufSize)
If lResult = 0 Then
If lValueType = REG_SZ Then
'Create a buffer
strBuf = String(lDataBufSize, Chr$(0))
'retrieve the key's content
lResult = RegQueryValueEx(hKey, strValueName, 0, 0, ByVal strBuf, lDataBufSize)
If lResult = 0 Then
'Remove the unnecessary chr$(0)'s
RegQueryStringValue = Left$(strBuf, InStr(1, strBuf, Chr$(0)) - 1)
End If
ElseIf lValueType = REG_BINARY Then
Dim strData As Integer
'retrieve the key's value
lResult = RegQueryValueEx(hKey, strValueName, 0, 0, strData, lDataBufSize)
If lResult = 0 Then
RegQueryStringValue = strData
End If
End If
End If
End Function
Function GetString(hKey As Long, strPath As String, strValue As String)
Dim Ret
'Open the key
RegOpenKey hKey, strPath, Ret
'Get the key's content
GetString = RegQueryStringValue(Ret, strValue)
'Close the key
RegCloseKey Ret
End Function
Sub SaveString(hKey As Long, strPath As String, strValue As String, strData As String)
Dim Ret
'Create a new key
RegCreateKey hKey, strPath, Ret
'Save a string to the key
RegSetValueEx Ret, strValue, 0, REG_SZ, ByVal strData, Len(strData)
'close the key
RegCloseKey Ret
End Sub
Sub SaveStringLong(hKey As Long, strPath As String, strValue As String, strData As String)
Dim Ret
'Create a new key
RegCreateKey hKey, strPath, Ret
'Set the key's value
RegSetValueEx Ret, strValue, 0, REG_BINARY, CByte(strData), 4
'close the key
RegCloseKey Ret
End Sub
Sub DelSetting(hKey As Long, strPath As String, strValue As String)
Dim Ret
'Create a new key
RegCreateKey hKey, strPath, Ret
'Delete the key's value
RegDeleteValue Ret, strValue
'close the key
RegCloseKey Ret
End Sub
Private Sub Command1_Click()
Dim strString As String
'Ask for a value
strString = InputBox("Please enter a value between 0 and 255 to be saved as a binary value in the registry.", App.Title)
If strString = "" Or Val(strString) > 255 Or Val(strString) < 0 Then
MsgBox "Invalid value entered ...", vbExclamation + vbOKOnly, App.Title
Exit Sub
End If
'Save the value to the registry
SaveStringLong HKEY_CURRENT_USER, "KPD-Team", "BinaryValue", CByte(strString)
End Sub
Private Sub Command2_Click()
'Get a string from the registry
Ret = GetString(HKEY_CURRENT_USER, "KPD-Team", "BinaryValue")
If Ret = "" Then MsgBox "No value found !", vbExclamation + vbOKOnly, App.Title: Exit Sub
MsgBox "The value is " + Ret, vbOKOnly + vbInformation, App.Title
End Sub
Private Sub Command3_Click()
'Delete the setting from the registry
DelSetting HKEY_CURRENT_USER, "KPD-Team", "BinaryValue"
MsgBox "The value was deleted ...", vbInformation + vbOKOnly, App.Title
End Sub
Private Sub Form_Load()
Command1.Caption = "Set Value"
Command2.Caption = "Get Value"
Command3.Caption = "Delete Value"
End Sub
'This program needs 3 buttons
Const REG_SZ = 1 ' Unicode nul terminated string
Const REG_BINARY = 3 ' Free form binary
Const HKEY_CURRENT_USER = &H80000001
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Function RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String) As String
Dim lResult As Long, lValueType As Long, strBuf As String, lDataBufSize As Long
'retrieve nformation about the key
lResult = RegQueryValueEx(hKey, strValueName, 0, lValueType, ByVal 0, lDataBufSize)
If lResult = 0 Then
If lValueType = REG_SZ Then
'Create a buffer
strBuf = String(lDataBufSize, Chr$(0))
'retrieve the key's content
lResult = RegQueryValueEx(hKey, strValueName, 0, 0, ByVal strBuf, lDataBufSize)
If lResult = 0 Then
'Remove the unnecessary chr$(0)'s
RegQueryStringValue = Left$(strBuf, InStr(1, strBuf, Chr$(0)) - 1)
End If
ElseIf lValueType = REG_BINARY Then
Dim strData As Integer
'retrieve the key's value
lResult = RegQueryValueEx(hKey, strValueName, 0, 0, strData, lDataBufSize)
If lResult = 0 Then
RegQueryStringValue = strData
End If
End If
End If
End Function
Function GetString(hKey As Long, strPath As String, strValue As String)
Dim Ret
'Open the key
RegOpenKey hKey, strPath, Ret
'Get the key's content
GetString = RegQueryStringValue(Ret, strValue)
'Close the key
RegCloseKey Ret
End Function
Sub SaveString(hKey As Long, strPath As String, strValue As String, strData As String)
Dim Ret
'Create a new key
RegCreateKey hKey, strPath, Ret
'Save a string to the key
RegSetValueEx Ret, strValue, 0, REG_SZ, ByVal strData, Len(strData)
'close the key
RegCloseKey Ret
End Sub
Sub SaveStringLong(hKey As Long, strPath As String, strValue As String, strData As String)
Dim Ret
'Create a new key
RegCreateKey hKey, strPath, Ret
'Set the key's value
RegSetValueEx Ret, strValue, 0, REG_BINARY, CByte(strData), 4
'close the key
RegCloseKey Ret
End Sub
Sub DelSetting(hKey As Long, strPath As String, strValue As String)
Dim Ret
'Create a new key
RegCreateKey hKey, strPath, Ret
'Delete the key's value
RegDeleteValue Ret, strValue
'close the key
RegCloseKey Ret
End Sub
Private Sub Command1_Click()
Dim strString As String
'Ask for a value
strString = InputBox("Please enter a value between 0 and 255 to be saved as a binary value in the registry.", App.Title)
If strString = "" Or Val(strString) > 255 Or Val(strString) < 0 Then
MsgBox "Invalid value entered ...", vbExclamation + vbOKOnly, App.Title
Exit Sub
End If
'Save the value to the registry
SaveStringLong HKEY_CURRENT_USER, "KPD-Team", "BinaryValue", CByte(strString)
End Sub
Private Sub Command2_Click()
'Get a string from the registry
Ret = GetString(HKEY_CURRENT_USER, "KPD-Team", "BinaryValue")
If Ret = "" Then MsgBox "No value found !", vbExclamation + vbOKOnly, App.Title: Exit Sub
MsgBox "The value is " + Ret, vbOKOnly + vbInformation, App.Title
End Sub
Private Sub Command3_Click()
'Delete the setting from the registry
DelSetting HKEY_CURRENT_USER, "KPD-Team", "BinaryValue"
MsgBox "The value was deleted ...", vbInformation + vbOKOnly, App.Title
End Sub
Private Sub Form_Load()
Command1.Caption = "Set Value"
Command2.Caption = "Get Value"
Command3.Caption = "Delete Value"
End Sub
这个是 createkeyConst HKEY_CURRENT_USER = &H80000001
Const REG_OPTION_BACKUP_RESTORE = 4 ' open for backup or restore
Const REG_OPTION_VOLATILE = 1 ' Key is not preserved when system is rebooted
Const REG_OPTION_NON_VOLATILE = 0 ' Key is preserved when system is rebooted
Const STANDARD_RIGHTS_ALL = &H1F0000
Const SYNCHRONIZE = &H100000
Const READ_CONTROL = &H20000
Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Const KEY_CREATE_LINK = &H20
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
Const KEY_EXECUTE = (KEY_READ)
Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As Any, phkResult As Long, lpdwDisposition As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Sub Form_Load()
Dim Result As Long
'Check if the specified key exists
RegOpenKeyEx HKEY_CURRENT_USER, "KPD-Team", 0, KEY_ALL_ACCESS, Result
'If the key doesn't exist, we create it
If Result = 0 Then
'Create a new key
RegCreateKeyEx HKEY_CURRENT_USER, "KPD-Team", 0, "REG_DWORD", REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, ByVal 0&, Result, Ret
If Result = 0 Then
MsgBox "Error while creating the Key!!"
Exit Sub
End If
End If
'Delete the key
RegDeleteKey Result, ""
'close the handle
RegCloseKey Result
End Sub
怎样写 REG_WORD 类型的值?用RegSetValueEx()函数!