使用Visual Basic 6.0开发程序的一些方法技巧收集之一：注册表操作

    前一段时间在负责开发公司产品的安装升级项目过程中，采用了Visual Basic 6.0开发了几个安装升级管理的辅助程序，其中使用了一些方法，这其中有些方法或技巧由网友提供，并经过本人作了修改，现采用分类的方式，依次将这些用到的方法或技巧贴出来，跟各位分享一下。

    这篇文章讲述一些关于Visual Basic 6.0 操作注册表的方法或技巧。在Windows环境下，对注册表操作是较常的事情，通常都是利用API来处理。
1、声明API，如下所示：

' 注册表操作API声明

Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult 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, lpData As Any, ByVal cbData As Long) As Long

Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

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

Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long

Private Declare Function RegFlushKey Lib "advapi32.dll" (ByVal hKey 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, ByVal lpData As String, lpcbData As Long) As Long

2、声明常量：
Private Const REG_SZ = 1
Private Const HKEY_LOCAL_MACHINE = &H80000002

3、注册表操作方法：
（1）读注册表指定项的键值
' **********************************************************************
' 函数名称：ReadRegistry
' 功能描述：根据键读取注册表中对应的键值
' 输    入：ByVal Section(String)：注册表项，ByVal Key(String)：键
' 返    回：strValue(String)：键值
' **********************************************************************
Public Function ReadRegistry(ByVal Section As String, ByVal Key As String) As String
    Dim lngResult As Long
    Dim lngKeyValue As Long
    Dim lngValueLength As Long
    Dim strValue As String
   
    On Error Resume Next
   
    lngResult = RegOpenKey(HKEY_LOCAL_MACHINE, Section, lngKeyValue)

    strValue = Space$(2048)
    lngValueLength = Len(strValue)
    lngResult = RegQueryValueEx(lngKeyValue, Key, 0&, REG_SZ, strValue, lngValueLength)
   
    If (lngResult = 0) And (Err.Number = 0) Then
        strValue = Left$(strValue, lngValueLength - 1)
    Else
        strValue = ""
    End If
   
    lngResult = RegCloseKey(lngKeyValue)
    ReadRegistry = strValue
   
End Function

（2）写注册表
' **********************************************************************
' 函数名称：WriteRegistry
' 功能描述：写入注册表
' 输    入：ByVal Section(String)：注册表项，ByVal Key(String)：键，ByVal Value(String)：键值
' 返    回：无
' **********************************************************************
Public Sub WriteRegistry(ByVal Section As String, ByVal Key As String, ByVal Value As String)
    Dim lngResult As Long
    Dim lngKeyValue As Long
   
    On Error Resume Next
   
    lngResult = RegCreateKey(HKEY_LOCAL_MACHINE, Section, lngKeyValue)
    lngResult = RegSetValueExString(lngKeyValue, Key, 0&, REG_SZ, ByVal Value, Len(Value))
   
    lngResult = RegFlushKey(lngKeyValue)
    lngResult = RegCloseKey(lngKeyValue)
   
End Sub

（3）删除注册表指定键
' **********************************************************************
' 函数名称：DeleteValue
' 功能描述：删除注册表键
' 输    入：ByVal Section(String)：注册表项，ByVal Key(String)：键
' 返    回：无
' **********************************************************************
Public Sub DeleteValue(ByVal Section As String, ByVal Key As String)
    Dim lResult As Long
    Dim lKeyValue As Long
   
    On Error Resume Next
   
    lResult = RegOpenKey(HKEY_LOCAL_MACHINE, Section, lKeyValue)
    lResult = RegDeleteValue(lKeyValue, Key)
    lResult = RegCloseKey(lKeyValue)
   
End Sub

 

 

    以下部分是本人从网络上收集过来的关于注册表操作的各类方法，相对较全面，相信对各位有需要的朋友会有较大的帮助。
Option Explicit

Const HKEY_LOCAL_MACHINE = &H80000002

Const ERROR_NO_MORE_ITEMS = 259&
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_SZ = 1

Const STANDARD_RIGHTS_ALL = &H1F0000
Const KEY_CREATE_LINK = &H20
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const SYNCHRONIZE = &H100000
Const READ_CONTROL = &H20000
Const REG_OPTION_NON_VOLATILE = 0
Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Const KEY_READ = ((STANDARD_RIGHTS_READ 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 KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))

Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Long, ByVal cbData As Long) As Long
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 lpData As String, ByVal cbData As Long) As Long
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 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
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
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey 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 String, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long
Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
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
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

 

