Attribute VB_Name = "Regedit"
'VB提供了四個訪問Windows注冊表的函數(shù)，但是只能訪問
'“HKEY_CURRENT_USER\Software\VB and VBA Program Settings”下,
'不能任意的訪問，也不能存取除字符串以外類型的字段，幸好VB能通
'過于Windows API來訪問注冊表，于是筆者根據(jù)API函數(shù)編
'寫這個訪問注冊表的模塊，希望能對你有幫助。
'函數(shù)聲明
Public Declare Function RegOpenKey Lib "advapi32.dll" _
Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey _
As String, phkResult As Long) As Long

Public Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey 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 RegQueryValue Lib "advapi32.dll" _
Alias "RegQueryValueA" (ByVal hKey As Long, ByVal lpSubKey _
As String, ByVal lpValue As String, lpcbValue 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 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 Any, _
lpcbData As Long) As Long
'注意：原來的API瀏覽器中l(wèi)pData原來的類型是Byte ，由于這個類型只支持
'Byte類型，所以改為Any類型才可正常讀出數(shù)據(jù)

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

Public Declare Function RegSetValue Lib "advapi32.dll" _
Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey _
As String, ByVal dwType As Long, ByVal lpData As String, _
ByVal cbData 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 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 RegDeleteKey Lib "advapi32.dll" _
Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey _
As String) 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 Enum OpTypeString
  oString = 1 '字符串
  oExpandSZ = 2 '展開式字符串
  oLongData = 7 '多重字符串
End Enum

Public Enum OpTypeNumber
  oLong = 4 '長整型
  oBinary = 3 'Binary數(shù)據(jù)
  oBigEndian = 5 'Big Endian長整數(shù)
End Enum

Public Enum OHKEY
 HKEY_CLASSES_ROOT = &H80000000
 HKEY_CURRENT_CONFIG = &H80000005
 HKEY_CURRENT_USER = &H80000001
 HKEY_DYN_DATA = &H80000006
 HKEY_LOCAL_MACHINE = &H80000002
 HKEY_USERS = &H80000003
End Enum



Public Function RegSaveStringValue(mhKey As OHKEY, lpSubKey As String, hKeyName As String, hValueType As OpTypeString, hKeyValue As String) As Boolean
'寫入字符串型數(shù)據(jù)
'mhKey是指主鍵的名稱，lpSubKey是指路徑，hKeyName是指鍵名，hValueType是指鍵值的數(shù)據(jù)類型，hKeyValue是指數(shù)據(jù)
Dim hKey As Long, ret As Long, retk As Long, cbData As Long '聲明變量
hKeyValue = hKeyValue + Chr(0)
RegSaveStringValue = False
cbData = LenB(StrConv(hKeyValue, vbFromUnicode)) '讀取字符串的實際長度
ret = RegCreateKey(mhKey, lpSubKey, hKey) '如果人打開這個主鍵，沒有則創(chuàng)建該主鍵
If ret = 0 Then
  If RegSetValueEx(hKey, hKeyName, 0, hValueType, ByVal hKeyValue, cbData) = 0 Then
   RegSaveStringValue = True '成功則返回真值
  End If
End If
RegCloseKey hKey '刪除打開的鍵值，釋放內(nèi)存

End Function

Public Function RegSaveNumberValue(mhKey As OHKEY, lpSubKey As String, hKeyName As String, hValueType As OpTypeNumber, hKeyValue As Long) As Boolean
'寫入數(shù)字型數(shù)據(jù)
'mhKey是指主鍵的名稱，lpSubKey是指路徑，hKeyName是指鍵名，hValueType是指鍵值的數(shù)據(jù)類型，hKeyValue是指數(shù)據(jù)
Dim hKey As Long, ret As Long, retk As Long, cbData As Long
cbData = 4 'Len(CStr(hKeyValue))
RegSaveNumberValue = False
ret = RegCreateKey(mhKey, lpSubKey, hKey)
If ret = 0 Then
  If RegSetValueEx(hKey, hKeyName, 0, hValueType, hKeyValue, cbData) = 0 Then
   RegSaveNumberValue = True
  End If
End If
RegCloseKey hKey '刪除打開的鍵值，釋放內(nèi)存

End Function

