保存注册表（写注册表）问题

Question

写注册表命令：SaveSetting
    怎么把字串写到自己规定的固定的节点，而不是默认的？
    比如：我想写到HKEY_CLASSES_ROOT主键下的某个键，而不是默认的VB主键下的某个键。

Answer 1

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 SelectEnd Function
   例如： 'SetKeyValue HKEY_CURRENT_USER, "Software\SubKey1\SubKey2", "Test", "This is just a test", REG_SZ

Answer 2

Global Const REG_SZ As Long = 1Global Const HKEY_CLASSES_ROOT = &H80000000
Global Const HKEY_CURRENT_USER = &H80000001
Global Const HKEY_LOCAL_MACHINE = &H80000002
Global Const HKEY_USERS = &H80000003Declare 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
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

Answer 3

Public Function QueryValue(lPredefinedKey As Long, sKeyName As String, sValueName 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

Answer 4

送大家我常用的操作注册表的类（读取，保存字符串为主）
Option Explicit
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, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition 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
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As LongPrivate Type SECURITY_ATTRIBUTES
  nLength As Long
  lpSecurityDescriptor As Long
  bInheritHandle As Boolean
End TypePublic Enum BaseRegKey
    HKEY_CLASSES_ROOT_ = &H80000000
    HKEY_CURRENT_USER_ = &H80000001
    HKEY_LOCAL_MACHINE_ = &H80000002
    HKEY_USERS_ = &H80000003
    HKEY_CURRENT_CONFIG_ = &H80000005
    HKEY_DYN_DATA_ = &H80000006
End Enum'参数samDesired
'One or more of the following flags specifying the desired read/write access:
Const KEY_ALL_ACCESS = &HF003F
'Permission for all types of access.
Const KEY_CREATE_LINK = &H20
'Permission to create symbolic links.
Const KEY_CREATE_SUB_KEY = &H4
'Permission to create subkeys.
Const KEY_ENUMERATE_SUB_KEYS = &H8
'Permission to enumerate subkeys.
Const KEY_EXECUTE = &H20019
'Same as KEY_READ.
Const KEY_NOTIFY = &H10
'Permission to give change notification.
Const KEY_QUERY_VALUE = &H1
'Permission to query subkey data.
Const KEY_READ = &H20019
'Permission for general read access.
Const KEY_SET_VALUE = &H2
'Permission to set subkey data.
Const KEY_WRITE = &H20006
'Permission for general write access.'参数lpType
'Variable which receives one of the following flags identifying the data type of the data read:
Const REG_BINARY = 3
'A non-text sequence of bytes.
Const REG_DWORD = 4
'Same as REG_DWORD_LITTLE_ENDIAN.
Const REG_DWORD_BIG_ENDIAN = 5
'A 32-bit integer stored in big-endian format. This is the opposite of the way Intel-based computers normally store numbers -- the byte order is reversed.
Const REG_DWORD_LITTLE_ENDIAN = 4
'A 32-bit integer stored in little-endian format. This is the way Intel-based computers store numbers.
Const REG_EXPAND_SZ = 2
'A null-terminated string which contains unexpanded environment variables.
Const REG_LINK = 6
'A Unicode symbolic link.
Const REG_MULTI_SZ = 7
'A series of strings, each separated by a null character and the entire set terminated by a two null characters.
Const REG_NONE = 0
'No data type.
Const REG_RESOURCE_LIST = 8
'A list of resources in the resource map.
Const REG_SZ = 1
'A string terminated by a null character.

Answer 5

Dim mlngHRegKey As Long
Dim mBkey As BaseRegKey, mstrMainKey As String
Dim mblnOpenNow As Boolean'*****************************************************
'目的:                  在注册表中创建指定的主键，并打开他，使函数可以访问此主键。
'假设:
'   mblnOpenNow:        判断是否有主键打开
'   mlngHRegKey:        一个打开的主键的句柄
'   mBkey:              要打开的主键的根键名称
'   mstrMainKey:        要打开的主键的具体名称
'效果:
'   mblnOpenNow:        主键打开后，表示为true
'输入：
'   BKey:               要打开的主键的根键名称
'   Mainkey:            要打开的主键的具体名称
'返回：                 打开成功为true,失败为false
'*****************************************************Public Function KeyCreate(BKey As BaseRegKey, Mainkey As String) As Boolean
    On Error GoTo ErrorLine
    Dim TempHregkey As Long
    Dim secattr As SECURITY_ATTRIBUTES
    Dim neworused As Long
    Dim stringbuffer As String
    Dim retval As Long
    
    If mblnOpenNow Then
        retval = RegCloseKey(mlngHRegKey)
    End If
    secattr.nLength = Len(secattr)
    secattr.lpSecurityDescriptor = 0
    secattr.bInheritHandle = True
    
    retval = RegCreateKeyEx(BKey, Mainkey, 0, "", 0, KEY_ALL_ACCESS, secattr, TempHregkey, neworused)
    If retval = 0 Then
        mblnOpenNow = True: mlngHRegKey = TempHregkey: KeyCreate = True
        mBkey = BKey: mstrMainKey = Mainkey
    Else
        KeyCreate = False: Exit Function
    End If
    Exit Function
ErrorLine:
    MsgBox "clsRegistry[KeyCreate]:" & Err.Number & ";" & Err.Source & ";" & Err.Description
End Function'*****************************************************
'目的:                  关闭打开的主键
'假设:
'   mblnOpenNow:        判断是否有主键打开
'   mlngHRegKey:        一个打开的主键的句柄
'效果:
'   mblnOpenNow:        若有打开的主键关闭他，并把值设为false
'   mlngHRegKey:        一个打开的主键的句柄
'*****************************************************
Public Sub KeyClose()
    On Error GoTo ErrorLine
    Dim retval As Long
    If mblnOpenNow Then
        retval = RegCloseKey(mlngHRegKey)
        mblnOpenNow = False
    End If
    Exit Sub
ErrorLine:
    MsgBox "clsRegistry[KeyClose]:" & Err.Number & ";" & Err.Source & ";" & Err.Description
End Sub'*****************************************************
'目的:                  读取已打开的主键的某键值的数据
'假设:
'   mblnOpenNow:        判断是否有主键打开
'   mlngHRegKey:        一个打开的主键的句柄
'输入：
'   strProName:         要读取的某键值的名称
'返回：                 已打开的主键的某键值的数据
'                       错误时返回空值
'*****************************************************
Public Function ReadPro(strProName As String) As String
    On Error GoTo ErrorLine
    If Not mblnOpenNow Then
        ReadPro = ""
        Exit Function
    End If
    Dim stringbuffer As String
    Dim slength As Long
    Dim retval As Long
    stringbuffer = Space(255)
    slength = 255
    retval = RegQueryValueEx(mlngHRegKey, strProName, 0, REG_SZ, ByVal stringbuffer, slength)
    If retval = 0 Then
        ReadPro = ZStr(stringbuffer)
    Else
        ReadPro = ""
    End If
    Exit Function
ErrorLine:
    MsgBox "clsRegistry[ReadPro]:" & Err.Number & ";" & Err.Source & ";" & Err.Description
End Function'*****************************************************
'目的:                  写入数据到已打开的主键的某键值中去
'假设:
'   mblnOpenNow:        判断是否有主键打开
'   mlngHRegKey:        一个打开的主键的句柄
'输入：
'   strProName:         要写入的某键值的名称
'   strData:            要写入的数据（字符型）
'返回：                 写入成功返回 True
'                       写入失败返回 False
'*****************************************************
Public Function SavePro(strProName As String, strData As String) As Boolean
    On Error GoTo ErrorLine
    If Not mblnOpenNow Then
        SavePro = False
        Exit Function
    End If
    Dim stringbuffer As String
    Dim slength As Long
    Dim retval As Long
    stringbuffer = strData
    slength = LenB(StrConv(stringbuffer, vbFromUnicode)) + 1
    retval = RegSetValueEx(mlngHRegKey, strProName, 0, REG_SZ, ByVal stringbuffer, slength)
    If retval = 0 Then
        SavePro = True
    Else
        SavePro = False
    End If
    Exit Function
ErrorLine:
    MsgBox "clsRegistry[SavePro]:" & Err.Number & ";" & Err.Source & ";" & Err.Description
End Function'*****************************************************
'目的:                  删除已打开的主键的某键值
'假设:
'   mblnOpenNow:        判断是否有主键打开
'   mlngHRegKey:        一个打开的主键的句柄
'输入：
'   strProName:         要删除的某键值的名称
'返回：                 删除成功返回 True
'                       删除失败返回 False
'*****************************************************
Public Function DeletePro(strProName As String) As Boolean
    On Error GoTo ErrorLine
    If Not mblnOpenNow Then
        DeletePro = False
        Exit Function
    End If
    Dim retval As Long
    retval = RegDeleteValue(mlngHRegKey, strProName)
    If retval = 0 Then
        DeletePro = True
    Else
        DeletePro = False
    End If
    Exit Function
ErrorLine:
    MsgBox "clsRegistry[DeletePro]:" & Err.Number & ";" & Err.Source & ";" & Err.Description
End Function
'*****************************************************
'目的:                  初始化类　clsRegistry
'假设:
'   mblnOpenNow:        判断是否有主键打开
'效果:
'   mblnOpenNow:        为 false
'*****************************************************
Private Sub Class_Initialize()
    On Error GoTo ErrorLine
    mblnOpenNow = False
    Exit Sub
ErrorLine:
    MsgBox "clsRegistry[Class_Initialize]:" & Err.Number & ";" & Err.Source & ";" & Err.Description
End Sub'*****************************************************
'目的:                  去掉字符串后面的chr(0)字符
'*****************************************************
Private Function ZStr(strT$)
    Dim i%
    ZStr = strT
    i = InStr(strT, Chr(0)) - 1
    If i > 0 Then
        ZStr = Left(strT, i)
    End If
End Function

Answer 6

如何打开,如下的键
HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services\W3SVC\Parameters\Virtual Roots。下面的值是多条，如果您的机器上有WEB站点，所有站点都在该键下，每个站点一条记录，大侠帮帮忙怎么读。