Læs fra Registreringsdatabase

Take a look at this link http://www.mvps.org/access/api/api0015.htm


Place this code in a module then use as follows.

a$ = fReturnRegKeyValue(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion", "ProductName")




'********Code Start**************
'This code was originally written by Terry Kreft
' and Dev Ashish.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Dev Ashish & Terry Kreft
'
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006

Private Const STANDARD_RIGHTS_READ = &H20000
Private Const KEY_QUERY_VALUE = &H1&
Private Const KEY_ENUMERATE_SUB_KEYS = &H8&
Private Const KEY_NOTIFY = &H10&
Private Const SYNCHRONIZE = &H100000
Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or _
                        KEY_QUERY_VALUE Or _
                        KEY_ENUMERATE_SUB_KEYS Or _
                        KEY_NOTIFY) And _
                        (Not SYNCHRONIZE))
Private Const MAXLEN = 256
Private Const ERROR_SUCCESS = &H0&

Const REG_NONE = 0
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_DWORD_LITTLE_ENDIAN = 4
Const REG_DWORD_BIG_ENDIAN = 5
Const REG_LINK = 6
Const REG_MULTI_SZ = 7
Const REG_RESOURCE_LIST = 8

Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Declare Function apiRegOpenKeyEx Lib "advapi32.dll" _
        Alias "RegOpenKeyExA" (ByVal hKey As Long, _
        ByVal lpSubKey As String, ByVal ulOptions As Long, _
        ByVal samDesired As Long, ByRef phkResult As Long) _
        As Long

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

Private Declare Function apiRegQueryValueEx Lib "advapi32.dll" _
        Alias "RegQueryValueExA" (ByVal hKey As Long, _
        ByVal lpValueName As String, ByVal lpReserved As Long, _
        ByRef lpType As Long, lpData As Any, _
        ByRef lpcbData As Long) As Long

Private Declare Function apiRegQueryInfoKey Lib "advapi32.dll" _
        Alias "RegQueryInfoKeyA" (ByVal hKey As Long, _
        ByVal lpClass As String, ByRef lpcbClass As Long, _
        ByVal lpReserved As Long, ByRef lpcSubKeys As Long, _
        ByRef lpcbMaxSubKeyLen As Long, _
        ByRef lpcbMaxClassLen As Long, _
        ByRef lpcValues As Long, _
        ByRef lpcbMaxValueNameLen As Long, _
        ByRef lpcbMaxValueLen As Long, _
        ByRef lpcbSecurityDescriptor As Long, _
        ByRef lpftLastWriteTime As FILETIME) As Long

Function fReturnRegKeyValue(ByVal lngKeyToGet As Long, _
                            ByVal strKeyName As String, _
                            ByVal strValueName As String) _
                            As String
Dim lnghKey As Long
Dim strClassName As String
Dim lngClassLen As Long
Dim lngReserved As Long
Dim lngSubKeys As Long
Dim lngMaxSubKeyLen As Long
Dim lngMaxClassLen As Long
Dim lngValues As Long
Dim lngMaxValueNameLen As Long
Dim lngMaxValueLen As Long
Dim lngSecurity As Long
Dim ftLastWrite As FILETIME
Dim lngType As Long
Dim lngData As Long
Dim lngTmp As Long
Dim strRet As String
Dim varRet As Variant
Dim lngRet As Long
   
    On Error GoTo fReturnRegKeyValue_Err
       
    'Open the key first
    lngTmp = apiRegOpenKeyEx(lngKeyToGet, _
                strKeyName, 0&, KEY_READ, lnghKey)

    'Are we ok?
    If Not (lngTmp = ERROR_SUCCESS) Then Err.Raise _
                                lngTmp + vbObjectError

    lngReserved = 0&
    strClassName = String$(MAXLEN, 0):  lngClassLen = MAXLEN

    'Get boundary values
    lngTmp = apiRegQueryInfoKey(lnghKey, strClassName, _
        lngClassLen, lngReserved, lngSubKeys, lngMaxSubKeyLen, _
        lngMaxClassLen, lngValues, lngMaxValueNameLen, _
        lngMaxValueLen, lngSecurity, ftLastWrite)

    'How we doin?
    If Not (lngTmp = ERROR_SUCCESS) Then Err.Raise _
                                lngTmp + vbObjectError
   
    'Now grab the value for the key
    strRet = String$(MAXLEN - 1, 0)
    lngTmp = apiRegQueryValueEx(lnghKey, strValueName, _
                lngReserved, lngType, ByVal strRet, lngData)
    Select Case lngType
      Case REG_SZ
        lngTmp = apiRegQueryValueEx(lnghKey, strValueName, _
                lngReserved, lngType, ByVal strRet, lngData)
        varRet = Left(strRet, lngData - 1)
      Case REG_DWORD
        lngTmp = apiRegQueryValueEx(lnghKey, strValueName, _
                lngReserved, lngType, lngRet, lngData)
        varRet = lngRet
      Case REG_BINARY
        lngTmp = apiRegQueryValueEx(lnghKey, strValueName, _
                lngReserved, lngType, ByVal strRet, lngData)
        varRet = Left(strRet, lngData)
    End Select
   
    'All quiet on the western front?
    If Not (lngTmp = ERROR_SUCCESS) Then Err.Raise _
                                lngTmp + vbObjectError

