请问在vb中如何调用注册表

[freeking]

我想编程序保存注册表，然后恢复注册表，怎么完成。 请高手指教

[coowoo]

搜索--〉注册表

[fling_boy]

Public Declare Function RegConnectRegistry Lib "advapi32.dll" Alias "RegConnectRegistryA" (ByVal lpMachineName As String, ByVal hKey As Long, phkResult As Long) As Long
Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult 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
Public Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As Long, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long
Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
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
Public Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) 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 Any, lpcbData As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, source As Any, ByVal numBytes As Long)

Public Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long

Const SYNCHRONIZE = &H100000
Const READ_CONTROL = &H20000
Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Const STANDARD_RIGHTS_ALL = &H1F0000

Const KEY_QUERY_VALUE = &H1
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_READ = ((READ_CONTROL 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 ERROR_SUCCESS = 0&

Public Const REG_SZ = 1
Public Const REG_BINARY = 3
Public Const REG_DWORD = 4

Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006

Public Const REG_CREATED_NEW_KEY = &H1
Public Const REG_OPENED_EXISTING_KEY = &H2

' Return True if the system has a math processor.

Function MathProcessor() As Boolean
Dim hKey As Long, key As String
key = "HARDWARE\DESCRIPTION\System\FloatingPointProcessor"
If RegOpenKeyEx(HKEY_LOCAL_MACHINE, key, 0, KEY_READ, hKey) = 0 Then
' If the open operation succeeded, the key exists
MathProcessor = True
' Important: close the key before exiting.
RegCloseKey hKey
End If
End Function

' Test if a Registry key exists.

Function CheckRegistryKey(ByVal hKey As Long, ByVal KeyName As String) As Boolean
Dim handle As Long
' Try to open the key.
If RegOpenKeyEx(hKey, KeyName, 0, KEY_READ, handle) = 0 Then
' The key exists.
CheckRegistryKey = True
' Close it before exiting.
RegCloseKey handle
End If
End Function

' Create a registry key, then close it.
' Returns True if the key already existed, False if it was created.

Function CreateRegistryKey(ByVal hKey As Long, ByVal KeyName As String) As Boolean
Dim handle As Long, disposition As Long
If RegCreateKeyEx(hKey, KeyName, 0, 0, 0, 0, 0, handle, disposition) Then
Err.Raise 1001, , "Unable to create the registry key"
Else
' Return True if the key already existed.
CreateRegistryKey = (disposition = REG_OPENED_EXISTING_KEY)
' Close the key.
RegCloseKey handle
End If
End Function

' Delete a registry key.
' Under Windows NT it doesn't work if the key contains subkeys.

Sub DeleteRegistryKey(ByVal hKey As Long, ByVal KeyName As String)
RegDeleteKey hKey, KeyName
End Sub

[fling_boy]

' Read a Registry value.
' Use KeyName = "" for the default value.
' Supports only DWORD, SZ, and BINARY value types.

Function GetRegistryValue(ByVal hKey As Long, ByVal KeyName As String, _
ByVal ValueName As String, ByVal KeyType As Integer, _
Optional DefaultValue As Variant = Empty) As Variant

Dim handle As Long, resLong As Long
Dim resString As String, length As Long
Dim resBinary() As Byte

' Prepare the default result.
GetRegistryValue = DefaultValue
' Open the key, exit if not found.
If RegOpenKeyEx(hKey, KeyName, 0, KEY_READ, handle) Then Exit Function

Select Case KeyType
Case REG_DWORD
' Read the value, use the default if not found.
If RegQueryValueEx(handle, ValueName, 0, REG_DWORD, _
resLong, 4) = 0 Then
GetRegistryValue = resLong
End If
Case REG_SZ
length = 1024: resString = Space$(length)
If RegQueryValueEx(handle, ValueName, 0, REG_SZ, _
ByVal resString, length) = 0 Then
' If value is found, trim characters in excess.
GetRegistryValue = Left$(resString, length - 1)
End If
Case REG_BINARY
length = 4096
ReDim resBinary(length - 1) As Byte
If RegQueryValueEx(handle, ValueName, 0, REG_BINARY, _
resBinary(0), length) = 0 Then
ReDim Preserve resBinary(length - 1) As Byte
GetRegistryValue = resBinary()
End If
Case Else
Err.Raise 1001, , "Unsupported value type"
End Select

RegCloseKey handle
End Function

' Write / Create a Registry value.
' Use KeyName = "" for the default value.
' Supports only DWORD, SZ, and BINARY value types.

Sub SetRegistryValue(ByVal hKey As Long, ByVal KeyName As String, ByVal ValueName As String, ByVal KeyType As Integer, value As Variant)
Dim handle As Long, lngValue As Long
Dim strValue As String
Dim binValue() As Byte, length As Long

' Open the key, exit if not found.
If RegOpenKeyEx(hKey, KeyName, 0, KEY_WRITE, handle) Then Exit Sub

Select Case KeyType
Case REG_DWORD
lngValue = value
RegSetValueEx handle, ValueName, 0, KeyType, lngValue, 4
Case REG_SZ
strValue = value
RegSetValueEx handle, ValueName, 0, KeyType, ByVal strValue, Len(strValue)
Case REG_BINARY
binValue = value
length = UBound(binValue) - LBound(binValue) + 1
RegSetValueEx handle, ValueName, 0, KeyType, binValue(LBound(binValue)), length
End Select

' Close the key.
RegCloseKey handle
End Sub

' Delete a value.

Sub DeleteRegistryValue(ByVal hKey As Long, ByVal KeyName As String, ByVal ValueName As String)
Dim handle As Long

' Open the key, exit if not found.
If RegOpenKeyEx(hKey, KeyName, 0, KEY_WRITE, handle) Then Exit Sub
' Delete the value.
RegDeleteValue handle, ValueName
' Close the handle.
RegCloseKey handle
End Sub

' Enumerate registry keys under a given key, returns an array of strings.

Function EnumRegistryKeys(ByVal hKey As Long, ByVal KeyName As String) As String()
Dim handle As Long, index As Long, length As Long
ReDim result(0 To 100) As String
Dim FileTimeBuffer(100) As Byte

' Open the key, exit if not found.
If Len(KeyName) Then
If RegOpenKeyEx(hKey, KeyName, 0, KEY_READ, handle) Then Exit Function
' in all case the subsequent functions use hKey
hKey = handle
End If

For index = 0 To 999999
' Make room in the array.
If index > UBound(result) Then
ReDim Preserve result(index + 99) As String
End If
length = 260 ' Max length for a key name.
result(index) = Space$(length)
If RegEnumKey(hKey, index, result(index), length) Then Exit For
result(index) = Left$(result(index), InStr(result(index), vbNullChar) - 1)
Next

' Close the key, if it was actually opened.
If handle Then RegCloseKey handle

' Trim unused items in the array.
ReDim Preserve result(index - 1) As String
EnumRegistryKeys = result()
End Function

' Enumerate registry values under a given key,
' returns a two dimensional array of Variant (row 0 for value names, row 1 for value contents)

Function EnumRegistryValues(ByVal hKey As Long, ByVal KeyName As String) As Variant()
Dim handle As Long, index As Long, valueType As Long
Dim name As String, nameLen As Long
Dim lngValue As Long, strValue As String, dataLen As Long

ReDim result(0 To 1, 0 To 100) As Variant

' Open the key, exit if not found.
If Len(KeyName) Then
If RegOpenKeyEx(hKey, KeyName, 0, KEY_READ, handle) Then Exit Function
' in all case the subsequent functions use hKey
hKey = handle
End If

For index = 0 To 999999
' Make room in the array.
If index > UBound(result, 2) Then
ReDim Preserve result(0 To 1, index + 99) As Variant
End If
nameLen = 260 ' Max length for a key name.
name = Space$(nameLen)
dataLen = 4096
ReDim binValue(0 To dataLen - 1) As Byte
If RegEnumValue(hKey, index, name, nameLen, ByVal 0&, valueType, binValue(0), dataLen) Then Exit For
result(0, index) = Left$(name, nameLen)

Select Case valueType
Case REG_DWORD
' Copy the first 4 bytes into a long variable
CopyMemory lngValue, binValue(0), 4
result(1, index) = lngValue
Case REG_SZ
' Convert the result to a string.
result(1, index) = Left$(StrConv(binValue(), vbUnicode), dataLen - 1)
Case Else
' In all other cases, just copy the array of bytes.
ReDim Preserve binValue(0 To dataLen - 1) As Byte
result(1, index) = binValue()
End Select
Next

' Close the key, if it was actually opened.
If handle Then RegCloseKey handle

' Trim unused items in the array.
ReDim Preserve result(0 To 1, index - 1) As Variant
EnumRegistryValues = result()
End Function

' You can use this function to decypher error messages from the API.

Function SystemMessage(ApiErrorCode As Long) As String
Dim buffer As String, length As Long
Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000

buffer = Space$(1024)
length = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0, ApiErrorCode, 0, buffer, Len(buffer), ByVal 0)
SystemMessage = Left$(buffer, length)

End Function

[freeking]

先谢先谢，我回去研究研究

[freeking]

我回去研究研究， ，先谢

[freeking]

我回去研究研究， ，先谢