Public Function RegDelKeyVb(sSubKey As String, Optional hKey As Long = HKEY_LOCAL_MACHINE) As Boolean
Dim nRev As Long

    nRev = RegDeleteKey(hKey, sSubKey)
   
    If (0 = nRev) Then
        RegDelKeyVb = True
    Else
        RegDelKeyVb = False
    End If
End Function

Public Function RegDelValVb(sKey As String, sValName As String) As Boolean
    Dim nRev As Long, hKey As Long

    hKey = RegOpenVb(sKey)
    If (0 <> hKey) Then
        nRev = RegDeleteValue(hKey, sValName)
       
        If (0 = nRev) Then
            RegDelValVb = True
        Else
            RegDelValVb = False
        End If
    Else
        RegDelValVb = False
    End If
End Function

Public Function RegCreateVb(sSubKey As String, Optional hKey As Long = HKEY_LOCAL_MACHINE) As Boolean
Dim nRev As Long, nKey As Long

    nRev = RegCreateKeyEx(hKey, sSubKey, 0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, nKey, 0&)

    If (0 = nRev) Then
        RegCloseVb nKey
        RegCreateVb = True
    Else
        RegCreateVb = False
    End If
End Function

Public Function RegOpenVb(sName As String, Optional hKey As Long = HKEY_LOCAL_MACHINE) As Long
Dim nRev As Long, nKey As Long

    nRev = RegOpenKeyEx(hKey, sName, 0, KEY_ALL_ACCESS, nKey)
    If (0 = nRev) Then
        RegOpenVb = nKey
    Else
        RegOpenVb = 0
    End If
End Function

 

Function ReadLongReg(sSubKey As String, sName As String) As Long
    Dim nRevKey As Long, nRevVal As Long
   
    nRevKey = RegOpenVb(sSubKey)
    nRevVal = RegReadLongVb(nRevKey, sName)
    RegCloseVb nRevKey
    ReadLongReg = nRevVal
End Function

Sub WriteLongReg(sSubKey As String, sName As String, lRev As Long)
    Dim nRevKey As Long
   
    RegCreateVb sSubKey
    nRevKey = RegOpenVb(sSubKey)
    RegSetLongVb nRevKey, sName, lRev
    RegCloseVb nRevKey
End Sub

Function ReadStrReg(sSubKey As String, sName As String) As String
    Dim nRevKey As Long, sRev As String
    nRevKey = RegOpenVb(sSubKey)
    sRev = RegReadStrVb(nRevKey, sName)
    RegCloseVb nRevKey
    ReadStrReg = sRev
End Function

Sub WriteStrReg(sSubKey As String, sName As String, sValue As String)
    Dim nRevKey As Long
   
    RegCreateVb sSubKey
    nRevKey = RegOpenVb(sSubKey)
    RegSetStrVb nRevKey, sName, sValue
    RegCloseVb nRevKey
End Sub

Function RegReadLongVb(hKey As Long, sName As String) As Long
Dim nRev As Long, nValue As Long

    nRev = RegQueryValueExLong(hKey, sName, 0, REG_DWORD, nValue, 4)
    If (0 = nRev) Then
        RegReadLongVb = nValue
    Else
        RegReadLongVb = 0
    End If
End Function

Function RegCloseVb(hKey As Long) As Boolean
Dim nRev As Long

    nRev = RegCloseKey(hKey)
   
    If (0 = nRev) Then
        RegCloseVb = True
    Else
        RegCloseVb = False
    End If
End Function

Function RegSetLongVb(hKey As Long, sName As String, nValue As Long) As Boolean
Dim nRev As Long, nLen As Long

    nLen = 4
    nRev = RegSetValueExLong(hKey, sName, 0, REG_DWORD, nValue, nLen)
    If (0 = nRev) Then
        RegSetLongVb = False
    Else
        RegSetLongVb = True
    End If
End Function