fReturnRegKeyValue_Exit:
    fReturnRegKeyValue = varRet
    lngTmp = apiRegCloseKey(lnghKey)
    Exit Function
fReturnRegKeyValue_Err:
    varRet = "Error: Key or Value Not Found."
    Resume fReturnRegKeyValue_Exit
End Function

'********Code End**************

Prøv:

a$ = System.PrivateProfileString("", "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion", "ProductName")

GetSetting kan ikke bruges da den kun kan tilgå et begrænset del af registry.

Terrys løsning virker sikkert. Jeg ville dog korte koden en del ned.

Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_CONFIG = &H80000005
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_USERS = &H80000003

Private Const KEY_QUERY_VALUE = 1

Private 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
Private Declare Function RegCloseKey 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, ByRef lpType As Long, lpData As Any, ByRef lpcbData As Long) As Long

Private Function RegKeyGet(hKey As Long, sKeyPath As String, sValueName As String) As String
Dim hSubkey As Long
Dim lType As Long
Dim sData As String
Dim lDataLen As Long
If RegOpenKeyEx(hKey, sKeyPath, 0, KEY_QUERY_VALUE, hSubkey) = 0 Then
  If RegQueryValueEx(hSubkey, sValueName, 0, lType, ByVal 0, lDataLen) = 0 Then
      sData = String(lDataLen, Chr(0))
      Call RegQueryValueEx(hSubkey, sValueName, 0, lType, ByVal sData, lDataLen)
      RegKeyGet = sData
  Else
      RegKeyGet = "*"
  End If
  RegCloseKey hKey
Else
    RegKeyGet = "*"
End If
End Function

og så bruge RegKeyGet(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion", "ProductName")

System.PrivateProfileString kender jeg ikke.

System.PrivateProfileString henter den rigtige setting hos mig.
Jeg skrev "prøv" - men jeg havde naturligvis tjekket først ;-).

System.PrivateProfileString I think is used in Office apps. (Word, Outlook etc.)

>arne_v
Din løsning virker sådan set også; men man kan kun hente een nøgle af gangen. D.v.s. at man f.eks. ikke kan lave 2 linier for at hente to forskellige nøgler samtidig.

mvh
Johs_j

Den kan godt laves i en multi version:

' change sValueName to String() if you want to call it with such
Private Function RegKeyMultiGet(hKey As Long, sKeyPath As String, sValueName As Variant) As String()
Dim hSubkey As Long
Dim lType As Long
Dim sData As String
Dim lDataLen As Long
Dim i As Integer
If RegOpenKeyEx(hKey, sKeyPath, 0, KEY_QUERY_VALUE, hSubkey) = 0 Then
  Dim res() As String
  ReDim res(UBound(sValueName))
  For i = 0 To UBound(sValueName)
      If RegQueryValueEx(hSubkey, sValueName(i), 0, lType, ByVal 0, lDataLen) = 0 Then
        sData = String(lDataLen, Chr(0))
        Call RegQueryValueEx(hSubkey, sValueName(i), 0, lType, ByVal sData, lDataLen)
        res(i) = sData
      Else
        res(i) = "*"
      End If
  Next
  RegKeyMultiGet = res
  RegCloseKey hKey
Else
    RegKeyMultiGet = Array()
End If
End Function

Eksempel på kald:

Function TestRegKeyMultiGet()
  Dim val As Variant
  For Each val In RegKeyMultiGet(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion", Array("ProductName", "CSDVersion"))
      MsgBox val
  Next
End Function

"D.v.s. at man f.eks. ikke kan lave 2 linier for at hente to forskellige nøgler samtidig"

Where was that in your original question? Usding GetSetting wouldnt have been able to do that either!



Whats wrong with calling the function for each value you want, you still have to extract the values from an array before you can use them.

>terry
a$ = fReturnRegKeyValue(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion", "ProductName")

b$ = fReturnRegKeyValue(HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\ComputerName\ComputerName", "ComputerName")

Som jeg viser her laver jeg også 2 kald. Det virker i din løsnning, men ikke i arne_v's. Der kommer b$ ud som en tom streng.

>arne_v
Jeg kan ikke give point til en kommentar.
mvh
johs_j

" Det virker i din løsnning, men ikke i arne_v's."!

Then why do you need another solution?

Function test()
    Dim a, b As String
    a = RegKeyGet(HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion", "ProductName")
    b = RegKeyGet(HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\ComputerName\ComputerName", "ComputerName")
    MsgBox (a)
    MsgBox (b)
 
End Function

virker fint her.

>arne_v
Send et svar hvis du vil have nogle af pointerne.
johs_j

svar

thanks