getregistrysetting.bas

来自「常用基本函数库,也许你需要的正在其中！如果不做程序」· BAS 代码 · 共 57 行

Attribute VB_Name = "modGetRegistrySetting"
Option Explicit

'Registry Read permissions:
Private Const KEY_QUERY_VALUE = &H1&
Private Const KEY_ENUMERATE_SUB_KEYS = &H8&
Private Const KEY_NOTIFY = &H10&
Private Const READ_CONTROL = &H20000
Private Const STANDARD_RIGHTS_READ = READ_CONTROL
Private Const Key_Read = STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY

Private Const REG_DWORD = 4&    ' 32-bit number

Private Declare Function RegCloseKey& Lib "advapi32.dll" (ByVal HKey&)
Private Declare Function RegOpenKeyExA& Lib "advapi32.dll" (ByVal HKey&, ByVal lpszSubKey$, dwOptions&, ByVal samDesired&, lpHKey&)
Private Declare Function RegQueryValueExA& Lib "advapi32.dll" (ByVal HKey&, ByVal lpszValueName$, lpdwRes&, lpdwType&, ByVal lpDataBuff$, nSize&)
Function GetRegistrySetting(lMainKey As Long, tSubKey As String, tValue As String) As String
    
    'lMainKey must be one of the Publicly declared HKEY constants
    '
    'Example call: GetRegistrySetting(HKEY_CURRENT_USER, "Control Panel\Desktop", "ScreenSaveUsePassword")
    '
    Dim lKeyType As Long            'returns the key type.  This function expects REG_SZ
    Dim lRetVal As Long             'returned by registry functions, should be 0&
    Dim lpHKey As Long              'return handle to opened key
    Dim lpcbData As Long            'length of data in returned string
    Dim tReturnedString As String   'returned string value
    Dim fTempDbl As Double
    
    'Open key
    lRetVal = RegOpenKeyExA(lMainKey, tSubKey, 0&, Key_Read, lpHKey)
    If lRetVal <> 0 Then
        GetRegistrySetting = ""
        Exit Function     'No key open, so leave
    End If
    
    'Set up a buffer for the data to be returned in
    lpcbData = 255
    tReturnedString = Space$(lpcbData)
    
    'Get the key
    lRetVal = RegQueryValueExA(lpHKey, tValue, ByVal 0&, lKeyType, tReturnedString, lpcbData)
    If lRetVal <> 0 Then
        GetRegistrySetting = ""   'Key still open, so finish up
    Else
        If lKeyType = REG_DWORD Then
            fTempDbl = Asc(Mid(tReturnedString, 1, 1)) + &H100& * Asc(Mid(tReturnedString, 2, 1)) + &H10000 * Asc(Mid(tReturnedString, 3, 1)) + &H1000000 * CDbl(Asc(Mid(tReturnedString, 4, 1)))
            tReturnedString = Format(fTempDbl, "000")
        End If
        GetRegistrySetting = Left(tReturnedString, lpcbData - 1)
    End If
    
    'Always close opened keys!
    lRetVal = RegCloseKey(lpHKey)
    
End Function