Function RegSetStrVb(hKey As Long, sName As String, sValue As String) As Boolean
Dim nRev As Long, nLen As Long
Dim strEnd As String, sRev As String

    sRev = sValue + vbNullChar
    nLen = Len(sRev)
    nRev = RegSetValueExString(hKey, sName, 0, REG_SZ, sRev, nLen)
    If (0 = nRev) Then
        RegSetStrVb = False
    Else
        RegSetStrVb = True
    End If
End Function

Function RegReadStrVb(hKey As Long, sName As String) As String
Dim nRev As Long
Dim sRev As String * 255

    sRev = String(255, Chr(0))
    nRev = RegQueryValueExString(hKey, sName, 0, REG_SZ, sRev, 255)
    If (0 = nRev) Then
        RegReadStrVb = Mid(sRev, 1, InStr(1, sRev, Chr(0)) - 1)
    Else
        RegReadStrVb = ""
    End If
End Function

Private Sub WanEnumReg(sKey As String, nIndex As Long, ByVal nFile As Integer)
On Error GoTo errlst
    Dim nLen As Long, nRev As Long, nKey As Long
    Dim sChildKey As String, sRev As String

    nRev = RegOpenKeyEx(HKEY_LOCAL_MACHINE, sKey, 0, KEY_READ, nKey)
    If (0 = nRev) Then
       
        Print #nFile, "[HKEY_LOCAL_MACHINE/" + sKey + "]"
        WanEnumVal nKey, nFile
        Print #nFile, ""
       
        Do While ERROR_NO_MORE_ITEMS <> nRev
            nLen = 255: sRev = String(nLen, Chr(0))
            nRev = RegEnumKey(nKey, nIndex, sRev, nLen)
            If (0 = nRev) Then
                sChildKey = sKey + "/" + Mid(sRev, 1, InStr(1, sRev, Chr(0)) - 1)
                WanEnumReg sChildKey, 0, nFile
                nIndex = nIndex + 1
            End If
        Loop
        RegCloseKey nKey
    End If
    Exit Sub
errlst:
    Err.Clear
End Sub

Private Sub WanEnumVal(nKey As Long, ByVal nFile As Integer)
On Error GoTo errlst
    Dim nLen As Long, nRev As Long, sRev As String, nIndex As Long, nType As Long
    Dim lpByte(1 To 255) As Byte, nDataLen As Long, sVal As String, nVal As Long
   
    nRev = 0
    nIndex = 0
    Do While ERROR_NO_MORE_ITEMS <> nRev
        nLen = 255: sRev = String(nLen, Chr(0)): nDataLen = 255
        nRev = RegEnumValue(nKey, nIndex, sRev, nLen, 0, nType, lpByte(1), nDataLen)
        If (0 = nRev) Then
            sRev = Mid(sRev, 1, InStr(1, sRev, Chr(0)) - 1)
            If ("" <> sRev) Then
                If (REG_BINARY = nType Or REG_DWORD = nType) Then
                    sRev = """" + sRev + """=dword:" + FormatDword(RegReadLongVb(nKey, sRev))
                ElseIf (REG_SZ = nType) Then
                    sRev = """" + sRev + """=""" + ReplaceStrC(RegReadStrVb(nKey, sRev)) + """"
                End If
               
                Print #nFile, sRev
           
            End If
            nIndex = nIndex + 1
        End If
    Loop
    Exit Sub
errlst:
    Err.Clear
End Sub

Private Function ReplaceStrC(sIn As String) As String
On Error GoTo errlst
    Dim sRev As String, sLeft As String, sRight As String
    Dim nPos As Integer
   
    sRev = sIn: nPos = InStr(1, sRev, "/")
    Do While nPos > 0
        sLeft = Left(sRev, nPos): sRight = Mid(sRev, nPos + 1)
        sRev = sLeft + "/" + sRight
        nPos = nPos + 2
        nPos = InStr(nPos, sRev, "/")
    Loop
    ReplaceStrC = sRev
    Exit Function
errlst:
    ReplaceStrC = ""
    Err.Clear
End Function

Private Function FormatDword(nVal As Long) As String
On Error GoTo errlst
    Dim sRev As String, nLen As Integer
   
    sRev = Hex(nVal)
    nLen = Len(sRev)
    If (nLen < 8) Then
        sRev = String(8 - nLen, "0") + sRev
    End If
    FormatDword = sRev
    Exit Function
errlst:
    FormatDword = ""
    Err.Clear
End Function