关于在VB6中读写注册表的问题？

这是为一个登陆窗口设计的，我想在注册表HKEY_LOCAL_MACHINE\Software下创建主键abc\user既有路径HKEY_LOCAL_MACHINE\Software\abc\user然后在这个基础上创建两个字符串值user1="xiaoming" 和 password="12345678"怎样用代码实现以上内容的创建和读取，例如我在窗体上放一个combo控件和一个text控件，把读取到的user1的值"xiaoming"放到bombobox控件的list属性中，然后在运行时按照user1检验text控件中的值是否与password1相同大家能不能帮我解决，最好是按我所说得举个例子，谢谢。
如果有若干个user和password，即user1、user2、user3....和password1、password2、password3....怎样实现上面的问题，即是说在combo控件选择的值与user3相同便检验text的值是否与password3的值相同。

19 个解决方案

#1

模块中的代码
'注册表类
Public Declare Function RegQueryValueEx& Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey&, ByVal lpszValueName$, ByVal lpdwRes&, lpdwType&, ByVal lpDataBuff$, nSize&)
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

Const HKEY_LOCAL_MACHINE = &H80000002
Const KEY_QUERY_VALUE = &H1&
Const KEY_ENUMERATE_SUB_KEYS = &H8&
Const KEY_NOTIFY = &H10&
Const READ_CONTROL = &H20000
Const STANDARD_RIGHTS_READ = READ_CONTROL
Const KEY_READ = STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY

Public Function GetReg(sVBEntry As String) As String

    Dim s As String * 255
    Dim lVBKey As Long, lType As Long, lLen As Long, lRC As Long
    Dim sPath As String

    sPath = ""
    lLen = Len(s)
    lRC = RegOpenKeyEx(HKEY_LOCAL_MACHINE, sVBEntry, 0, KEY_READ, lVBKey)
    '搜索相应键值
    If lRC = 0 Then
        '执行找到
        lRC = RegQueryValueEx(lVBKey, "ServerName", 0, lType, s, lLen)
        If lRC = 0 Then sPath = Left$(s, lLen - 1)  'RegQueryValueEx succeded
        RegCloseKey lVBKey
    else
        '建立主键
    End If
    GetReg = sPath

    程序中
    strTemp = "SOFTWARE\abc\user"
    strServerName = GetReg(strTemp)

#2

你如果非要指定HKEY_LOCAL_MACHINE\Software\abc\user就要用到API了。在网上搜一搜，可以找到相应的控件。
或者使用SaveSetting appname, section, key, setting
GetSetting(appname, section, key[, default])
DeleteSetting appname, section[, key]
操作。这几条语句建立键值得位置是在注册标的一个专为VB程序设置的位置，对你应该是够用了。

#3

同意！

#4

。。。

#5

建立主键
public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
接上面else
'建立主键
    s=xiaoming
    llen=len(s)

    lRC = RegCreateKey(HKEY_LOCAL_MACHINE, sVBEntry, lVBKey)
    If lRC = 0 Then MsgBox "seuee"
'设置值项
    lRC = RegSetValueEx(lVBKey, strtemp, 0, REG_SZ, ByVal s, lLen)
    If lRC = 0 Then MsgBox "seuee"

    若有多个的话可用
   regEnumValue
   方法差不多

#6

To:dent(程式猎人--消灭一切BUGS,全无敌)
我知道你说的那几个函数,我就是为了学一些新的东西而已!!

#7

to:fullor2000(兽子)
你能不能详细说说
Const HKEY_LOCAL_MACHINE = &H80000002
Const KEY_QUERY_VALUE = &H1&
Const KEY_ENUMERATE_SUB_KEYS = &H8&
Const KEY_NOTIFY = &H10&
Const READ_CONTROL = &H20000
Const STANDARD_RIGHTS_READ = READ_CONTROL
Const KEY_READ = STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY
这几句是干什么用的，后面的值是固定的吗，如果是固定的，要想知道其他主键的值应该怎么办。
还有
RegOpenKeyEx(HKEY_LOCAL_MACHINE, sVBEntry, 0, KEY_READ, lVBKey)
中sVBEntry、KEY_READ、lVBKey又代表什么

我知道
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

lpReserved Long，未用，设为零
lpType Long，用于装载取回数据类型的一个变量
lpData Any，用于装载指定值的一个缓冲区
lpcbData Long，用于装载lpData缓冲区长度的一个变量。一旦返回，它会设为实际装载到缓冲区的字节数
但是就是不明白各代表什么意思，能不能用白话帮我解释一下。

