API——注册表读取

'打开一个现有的项。在win32下推荐使用这个函数
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
'获取一个项的设置值
Public 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 Long, lpcbData As Long) As Long        ' Note that if you declare the lpData parameter as String, you must pass it By Value.

Const HKEY_CLASSES_ROOT       As Long = &H80000000
Const HKEY_CURRENT_USER       As Long = &H80000001
Const HKEY_LOCAL_MACHINE      As Long = &H80000002
Const HKEY_USERS              As Long = &H80000003
Const HKEY_PERFORMANCE_DATA   As Long = &H80000004
Const HKEY_CURRENT_CONFIG     As Long = &H80000005
Const HKEY_DYN_DATA           As Long = &H80000006

Const KEY_READ As Long = &H20019
Const KEY_WRITE As Long = &H20006

Function GetObjectDllPath(ObjectName As String) As String
    Dim ret As Long
    Dim hKey As Long
    
    '打开注册表的某一项
    ret = RegOpenKeyEx(HKEY_CLASSES_ROOT, ObjectName & "\CLSID", 0, KEY_READ, hKey)
    If ret <> 0 Then
        GetObjectDllPath = "RegOpenKeyEx errno=" & ret
        Exit Function
    End If
    
    GetObjectDllPath = ReadData(hKey, "")
    '关闭注册表的某一项
    RegCloseKey hKey
    
    ret = RegOpenKeyEx(HKEY_CLASSES_ROOT, "CLSID\" + GetObjectDllPath + "\InprocServer32", 0, KEY_READ, hKey)
    If ret <> 0 Then
        GetObjectDllPath = "RegOpenKeyEx errno=" & ret
        Exit Function
    End If
    
    GetObjectDllPath = ReadData(hKey, "")
    RegCloseKey hKey
End Function

Function ReadData(hKey As Long, valueName As String) As String
    Dim lpType As Long
    Dim lpcbData As Long
    lpcbData = 512
    Dim lpData() As Byte
    ReDim lpData(lpcbData - 1) As Byte
    
    Dim ret As Long
    '读取注册表某一项的值
    ret = RegQueryValueEx(hKey, valueName, 0, lpType, VarPtr(lpData(0)), lpcbData)
    If ret <> 0 Then
        ReadData = "RegQueryValueEx errno=" & ret
        Exit Function
    End If
    '最后有个0
    ReDim Preserve lpData(lpcbData - 1 - 1) As Byte
    
    ReadData = VBA.StrConv(lpData, vbUnicode)
End Function