VB如何读写注册表?最好有实例

[lzj34]

VB如何读写注册表?最好有实例

[daviddivad]

Public 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 SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition As Long) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public 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 ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Public 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 ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As Any) As Long
Public Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long

'注册表的读写 读：返回读出的值 写/删：返回“0”表示成功，否则为写/删失败
'删除时，如果str_SetValue的值为1表示删除 注册表的项
Public Function fun_RegControlA(ByVal lng_Keymain As Long, ByVal str_Key As String, _
str_ValueKey As String, ByVal lng_ValueType As Long, ByVal lng_Set As Long, Optional ByVal str_SetValue As String) As String

'lng_Keymain 主键
'str_Key 子键
'str_ValueKey 子键中要操作的 键名
'lng_ValueType 子键中要操作的键名的类型
'lng_Set 读、写、删
'str_setvalue 要写入的值

On Error GoTo doError
Dim hKey As Long
Dim lpSubKey As String
Dim lpSecurityattributes As SECURITY_ATTRIBUTES
Dim phkResult As Long
Dim lpdwDisposition As Long

Dim lpValueName As String
Dim lpType As Long
Dim lpData As String
Dim lpcbData As Long

Dim dwType As Long
Dim cbData As Long

Dim lng_Ret As Long
Dim str_Ret As String
Dim lng_Temp As Long
Dim int_I As Integer

hKey = lng_Keymain
lpSubKey = str_Key
With lpSecurityattributes
.nLength = Len(lpSecurityattributes)
.bInheritHandle = True
.lpSecurityDescriptor = 0
End With
lng_Ret = RegCreateKeyEx(hKey, lpSubKey, 0, "", 0, KEY_ALL_ACCESS, lpSecurityattributes, phkResult, lpdwDisposition)
If lng_Ret = ERROR_SUCCESS Then
hKey = phkResult
If lng_Set = GetValue Then
lpType = lng_ValueType
lpValueName = str_ValueKey
lpData = Space$(100)
lpcbData = 100
If lng_Ret = ERROR_SUCCESS Then
Select Case lpType
Case 1 'REG_SZ
lng_Ret = RegQueryValueEx(hKey, lpValueName, 0, lpType, ByVal lpData, lpcbData)
int_I = InStr(1, lpData, Chr(0))
If int_I > 1 Then
str_Ret = Left$(lpData, int_I - 1)
Else
str_Ret = ""
End If
Case 3 'REG_BINARY
lng_Ret = RegQueryValueEx(hKey, lpValueName, 0, lpType, int_I, 4)
str_Ret = CStr(int_I)
Case 4 'REG_DWORD
lng_Ret = RegQueryValueEx(hKey, lpValueName, 0, lpType, lng_Temp, 4)
str_Ret = CStr(lng_Temp)
Case Else
str_Ret = ""
End Select
Else
str_Ret = ""
End If
ElseIf lng_Set = SetValue Then
lpValueName = str_ValueKey
dwType = lng_ValueType
lpData = str_SetValue
If lpData = "" Then
lng_Ret = 1
Else
Select Case dwType
Case 1 'REG_SZ
cbData = LenB(StrConv(str_SetValue, vbFromUnicode))
lng_Ret = RegSetValueEx(hKey, lpValueName, 0, dwType, ByVal lpData, cbData)
Case 3 'REG_BINARY
lng_Temp = Val(lpData)
If lng_Temp > (2 ^ 8 - 1) Or lng_Temp < 0 Then
lng_Ret = 1
Else
lng_Ret = RegSetValueEx(hKey, lpValueName, 0, dwType, CByte(lng_Temp), 4)
End If
Case 4 'REG_DWORD
lng_Temp = Val(lpData)
If lng_Temp > (2 ^ 32 - 1) Or lng_Temp < 0 Then
lng_Ret = 1
Else
lng_Ret = RegSetValueEx(hKey, lpValueName, 0, dwType, lng_Temp, 4)
End If
Case Else
lng_Ret = 1
End Select
End If
If lng_Ret = ERROR_SUCCESS Then str_Ret = "0"
ElseIf lng_Set = DeleteKey Then
lpValueName = str_ValueKey
If str_SetValue <> "1" Then
lng_Ret = RegDeleteValue(hKey, lpValueName)
If lng_Ret = ERROR_SUCCESS Then str_Ret = "0"
Else '删除项
lng_Ret = RegDeleteKey(hKey, lpValueName)
If lng_Ret = ERROR_SUCCESS Then str_Ret = "0"
End If
End If
End If
lng_Ret = RegCloseKey(hKey)
fun_RegControlA = str_Ret
Exit Function
doError:
RegCloseKey hKey
fun_RegControlA = ""
End Function

[daviddivad]

Public Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Public Const ERROR_SUCCESS = 0&
Public Const KEY_ALL_ACCESS = &H3F
Public Const MAX_LENGTH As Long = 260

[lihonggen0]

'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

[rainstormmaster]

呵呵，这方面的帖子很多，要学会搜索

[wumy_ld]

' Reg Key Security Options...
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_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL

' Reg Key ROOT Types...
Const HKEY_LOCAL_MACHINE = &H80000002
Const ERROR_SUCCESS = 0
Const REG_SZ = 1 ' Unicode nul terminated string
Const REG_DWORD = 4 ' 32-bit number

Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"
Const gREGVALSYSINFOLOC = "MSINFO"
Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
Const gREGVALSYSINFO = "PATH"

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 RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long

Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
Dim i As Long ' Loop Counter
Dim rc As Long ' Return Code
Dim hKey As Long ' Handle To An Open Registry Key
Dim hDepth As Long '
Dim KeyValType As Long ' Data Type Of A Registry Key
Dim tmpVal As String ' Tempory Storage For A Registry Key Value
Dim KeyValSize As Long ' Size Of Registry Key Variable
'------------------------------------------------------------
' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
'------------------------------------------------------------
rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open Registry Key

If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Handle Error...

tmpVal = String$(1024, 0) ' Allocate Variable Space
KeyValSize = 1024 ' Mark Variable Size

'------------------------------------------------------------
' Retrieve Registry Key Value...
'------------------------------------------------------------
rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
KeyValType, tmpVal, KeyValSize) ' Get/Create Key Value

If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Handle Errors

If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then ' Win95 Adds Null Terminated String...
tmpVal = Left(tmpVal, KeyValSize - 1) ' Null Found, Extract From String
Else ' WinNT Does NOT Null Terminate String...
tmpVal = Left(tmpVal, KeyValSize) ' Null Not Found, Extract String Only
End If
'------------------------------------------------------------
' Determine Key Value Type For Conversion...
'------------------------------------------------------------
Select Case KeyValType ' Search Data Types...
Case REG_SZ ' String Registry Key Data Type
KeyVal = tmpVal ' Copy String Value
Case REG_DWORD ' Double Word Registry Key Data Type
For i = Len(tmpVal) To 1 Step -1 ' Convert Each Bit
KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1))) ' Build Value Char. By Char.
Next
KeyVal = Format$("&h" + KeyVal) ' Convert Double Word To String
End Select

GetKeyValue = True ' Return Success
rc = RegCloseKey(hKey) ' Close Registry Key
Exit Function ' Exit

GetKeyError: ' Cleanup After An Error Has Occured...
KeyVal = "" ' Set Return Val To Empty String
GetKeyValue = False ' Return Failure
rc = RegCloseKey(hKey) ' Close Registry Key
End Function