#8

VB提供了这样一个模块，它里面包含了关于注册表操作的函数声明及一些过程\Program Files\Microsoft Visual Studio\VB98\Template\Code\Registry Access.bas

#9

to:AechoJohn(江江)
谢谢。

#10

Const HKEY_LOCAL_MACHINE = &H80000002
Const KEY_QUERY_VALUE = &H1&
Const KEY_ENUMERATE_SUB_KEYS = &H8&
Const KEY_NOTIFY = &H10&
Const READ_CONTROL = &H20000
Const STANDARD_RIGHTS_READ = READ_CONTROL
Const KEY_READ = STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY
这些值都定义在windows.inc中，你可以去网上下载一个。

RegOpenKeyEx(HKEY_LOCAL_MACHINE, sVBEntry, 0, KEY_READ, lVBKey)
中sVBEntry、KEY_READ、lVBKey又代表什么
sVBEntry要建的子建
可以定义成sVBEntry="Software\abc\user"
KEY_READ为windows.inc中的预定义值
lVBKey返回了你要获得的子建的句柄。

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

lpReserved Long，未用，设为零：就是微软夜没有想好干什么用的。
lpType Long，用于装载取回数据类型的一个变量：返回数据类型变量。通常是long
lpData Any，用于装载指定值的一个缓冲区：实际上在C中就是一个指针的概念，VB没有指针，就用这个代替。
lpcbData Long，用于装载lpData缓冲区长度的一个变量。一旦返回，它会设为实际装载到缓冲区的字节数：就是前面这个指针所指向的数据区域的长度。

#11

SaveSetting和GetSetting不是可以更为简单的达到这个目的吗？

#12

我详细的看了一下那个模块，也没有说明注册表关键字安全选项...等是做什么用的，还有
' Reg Data Types...
Const REG_SZ = 1                         ' Unicode空终结字符串
Const REG_EXPAND_SZ = 2                  ' Unicode空终结字符串
Const REG_DWORD = 4                      ' 32-bit 数字
Unicode空终结字符串是干什么的
' 注册表关键字根类型...
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_PERFORMANCE_DATA = &H80000004
是做什么的。

#13

to：fullor2000(兽子)
windows.inc是什么

#14

windows预定义的值都写在里面。

#15

我找到了一个全英文的,有没有代中文解说的,

#16

#17

Option Explicit
Const REG_SZ As Long = 1
Const REG_DWORD As Long = 4
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const ERROR_NONE = 0
Const ERROR_BADDB = 1
Const ERROR_BADKEY = 2
Const ERROR_CANTOPEN = 3
Const ERROR_CANTREAD = 4
Const ERROR_CANTWRITE = 5
Const ERROR_OUTOFMEMORY = 6
Const ERROR_INVALID_PARAMETER = 7
Const ERROR_ACCESS_DENIED = 8
Const ERROR_INVALID_PARAMETERS = 87
Const ERROR_NO_MORE_ITEMS = 259
Const KEY_ALL_ACCESS = &H3F
Const REG_OPTION_NON_VOLATILE = 0
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) 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, ByVal lpSecurityAttributes As Long, 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 ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Private Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long
Private Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long
Private Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long
Private Declare Function RegDeleteKey& Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String)
Private Declare Function RegDeleteValue& Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String)
'删除键
Public Function DeleteKey(lPredefinedKey As Long, sKeyName As String)
    Dim lRetVal As Long
    Dim hKey As Long
    lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
    lRetVal = RegDeleteKey(lPredefinedKey, sKeyName)
    RegCloseKey (hKey)
End Function
'删除键值
Public Function DeleteValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)
       Dim lRetVal As Long
       Dim hKey As Long
       lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
       lRetVal = RegDeleteValue(hKey, sValueName)
       RegCloseKey (hKey)
End Function
'赋值(下一层)
Public Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long
    Dim lValue As Long
    Dim sValue As String
    Select Case lType
        Case REG_SZ
            sValue = vValue
            SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))
        Case REG_DWORD
            lValue = vValue
            SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)
        End Select
