怎样写入和读注册表？跟者有分！

Option ExplicitPublic 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 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 RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult 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 String, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition 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 RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) 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 FILETIME) As Long
Public Declare Function ExpandEnvironmentStrings Lib "kernel32" Alias "ExpandEnvironmentStringsA" (ByVal lpSrc As String, ByVal lpDst As String, ByVal nSize 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 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
Dim l As Long, R As LongFunction DeleteKey(RootKey As EnumRegistryKey, SubKey As String) As Boolean
'删除键
On Error GoTo er
DeleteKey = DeleteSubkeyTree(RootKey, SubKey)
Exit Function
er:
DeleteKey = False
End FunctionFunction SetValue(RootKey As EnumRegistryKey, SubKey As String, Name As String, fbType As EnumRegistryValue, Value As Variant) As Long
'设置值
On Error GoTo er
Dim i As Integer, tmp As String, l As Integer
l = RegOpenKeyEx(RootKey, SubKey, 0, &H3F, R)
If l <> 0 Then GoTo er
Select Case fbType
Case REG_DWORD
    SetValue = RegSetValueEx(R, Name, 0&, 4, CLng(Value), 4)
Case REG_SZ
    l = 0
    For i = 1 To Len(Value)
        If Asc(Mid(Value, i, 1)) < 0 Then
            l = l + 2
        Else
            l = l + 1
        End If
    Next i
    SetValue = RegSetValueEx(R, Name, 0&, 1, ByVal CStr(Value), l)
Case REG_BINARY
    SetValue = RegSetValueEx(R, Name, 0&, 3, ByVal CStr(Value), Len(CStr(Value)))
Case Else
    SetValue = -1
End Select
RegCloseKey R
Exit Function
er:
SetValue = -1
RegCloseKey R
End FunctionFunction GetValue(RootKey As EnumRegistryKey, SubKey As String, Name As String, fbType As EnumRegistryValue) As Variant
'读取值
Dim s As Long, sValue As String, tmp As String, i As Integer, bin() As Byte
On Error GoTo er
tmp = String(1024, 0)
s = 1024
l = RegOpenKeyEx(RootKey, SubKey, 0, &H3F, R)
If l <> 0 Then GoTo er
Select Case fbType
Case REG_DWORD
    RegQueryValueEx R, Name, 0, 1, ByVal tmp, s
    tmp = Left(tmp, InStr(tmp, Chr(0)) - 1)
    For i = Len(tmp) To 1 Step -1
        sValue = sValue & Hex(Asc(Mid(tmp, i, 1)))
    Next i
    If sValue = "" Then GoTo er
    GetValue = Format("&H" & sValue)
Case REG_SZ
    RegQueryValueEx R, Name, 0, 1, ByVal tmp, s
    tmp = Left(tmp, InStr(tmp, Chr(0)) - 1)
    GetValue = tmp
Case REG_BINARY
    l = RegQueryValueEx(R, Name, 0, 3, ByVal vbNullString, s)
    ReDim bin(0 To s - 1) As Byte
    RegQueryValueEx R, Name, 0, 3, bin(0), s
    For i = 0 To UBound(bin)
        GetValue = GetValue & CStr(Hex(bin(i)))
    Next i
Case REG_EXPAND_SZ
    l = RegQueryValueEx(R, Name, 0, 2, ByVal vbNullString, s)
    tmp = String(s, Chr(0))
    RegQueryValueEx R, Name, 0, 2, ByVal tmp, s
    tmp = Left(tmp, InStr(tmp, Chr(0)) - 1) 'S为读取出来的字符串
    GetValue = String(Len(tmp) + 256, Chr(0)) 'S2为扩展之后的字符串
    ExpandEnvironmentStrings tmp, GetValue, Len(GetValue)
    GetValue = Left(GetValue, InStr(GetValue, Chr(0)) - 1)
Case REG_MULTI_SZCase Else
    GetValue = ""
End Select
RegCloseKey R
Exit Function
er:
GetValue = -1
RegCloseKey R
End FunctionFunction CreateKey(RootKey As EnumRegistryKey, SubKey As String) As Boolean
'建立键
l = RegOpenKeyEx(RootKey, SubKey, 0, &H3F, R)
If l <> 0 Then
    l = RegCreateKey(RootKey, SubKey, 1)
Else
    GoTo er
End If
RegCloseKey R
CreateKey = IIf(l = 0, True, False)
Exit Function
er:
RegCloseKey R
CreateKey = False
End FunctionFunction DeleteValue(RootKey As EnumRegistryKey, SubKey As String, Name As String) As Boolean
'删除值
l = RegOpenKeyEx(RootKey, SubKey, 0, &H3F, R)
If l = 0 Then l = RegDeleteValue(R, Name)
RegCloseKey R
DeleteValue = IIf(l = 0, True, False)
End FunctionPrivate Function DeleteSubkeyTree(ByVal hKey As Long, ByVal SubKey As String) As Boolean
Dim ret As Long, Index As Long, Name As String
Dim hSubKey As Long
ret = RegOpenKeyEx(hKey, SubKey, 0, &H3F, hSubKey)
If ret <> 0 Then
    DeleteSubkeyTree = False
    Exit Function
End If
ret = RegDeleteKey(hSubKey, "")
If ret <> 0 Then
Name = String(256, Chr(0))
While RegEnumKey(hSubKey, 0, Name, Len(Name)) = 0 And DeleteSubkeyTree(hSubKey, Name)
Wend
ret = RegDeleteKey(hSubKey, "")
End If
DeleteSubkeyTree = (ret = 0)
RegCloseKey hSubKey
End Function

Public Enum EnumRegistryValue
    REG_SZ = 1          '字符串
    REG_DWORD = 4       '双字节
    REG_BINARY = 3      '二进制
    REG_DWORD_BIG_ENDIAN = 5           ' 32-bit number
    REG_DWORD_LITTLE_ENDIAN = 4        ' 32-bit number (same as REG_DWORD)
    REG_EXPAND_SZ = 2                  ' Unicode nul terminated string
    REG_MULTI_SZ = 7                   ' Multiple Unicode strings
End EnumPublic Enum EnumRegistryKey
    HKEY_CLASSES_ROOT = &H80000000
    HKEY_CURRENT_USER = &H80000001
    HKEY_LOCAL_MACHINE = &H80000002
    HKEY_USERS = &H80000003
End Enum

VB声明 Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA"
(ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
参数类型及说明:
hKey:Key Handle
lpSubKey:SubKey名称或路径
phkResult:若RegOpenKey执行成功，则这一参数返回Subkey的hKey.返回值: =0,表示成功；≠0,表示失败。[注意这一点与别的API函数不太一样]调用例：
Dim ret As Long, hKey As Long, hKey2 As Long
'取得"HKEY_LOCAL_MACHINE"底下的"SOFTWARE\Microsoft"这个SubKey Handle.
ret = RegOpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft", hKey)
If ret = 0 Then 'If Success
MsgBox "HKLM\SOFTWARE\Microsoft = " & hKey
End If '继续以刚才所取得的"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft"hKey为参数，再取得它的'SubKey"Windows\CurrentVersion"的handle。ret = RegOpenKey(hKey, "Windows\CurrentVersion", hKey2)
If ret = 0 Then
MsgBox "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion = " & hKey2
End If相关的两个API函数是：RegCreateKey[建立SubKey]和RegClose[关闭SubKey]
详细说明：
RegCreateKey函数：
VB声明 Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA"
(ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
它的参数用法与RegOpenKey一样。所不同的是RegOpenKey只能打开已经有的SubKey,而RegCreateKey则可以建立SubKey,比较特别的是，如果调用RegCreateKey所建立的SubKey是一个已经存在的SubKey,则它的功能和RegOpenKey相同。由于RegCreateKey的这种特性，有的程序员干脆不用RegOpenKey，而用RegCreateKey来统一代替RegOpenKey。
RegClose函数：
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
当我们不再存取Registry时，将打开或建立的SubKey关闭是一个比较好的习惯，就正如我们在使用C语言的文件打开函数后必须要关闭一样。一个完整的例子：Option Explicit
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 Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA"
(ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long Sub Main()
Dim ret As Long, hKey As Long, hKey2 As Long
ret = RegOpenKey(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft", hKey)
If ret = 0 Then
MsgBox "HKLM\SOFTWARE\Microsoft = " & hKey
End If ret = RegOpenKey(hKey, "Windows\CurrentVersion", hKey2)
If ret = 0 Then
MsgBox "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion = " & hKey2
End If
'Use RegCreateKey function to create subkey "HKEY_LOCAL_MACHINE\SOFTWARE\Hongqt"
ret = RegCreateKey(HKEY_LOCAL_MACHINE, "SOFTWARE\Hongqt", hKey)
If Not ret Then
MsgBox "Create HKEY_LOCAL_MACHINE\SOFTWARE\Hongqt SubKey Success"
Else
MsgBox "Create Subkey Operation Fail"
End If RegCloseKey hKey
RegCloseKey hKey2
End SubRegQueryValueEx的Vb函数声明和参数解释：
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
hkey:Key Handle
lpValueName:Value Name
lpReserved:保留参数，调用时设置为0即可
lpType:返回读取的数据类型
lpData:返回读取的数据
lpcbData:传入lpData数据的长度，若成功读取数据，则返回所读取的数据的长度。
返回值: =0,表示成功；≠0,表示失败。
说明：
1、这一函数除了可读取指定名称的值之外，也可以读取default value。如果要读取default value,只需要将
参数lpValueName设置为""[空字符串]即可。
2、lpType 的可能取值，我们在第二篇文章中曾经提到过它的。
Enum ValueType
REG_NONE = 0
REG_SZ = 1 -->字符串
REG_EXPAND_SZ = 2 -->可展开式字符串
REG_BINARY = 3 -->Binary数据
REG_DWORD = 4 -->长整数
REG_DWORD_BIG_ENDIAN = 5 -->BIG_ENDIAN长整数
REG_MULTI_SZ = 7 -->多重字符串
End Enum 先利用RegQueryValueEx函数获得某个value的数据类型和数据的长度，只需要将参数lpData设置为vbNullString[表示暂时不读取数据]，然后由参数lpType获得数据类型，lpcbData获得数据长度。调用例子如下：
Dim hKey As Long, ret As Long, lenData As Long, typeData As Long
Dim Name As String
'读取HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run的internat.exe的value.
Name="internat.exe"
ret=RegOpenKey(HKEY_LOCAL_MACHINE,"Software\Microsoft\Windows\CurrentVersion\Run", hKey)
if ret=0 then
ret = RegQueryValueEx(hKey, Name, 0, typeData, ByVal vbNullString, lenData)'注意ByVal千万别忘了
end if

Const REG_SZ = 1 ' Unicode nul terminated string
Const REG_BINARY = 3 ' Free form binary
Const HKEY_CURRENT_USER = &H80000001
'關閉subkey的key
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
'創建subkey的key
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
'刪除某一key的名稱
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
'取得subkey的key
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
'讀取某一key特定名稱的值
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
'設定某一key特定名稱的值
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 FunctionFunction 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 FunctionSub 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 SubSub 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 SubSub 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'Set Value
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'Get Value
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'Delete Value
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 SubPrivate Sub Form_Load()
    Command1.Caption = "Set Value"
    Command2.Caption = "Get Value"
    Command3.Caption = "Delete Value"
End Sub

存储一些参数用getsetting、savesetting就行。
用API的话可参照上面的帖子。
rainstormmaster(rainstormmaster)说的对，要学会搜索。

调试易

怎样写入和读注册表？跟者有分！

解决方案 »