Access操作注册表信息的代码

Attribute VB_Name = "Module1"

Option Explicit

'操作注册表

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

Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hkey As Long) As Long

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

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

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 Const SYNCHRONIZE = &H100000

Public Const READ_CONTROL = &H20000

Public Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)

Public Const KEY_QUERY_VALUE = &H1

Public Const KEY_ENUMERATE_SUB_KEYS = &H8

Public Const KEY_NOTIFY = &H10

Public Const KEY_SET_VALUE = &H2

Public Const KEY_CREATE_SUB_KEY = &H4

Public Const KEY_READ = ((READ_CONTROL Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))

Public Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))

Public Const REG_SZ = 1

Public Const REG_BINARY = 3

Public Const REG_DWORD = 4

Public Const HKEY_LOCAL_MACHINE = &H80000002

Public Const REG_OPENED_EXISTING_KEY = &H2

__________________________________________________

'在需要时建立主键

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

MsgBox "不能建立该键", , "注意"

Else

' Return True if the key already existed.

If Disposition = REG_OPENED_EXISTING_KEY Then CreateRegistryKey = True

' Close the key.

RegCloseKey Handle

End If

End Function

'读取注册表的键值

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

MsgBox "不支持的类型", , "注意"

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, Disposition As Long

Dim strValue As String

Dim binValue() As Byte, length As Long

' Open the key, exit if not found.

If RegCreateKeyEx(hkey, KeyName, 0, 0, 0, 0, 0, Handle, Disposition) Then

MsgBox "出错了", , "注意"

Exit Sub

End If

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

End Sub

Form中的使用方法如下:

'窗体中有一个按钮，名为cmdOk

Private Sub Form_Load()

CreateRegistryKey HKEY_LOCAL_MACHINE, "Software\Text1"

CreateRegistryKey HKEY_LOCAL_MACHINE, "Software\Text1\Text2"

End Sub

Private Sub cmdOk_Click()

If RegOpenKeyEx(HKEY_LOCAL_MACHINE, "Software\Text1\Text2", 0, KEY_READ, Handle) = 0 Then

KeyValue = Text1.Text

RegSetValueEx Handle, "Text3", 0, REG_SZ, ByVal KeyValue, Len(KeyValue)

KeyValue = Text2.Text

RegSetValueEx Handle, "Text4", 0, REG_SZ, ByVal KeyValue, Len(KeyValue)

KeyValue = Text3.Text

RegSetValueEx Handle, "Text5", 0, REG_SZ, ByVal KeyValue, Len(KeyValue)

KeyValue = Text5.Text

RegSetValueEx Handle, "Text6", 0, REG_SZ, ByVal KeyValue, Len(KeyValue)

RegCloseKey Handle

End If

End Sub