End Function
'获取值(下一层)
Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long
    Dim cch As Long
    Dim lrc As Long
    Dim lType As Long
    Dim lValue As Long
    Dim sValue As String
    On Error GoTo QueryValueExError
    lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
    If lrc <> ERROR_NONE Then Error 5
    Select Case lType
        Case REG_SZ:
            sValue = String(cch, 0)
            lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)
            If lrc = ERROR_NONE Then
                vValue = Left$(sValue, cch)
            Else
                vValue = Empty
            End If
        Case REG_DWORD:
            lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch)
            If lrc = ERROR_NONE Then vValue = lValue
        Case Else
            lrc = -1
    End Select
QueryValueExExit:
        QueryValueEx = lrc
        Exit Function
QueryValueExError:
        Resume QueryValueExExit
End Function
'建立新键
Public Function CreateNewKey(lPredefinedKey As Long, sNewKeyName As String)
    Dim hNewKey As Long
    Dim lRetVal As Long

    lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hNewKey, lRetVal)
    RegCloseKey (hNewKey)
End Function
'给指定的键值赋值
Public Function SetKeyValue(lPredefinedKey As Long, sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)
       Dim lRetVal As Long
       Dim hKey As Long
       lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
       lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
       RegCloseKey (hKey)
End Function
'获取指定的键值
Public Function QueryValue(lPredefinedKey As Long, sKeyName As String, sValueName As String) As String
       Dim lRetVal As Long
       Dim hKey As Long
       Dim vValue As Variant

       lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
       lRetVal = QueryValueEx(hKey, sValueName, vValue)
       QueryValue = vValue
       RegCloseKey (hKey)
End Function

Public Function Operate(sKeyName As String, sValueName As String, vValueSetting As Variant, Sign As Integer) As String

    Select Case Sign
        Case 1: CreateNewKey HKEY_CURRENT_USER, sKeyName
        Case 2: SetKeyValue HKEY_CURRENT_USER, sKeyName, sValueName, vValueSetting, REG_SZ
        Case 3: Operate = QueryValue(HKEY_CURRENT_USER, sKeyName, sValueName)
        Case 4: DeleteValue HKEY_CURRENT_USER, sKeyName, sValueName
        Case 5: DeleteKey HKEY_CURRENT_USER, sKeyName
    End Select

End Function

#18

Option Explicit
...
...
Public Enum EnumRegistryValue
    REG_SZ = 1          '字符串
    REG_DWORD = 4       '双字节
    REG_BINARY = 3      '二进制
End Enum

Public Enum EnumRegistryKey
    HKEY_CLASSES_ROOT = &H80000000
    HKEY_CURRENT_USER = &H80000001
    HKEY_LOCAL_MACHINE = &H80000002
    HKEY_USERS = &H80000003
End Enum
Dim l As Long, r As Long

Public Function DeleteKey(RootKey As EnumRegistryKey, SubKey As String) As Long
'删除键
On Error GoTo er
l = RegOpenKeyEx(RootKey, SubKey, 0, &H3F, r)
If l <> 0 Then GoTo er
l = RegDeleteKey(r, SubKey)
DeleteKey = l
RegCloseKey r
Exit Function
er:
DeleteKey = ""
RegCloseKey r
End Function

Public Function 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 Function

Public Function 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
    RegQueryValueEx r, Name, 0, 3, ByVal vbNullString, s
    sValue = String(s, 0)
    RegQueryValueEx r, Name, 0, 3, ByVal sValue, s
    GetValue = sValue
Case Else
    GetValue = ""
End Select
RegCloseKey r
Exit Function
er:
GetValue = -1
RegCloseKey r
End Function

Public Function CreateKey(RootKey As EnumRegistryKey, SubKey As String) As Long
'建立键
l = RegOpenKeyEx(RootKey, SubKey, 0, &H3F, r)
If l <> 0 Then l = RegCreateKey(RootKey, SubKey, 1)
RegCloseKey r
CreateKey = l
End Function

#19

Option Explicit

Const REG_SZ As Long = 1
Const REG_DWORD As Long = 4

Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003

Const ERROR_NONE = 0
Const ERROR_BADDB = 1
Const ERROR_BADKEY = 2
Const ERROR_CANTOPEN = 3
Const ERROR_CANTREAD = 4
Const ERROR_CANTWRITE = 5
Const ERROR_OUTOFMEMORY = 6
Const ERROR_INVALID_PARAMETER = 7
Const ERROR_ACCESS_DENIED = 8
Const ERROR_INVALID_PARAMETERS = 87
Const ERROR_NO_MORE_ITEMS = 259

Const KEY_ALL_ACCESS = &H3F