Public Function RegReadValue(mhKey As OHKEY, lpSubKey As String, hKeyName As String, hValueType As Long, hKeyValue As String) As Boolean
'讀取數(shù)據(jù)
'mhKey是指主鍵的名稱，lpSubKey是指路徑，hKeyName是指鍵名，hValueType是指鍵值的數(shù)據(jù)類型，hKeyValue是指數(shù)據(jù)
Dim hKey As Long, ret As Long, lenData As Long
ret = RegOpenKey(mhKey, lpSubKey, hKey)
If ret = 0 Then
 RegReadValue = True
 '讀取數(shù)據(jù)類型
 ret = RegQueryValueEx(hKey, hKeyName, 0, hValueType, ByVal vbNullString, lenData)
  Select Case hValueType
   Case OpTypeString.oExpandSZ, OpTypeString.oLongData, OpTypeString.oString
    '如果是字符型
    Dim s As String, s2 As String
    s = String(lenData, Chr(0))
    RegQueryValueEx hKey, hKeyName, 0, hValueType, ByVal s, lenData
    Select Case hValueType
     Case OpTypeString.oString '如果是字符串
       hKeyValue = Left(s, InStr(s, Chr(0)) - 1)
     Case OpTypeString.oExpandSZ '如果是展開式字符串
      s2 = String(Len(s) + 256, Chr(0))
      ExpandEnvironmentStrings s, s2, Len(s2)
      hKeyValue = Left(s2, InStr(s2, Chr(0)) - 1)
     Case OpTypeString.oLongData '如果是多重字符串
      hKeyValue = Left(s, Len(s) - 1)
    End Select
   Case OpTypeNumber.oBigEndian, OpTypeNumber.oLong
    '如果是長整型
    Dim l As Long
    RegQueryValueEx hKey, hKeyName, 0, hValueType, l, lenData
    hKeyValue = CStr(l)
   Case OpTypeNumber.oBinary
    '如果是二進制型
    ReDim bArr(0 To lenData - 1) As Byte
        RegQueryValueEx hKey, hKeyName, 0, hValueType, bArr(0), lenData
        For i = 1 To lenData - 1
         hKeyValue = hKeyValue + Hex(bArr(i))
        Next i
  End Select
   
Else
  RegReadValue = False
End If
RegCloseKey hKey '刪除打開的鍵值，釋放內(nèi)存

End Function

Public Function RegDeleteSubkey(hKey As OHKEY, SubKey As String)
'刪除目錄
'mhKey是指主鍵的名稱，SubKey是指路徑
    Dim ret As Long, Index As Long, hName As String
    Dim hSubkey As Long
    
    ret = RegOpenKey(hKey, SubKey, hSubkey)
    If ret <> 0 Then
        DeleteSubkeyTree = False
        Exit Function
    End If
    ret = RegDeleteKey(hSubkey, "")
    If ret <> 0 Then '如果刪除失敗則認為是NT則用遞歸方法刪除目錄
        Name = String(256, Chr(0))
        While RegEnumKey(hSubkey, 0, hName, Len(hName)) = 0 And _
              DeleteSubkeyTree(hSubkey, hName)
        Wend
        ret = RegDeleteKey(hSubkey, "")
    End If
    DeleteSubkeyTree = (ret = 0)
    RegCloseKey hSubkey '刪除打開的鍵值，釋放內(nèi)存
End Function

Public Function RegDeleteKeyName(mhKey As OHKEY, SubKey As String, hKeyName As String) As Boolean
'刪除子鍵數(shù)據(jù)
'mhKey是指主鍵的名稱，SubKey是指路徑，hKeyName是指鍵名
Dim hKey As Long, ret As Long
ret = RegOpenKey(mhKey, SubKey, hKey)
RegDeleteKeyName = False
If ret = 0 Then
  If RegDeleteValue(hKey, hKeyName) = 0 Then RegDeleteKeyName = True
End If
RegCloseKey hKey '刪除打開的鍵值，釋放內(nèi)存
End Function

Public Function RegCountSubKey(mhKey As OHKEY, SubKey As String) As Long
'統(tǒng)計所有子鍵數(shù)目
'mhKey是指主鍵的名稱，SubKey是指路徑
Dim hKey As Long, ret As Long, idx As Long, lenName As Long, lpValeName As String, TypeData As Long, lenData As Long
idx = 0
ret = RegOpenKey(mhKey, SubKey, hKey)
If ret = 0 Then
 While RegEnumValue(hKey, idx, lpValeName, lenName, ByVal 0, TypeData, ByVal vbNullString, lenData) = 0
   idx = idx + 1
 Wend
End If
RegCountSubKey = idx
RegCloseKey hKey '刪除打開的鍵值，釋放內(nèi)存
End Function

Public Function RegEnumSubKey(mhKey As OHKEY, SubKey As String, hKeyIndex As Long, hKeyName As String, hKeyType As Long, hKeyValue As String) As Boolean
'讀取指定的子鍵鍵值
'mhKey是指主鍵的名稱，SubKey是指路徑，hKeyIndex是指定要返回第幾個鍵名，hKeyName是指鍵名，hValueType是指鍵值的數(shù)據(jù)類型，hKeyValue是指數(shù)據(jù)

Dim hKey As Long, ret As Long, lenName As Long, lpValeName As String, TypeData As Long, lenData As Long
Dim s As String
s = String(lenData, Chr(0))
lenName = 256
lpValeName = String(256, Chr(0))
RegEnumSubKey = False
ret = RegOpenKey(mhKey, SubKey, hKey)
If ret = 0 Then
 If RegEnumValue(hKey, ByVal hKeyIndex, lpValeName, lenName, ByVal 0, TypeData, ByVal vbNullString, lenData) = 0 Then
  hKeyName = Left(lpValeName, InStr(lpValeName, Chr(0)) - 1) ' Left(s, InStr(s, Chr(0)) - 1)
  If RegReadValue(mhKey, SubKey, hKeyName, hKeyType, hKeyValue) Then
   RegEnumSubKey = True
  End If
 
 End If
End If
RegCloseKey hKey '刪除打開的鍵值，釋放內(nèi)存

End Function