Const REG_OPTION_NON_VOLATILE = 0

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) 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, ByVal lpSecurityAttributes As Long, 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 ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Private Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long
Private Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long
Private Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long
Private Declare Function RegDeleteKey& Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String)
Private Declare Function RegDeleteValue& Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String)

'删除键
Public Function DeleteKey(lPredefinedKey As Long, sKeyName As String)

    Dim lRetVal As Long
    Dim hKey As Long
    lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
    lRetVal = RegDeleteKey(lPredefinedKey, sKeyName)
    RegCloseKey (hKey)

End Function

'删除键值
Public Function DeleteValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)

       Dim lRetVal As Long
       Dim hKey As Long

       lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
       lRetVal = RegDeleteValue(hKey, sValueName)
       RegCloseKey (hKey)

End Function

'赋值(下一层)
Public Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long

    Dim lValue As Long
    Dim sValue As String

    Select Case lType
        Case REG_SZ
            sValue = vValue
            SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))
        Case REG_DWORD
            lValue = vValue
            SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)
        End Select

End Function

'获取值(下一层)
Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long

    Dim cch As Long
    Dim lrc As Long
    Dim lType As Long
    Dim lValue As Long
    Dim sValue As String

    On Error GoTo QueryValueExError

    lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
    If lrc <> ERROR_NONE Then Error 5

    Select Case lType
        Case REG_SZ:
            sValue = String(cch, 0)
            lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)
            If lrc = ERROR_NONE Then
                vValue = Left$(sValue, cch)
            Else
                vValue = Empty
            End If

        Case REG_DWORD:
            lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch)
            If lrc = ERROR_NONE Then vValue = lValue
        Case Else
            lrc = -1
    End Select

QueryValueExExit:

        QueryValueEx = lrc
        Exit Function

QueryValueExError:

        Resume QueryValueExExit

End Function

'建立新键
Public Function CreateNewKey(lPredefinedKey As Long, sNewKeyName As String)

    Dim hNewKey As Long
    Dim lRetVal As Long

    lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hNewKey, lRetVal)
    RegCloseKey (hNewKey)
End Function

'Sub main()
'    '函数在注册表的"HKEY_CURRENT_USER\Software"中建立了
'    '一个SubKey1项并在其中建立了值，并在显示后删除建立
'    '的值，如果你想通过RegEdit看到结果，可以将最后两句
'    '删除，不过要记得手动删除建立的键值
'    CreateNewKey HKEY_CURRENT_USER, "Software\SubKey1\SubKey2"
'    SetKeyValue HKEY_CURRENT_USER, "Software\SubKey1\SubKey2", "Test", "This is just a test", REG_SZ
'    MsgBox QueryValue(HKEY_CURRENT_USER, "Software\SubKey1\SubKey2", "Test")
'    DeleteValue HKEY_CURRENT_USER, "Software\SubKey1\SubKey2", "Test"
'    DeleteKey HKEY_CURRENT_USER, "Software\SubKey1\SubKey2"
'End Sub

'给指定的键值赋值
Public Function SetKeyValue(lPredefinedKey As Long, sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)

       Dim lRetVal As Long
       Dim hKey As Long

       lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
       lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
       RegCloseKey (hKey)

End Function

'获取指定的键值
Public Function QueryValue(lPredefinedKey As Long, sKeyName As String, sValueName As String) As String

       Dim lRetVal As Long
       Dim hKey As Long
       Dim vValue As Variant

       lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
       lRetVal = QueryValueEx(hKey, sValueName, vValue)
       QueryValue = vValue
       RegCloseKey (hKey)
End Function

#20

#1

#2

#3

同意！

#4

。。。

#5

#6

To:dent(程式猎人--消灭一切BUGS,全无敌)
我知道你说的那几个函数,我就是为了学一些新的东西而已!!

#7

#8

VB提供了这样一个模块，它里面包含了关于注册表操作的函数声明及一些过程\Program Files\Microsoft Visual Studio\VB98\Template\Code\Registry Access.bas

#9

to:AechoJohn(江江)
谢谢。

#10

#11

SaveSetting和GetSetting不是可以更为简单的达到这个目的吗？

#12

#13

to：fullor2000(兽子)
windows.inc是什么

#14

windows预定义的值都写在里面。

#15

我找到了一个全英文的,有没有代中文解说的,

#16

#17

#18

#19

Option Explicit

Const REG_SZ As Long = 1
Const REG_DWORD As Long = 4

Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003

Const ERROR_NONE = 0
Const ERROR_BADDB = 1
Const ERROR_BADKEY = 2
Const ERROR_CANTOPEN = 3
Const ERROR_CANTREAD = 4
Const ERROR_CANTWRITE = 5
Const ERROR_OUTOFMEMORY = 6
Const ERROR_INVALID_PARAMETER = 7
Const ERROR_ACCESS_DENIED = 8
Const ERROR_INVALID_PARAMETERS = 87
Const ERROR_NO_MORE_ITEMS = 259

Const KEY_ALL_ACCESS = &H3F

Const REG_OPTION_NON_VOLATILE = 0

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) 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, ByVal lpSecurityAttributes As Long, 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 ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Private Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long
Private Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long
Private Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long
Private Declare Function RegDeleteKey& Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String)
Private Declare Function RegDeleteValue& Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String)

'删除键
Public Function DeleteKey(lPredefinedKey As Long, sKeyName As String)

    Dim lRetVal As Long
    Dim hKey As Long
    lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
    lRetVal = RegDeleteKey(lPredefinedKey, sKeyName)
    RegCloseKey (hKey)

End Function

'删除键值
Public Function DeleteValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)

       Dim lRetVal As Long
       Dim hKey As Long

       lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
       lRetVal = RegDeleteValue(hKey, sValueName)
       RegCloseKey (hKey)

End Function

'赋值(下一层)
Public Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long

    Dim lValue As Long
    Dim sValue As String

    Select Case lType
        Case REG_SZ
            sValue = vValue
            SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))
        Case REG_DWORD
            lValue = vValue
            SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)
        End Select

End Function

'获取值(下一层)
Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long

    Dim cch As Long
    Dim lrc As Long
    Dim lType As Long
    Dim lValue As Long
    Dim sValue As String

    On Error GoTo QueryValueExError

    lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
    If lrc <> ERROR_NONE Then Error 5

    Select Case lType
        Case REG_SZ:
            sValue = String(cch, 0)
            lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)
            If lrc = ERROR_NONE Then
                vValue = Left$(sValue, cch)
            Else
                vValue = Empty
            End If

        Case REG_DWORD:
            lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch)
            If lrc = ERROR_NONE Then vValue = lValue
        Case Else
            lrc = -1
    End Select

QueryValueExExit:

        QueryValueEx = lrc
        Exit Function

QueryValueExError:

        Resume QueryValueExExit

End Function

'建立新键
Public Function CreateNewKey(lPredefinedKey As Long, sNewKeyName As String)

    Dim hNewKey As Long
    Dim lRetVal As Long

    lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hNewKey, lRetVal)
    RegCloseKey (hNewKey)
End Function

'Sub main()
'    '函数在注册表的"HKEY_CURRENT_USER\Software"中建立了
'    '一个SubKey1项并在其中建立了值，并在显示后删除建立
'    '的值，如果你想通过RegEdit看到结果，可以将最后两句
'    '删除，不过要记得手动删除建立的键值
'    CreateNewKey HKEY_CURRENT_USER, "Software\SubKey1\SubKey2"
'    SetKeyValue HKEY_CURRENT_USER, "Software\SubKey1\SubKey2", "Test", "This is just a test", REG_SZ
'    MsgBox QueryValue(HKEY_CURRENT_USER, "Software\SubKey1\SubKey2", "Test")
'    DeleteValue HKEY_CURRENT_USER, "Software\SubKey1\SubKey2", "Test"
'    DeleteKey HKEY_CURRENT_USER, "Software\SubKey1\SubKey2"
'End Sub

'给指定的键值赋值
Public Function SetKeyValue(lPredefinedKey As Long, sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)

       Dim lRetVal As Long
       Dim hKey As Long

       lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
       lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
       RegCloseKey (hKey)

End Function

'获取指定的键值
Public Function QueryValue(lPredefinedKey As Long, sKeyName As String, sValueName As String) As String

       Dim lRetVal As Long
       Dim hKey As Long
       Dim vValue As Variant

       lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
       lRetVal = QueryValueEx(hKey, sValueName, vValue)
       QueryValue = vValue
       RegCloseKey (hKey)
End Function

关于在VB6中读写注册表的问题？

19 个解决方案

#1

#2

#3

#4

#5

#6

#7

#8

#9

#10

#11

#12

#13

#14

#15

#16

#17

#18

#19

#20

#1

#2

#3

#4

#5

#6

#7

#8

#9

#10

#11

#12

#13

#14

#15

#16

#17

#18

#19

#20

相关文章