|
 |
access thread: Retrieving a Value from the Win2000 Registry
Message #1 by amy.bender@p... on Thu, 19 Dec 2002 17:51:26
|
|
I have a report database that has linked SQL tables. A certain value
within the O/S registry will determine what reports I show the user.
Does anyone know how to obtain that value from the registry from Access??
Thanks!!
O/S: Windows 2000
DB: Access 2000
Message #2 by "Leo Scott" <leoscott@c...> on Thu, 19 Dec 2002 09:53:20 -0800
|
|
You can with VBA. Look at this in the help file:
GetSetting Function
Returns a key setting value from an application's entry in the Windows
registry or (on the Macintosh) information in the application?s
initialization file.
Syntax
GetSetting(appname, section, key[, default])
The GetSetting function syntax has these named arguments:
Part Description
appname Required. String expression containing the name of the application
or project whose key setting is requested. On the Macintosh, this is the
filename of the initialization file in the Preferences folder in the System
folder.
section Required. String expression containing the name of the section where
the key setting is found.
key Required. String expression containing the name of the key setting to
return.
default Optional. Expression containing the value to return if no value is
set in the key setting. If omitted, default is assumed to be a zero-length
string ("").
Remarks
If any of the items named in the GetSetting arguments do not exist,
GetSetting returns the value of default.
|-----Original Message-----
|From: amy.bender@p... [mailto:amy.bender@p...]
|Sent: Thursday, December 19, 2002 5:51 PM
|To: Access
|Subject: [access] Retrieving a Value from the Win2000 Registry
|
|
|I have a report database that has linked SQL tables. A certain value
|within the O/S registry will determine what reports I show the user.
|
|Does anyone know how to obtain that value from the registry from Access??
|
|Thanks!!
|
|O/S: Windows 2000
|DB: Access 2000
|
Message #3 by "Carnley, Dave" <dcarnley@a...> on Thu, 19 Dec 2002 12:26:17 -0600
|
|
try this... it's from VB6 but it should mostly work. I use this as part of
a registry-reading DLL that I wroteand use form wiothin my Access projects.
Option Explicit
Private Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long
Private 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
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 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
Private 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
Private Declare Function RegQueryValueExNULL 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
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, ByVal lpValue As _
String, ByVal cbData As Long) As Long
Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias _
"RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, _
ByVal cbData As Long) As Long
Private mlRootKey As Long
Private msSubKeyPath As String
Private mvKeyName As Variant
Private mvKeyValue As Variant
Private mlDataType As Long
Private mlNumberSubKeys As Long
Private mlNumberValues As Long
Private mvValueIndex As Variant
Private Const mcMaxLength As Long = 500
Private Sub class_initialize()
mlDataType = REG_DATATYPE_STRING
mlNumberSubKeys = 0
mlNumberValues = 0
End Sub
Public Property Get Value() As Variant
Value = mvKeyValue
End Property
Public Property Let Value(ByVal vNewValue As Variant)
mvKeyValue = vNewValue
End Property
Public Property Get RootKey() As Long
RootKey = mlRootKey
End Property
Public Property Let RootKey(ByVal vNewValue As Long)
Select Case vNewValue
Case REG_HKEY_CLASSES_ROOT, REG_HKEY_CURRENT_USER,
REG_HKEY_LOCAL_MACHINE, REG_HKEY_PERFORMANCE_DATA, REG_HKEY_USERS
mlRootKey = vNewValue
Case Else
Err.Raise vbObjectError + REG_ERR_KEY_NOT_FOUND, "clsRegistry",
"Invalid Root Key"
End Select
End Property
Public Property Get SubKeyPath() As Variant
SubKeyPath = msSubKeyPath
End Property
Public Property Let SubKeyPath(ByVal vNewValue As Variant)
msSubKeyPath = vNewValue
End Property
Public Property Get KeyName() As Variant
KeyName = mvKeyName
End Property
Public Property Let KeyName(ByVal vNewValue As Variant)
mvKeyName = vNewValue
End Property
Public Property Get DataType() As Long
DataType = mlDataType
End Property
Public Property Let DataType(ByVal vNewValue As Long)
Select Case vNewValue
Case REG_DATATYPE_LONG, REG_DATATYPE_STRING
mlDataType = vNewValue
Case Else
Err.Raise vbObjectError + REG_ERR_TYPE_NOT_SUPPORTED, "clsRegistry",
"Invalid Data Type"
End Select
End Property
Public Function SaveValue() As Long
Dim lngReturnValue As Long
lngReturnValue = SetKeyValue(msSubKeyPath, CStr(mvKeyName), mvKeyValue,
mlDataType)
SaveValue = lngReturnValue
End Function
Public Function Find() As Long
Dim lngReturnValue As Long
Dim hKey As Long
lngReturnValue = RegOpenKeyEx(mlRootKey, msSubKeyPath, 0,
KEY_QUERY_VALUE, hKey)
If lngReturnValue = ERROR_NONE Then ' key was found
Select Case mlDataType
Case REG_DATATYPE_STRING
mvKeyValue = QueryValue(msSubKeyPath, CStr(mvKeyName))
Case REG_DATATYPE_LONG
mvKeyValue = QueryValue(msSubKeyPath, CStr(mvKeyName))
Case Else
mvKeyValue = Null
lngReturnValue = REG_ERR_TYPE_NOT_SUPPORTED
End Select
' if mvKeyValue is "", then no value was found in the key.
If mvKeyValue = "" Then
mvKeyValue = Null
lngReturnValue = REG_ERR_VALUE_NOT_FOUND
End If
End If
Find = lngReturnValue
End Function
Public Property Get NumberOfSubKeys() As Long
NumberOfSubKeys = mlNumberSubKeys
End Property
Public Property Get NumberOfValues() As Long
NumberOfValues = mlNumberValues
End Property
Public Property Get ValueIndex() As Variant
ValueIndex = mvValueIndex
End Property
Public Property Let ValueIndex(ByVal vNewValue As Variant)
If Not IsNull(vNewValue) And _
Not IsEmpty(vNewValue) Then
If IsNumeric(vNewValue) Then
mvValueIndex = vNewValue
Else
Err.Raise vbObjectError + REG_ERR_TYPE_NOT_SUPPORTED,
"clsRegistry", "ValueIndex must be numeric or null"
End If
Else
mvValueIndex = vNewValue
End If
End Property
Public Function SetValueEx(ByVal hKey As Long, sValueName As String, _
lType As Long, vValue As Variant) As Long
Dim lValue As Long
Dim sValue As String
Select Case lType
Case REG_SZ
sValue = vValue & Chr$(0)
SetValueEx = RegSetValueExString(hKey, sValueName, 0&, _
lType, sValue, Len(sValue))
Case REG_DWORD
lValue = vValue
SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, _
lType, lValue, 4)
End Select
End Function
Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As _
String, vValue As Variant) As Long
Dim cch As Long
Dim lrc As Long
Dim lType As Long
Dim lValue As Long
Dim sValue As String
On Error GoTo QueryValueExError
' Determine the size and type of data to be read
lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
If lrc <> ERROR_NONE Then Error 5
Select Case lType
' For strings
Case REG_SZ:
sValue = String(cch, 0)
lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, _
sValue, cch)
If lrc = ERROR_NONE Then
vValue = Left$(sValue, cch - 1)
Else
vValue = Empty
End If
' For DWORDS
Case REG_DWORD:
lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, _
lValue, cch)
If lrc = ERROR_NONE Then vValue = lValue
Case Else
'all other data types not supported
lrc = -1
End Select
QueryValueExExit:
QueryValueEx = lrc
Exit Function
QueryValueExError:
Resume QueryValueExExit
End Function
Private Sub CreateNewKey(sNewKeyName As String, lPredefinedKey As Long)
Dim hNewKey As Long 'handle to the new key
Dim lRetVal As Long 'result of the RegCreateKeyEx function
lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, _
vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, _
0&, hNewKey, lRetVal)
RegCloseKey (hNewKey)
End Sub
Private Function SetKeyValue(sKeyName As String, sValueName As String, _
vValueSetting As Variant, lValueType As Long) As
Long
Dim lRetVal As Long 'result of the SetValueEx function
Dim hKey As Long 'handle of open key
'open the specified key, use create,so if it does not exist, it is
created
lRetVal = RegCreateKeyEx(mlRootKey, sKeyName, 0&, vbNullString,
REG_OPTION_NON_VOLATILE, _
KEY_ALL_ACCESS, 0&, hKey, lRetVal)
If lRetVal = ERROR_NONE Then
lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
RegCloseKey (hKey)
End If
SetKeyValue = lRetVal
End Function
Private Function QueryValue(sKeyName As String, sValueName As String) As
String
Dim lRetVal As Long 'result of the API functions
Dim hKey As Long 'handle of opened key
Dim vValue As Variant 'setting of queried value
lRetVal = RegOpenKeyEx(mlRootKey, sKeyName, 0, KEY_QUERY_VALUE, hKey)
If lRetVal = ERROR_NONE Then
lRetVal = QueryValueEx(hKey, sValueName, vValue)
If lRetVal = ERROR_NONE Then
QueryValue = vValue
Else
QueryValue = "" ' Null
End If
RegCloseKey (hKey)
Else
QueryValue = "" ' Null
End If
End Function
-----Original Message-----
From: amy.bender@p... [mailto:amy.bender@p...]
Sent: Thursday, December 19, 2002 11:51 AM
To: Access
Subject: [access] Retrieving a Value from the Win2000 Registry
I have a report database that has linked SQL tables. A certain value
within the O/S registry will determine what reports I show the user.
Does anyone know how to obtain that value from the registry from Access??
Thanks!!
O/S: Windows 2000
DB: Access 2000
Message #4 by John Fejsa <John.Fejsa@h...> on Fri, 20 Dec 2002 08:31:38 +1100
|
|
I tried playing with your code to see how it works but when I tried to
compile the code it generated "Variable NOt Defined" error. It pointed
to "REG_DATATYPE_STRING" variable. Is this a custom constant you
defined somewhere else. If it is can you send definition, if not can
you tell us what kind of a variable are we looking for and where to
find/define it. Thanks.
____________________________________________________
John Fejsa
Systems Analyst/Computer Programmer
Hunter Centre for Health Advancement
Locked Bag 10, WALLSEND NSW 2287
Phone: (02) 4924 6336 Fax: (02) 4924 6209
www.hcha.org.au
____________________________________________________
The doors we open and close each day decide the lives we live
____________________________________________________
CONFIDENTIALITY & PRIVILEGE NOTICE
>>> dcarnley@a... 20/12/2002 5:26:17 >>>
try this... it's from VB6 but it should mostly work. I use this as
part of
a registry-reading DLL that I wroteand use form wiothin my Access
projects.
Option Explicit
Private Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long
Private 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
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 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
Private 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
Private Declare Function RegQueryValueExNULL 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
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, ByVal lpValue As _
String, ByVal cbData As Long) As Long
Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias _
"RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, _
ByVal cbData As Long) As Long
Private mlRootKey As Long
Private msSubKeyPath As String
Private mvKeyName As Variant
Private mvKeyValue As Variant
Private mlDataType As Long
Private mlNumberSubKeys As Long
Private mlNumberValues As Long
Private mvValueIndex As Variant
Private Const mcMaxLength As Long = 500
Private Sub class_initialize()
mlDataType = REG_DATATYPE_STRING
mlNumberSubKeys = 0
mlNumberValues = 0
End Sub
Public Property Get Value() As Variant
Value = mvKeyValue
End Property
Public Property Let Value(ByVal vNewValue As Variant)
mvKeyValue = vNewValue
End Property
Public Property Get RootKey() As Long
RootKey = mlRootKey
End Property
Public Property Let RootKey(ByVal vNewValue As Long)
Select Case vNewValue
Case REG_HKEY_CLASSES_ROOT, REG_HKEY_CURRENT_USER,
REG_HKEY_LOCAL_MACHINE, REG_HKEY_PERFORMANCE_DATA, REG_HKEY_USERS
mlRootKey = vNewValue
Case Else
Err.Raise vbObjectError + REG_ERR_KEY_NOT_FOUND, "clsRegistry",
"Invalid Root Key"
End Select
End Property
Public Property Get SubKeyPath() As Variant
SubKeyPath = msSubKeyPath
End Property
Public Property Let SubKeyPath(ByVal vNewValue As Variant)
msSubKeyPath = vNewValue
End Property
Public Property Get KeyName() As Variant
KeyName = mvKeyName
End Property
Public Property Let KeyName(ByVal vNewValue As Variant)
mvKeyName = vNewValue
End Property
Public Property Get DataType() As Long
DataType = mlDataType
End Property
Public Property Let DataType(ByVal vNewValue As Long)
Select Case vNewValue
Case REG_DATATYPE_LONG, REG_DATATYPE_STRING
mlDataType = vNewValue
Case Else
Err.Raise vbObjectError + REG_ERR_TYPE_NOT_SUPPORTED,
"clsRegistry",
"Invalid Data Type"
End Select
End Property
Public Function SaveValue() As Long
Dim lngReturnValue As Long
lngReturnValue = SetKeyValue(msSubKeyPath, CStr(mvKeyName),
mvKeyValue,
mlDataType)
SaveValue = lngReturnValue
End Function
Public Function Find() As Long
Dim lngReturnValue As Long
Dim hKey As Long
lngReturnValue = RegOpenKeyEx(mlRootKey, msSubKeyPath, 0,
KEY_QUERY_VALUE, hKey)
If lngReturnValue = ERROR_NONE Then ' key was found
Select Case mlDataType
Case REG_DATATYPE_STRING
mvKeyValue = QueryValue(msSubKeyPath, CStr(mvKeyName))
Case REG_DATATYPE_LONG
mvKeyValue = QueryValue(msSubKeyPath, CStr(mvKeyName))
Case Else
mvKeyValue = Null
lngReturnValue = REG_ERR_TYPE_NOT_SUPPORTED
End Select
' if mvKeyValue is "", then no value was found in the key.
If mvKeyValue = "" Then
mvKeyValue = Null
lngReturnValue = REG_ERR_VALUE_NOT_FOUND
End If
End If
Find = lngReturnValue
End Function
Public Property Get NumberOfSubKeys() As Long
NumberOfSubKeys = mlNumberSubKeys
End Property
Public Property Get NumberOfValues() As Long
NumberOfValues = mlNumberValues
End Property
Public Property Get ValueIndex() As Variant
ValueIndex = mvValueIndex
End Property
Public Property Let ValueIndex(ByVal vNewValue As Variant)
If Not IsNull(vNewValue) And _
Not IsEmpty(vNewValue) Then
If IsNumeric(vNewValue) Then
mvValueIndex = vNewValue
Else
Err.Raise vbObjectError + REG_ERR_TYPE_NOT_SUPPORTED,
"clsRegistry", "ValueIndex must be numeric or null"
End If
Else
mvValueIndex = vNewValue
End If
End Property
Public Function SetValueEx(ByVal hKey As Long, sValueName As String,
_
lType As Long, vValue As Variant) As Long
Dim lValue As Long
Dim sValue As String
Select Case lType
Case REG_SZ
sValue = vValue & Chr$(0)
SetValueEx = RegSetValueExString(hKey, sValueName, 0&, _
lType, sValue,
Len(sValue))
Case REG_DWORD
lValue = vValue
SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, _
lType, lValue, 4)
End Select
End Function
Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As _
String, vValue As Variant) As Long
Dim cch As Long
Dim lrc As Long
Dim lType As Long
Dim lValue As Long
Dim sValue As String
On Error GoTo QueryValueExError
' Determine the size and type of data to be read
lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
If lrc <> ERROR_NONE Then Error 5
Select Case lType
' For strings
Case REG_SZ:
sValue = String(cch, 0)
lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, _
sValue, cch)
If lrc = ERROR_NONE Then
vValue = Left$(sValue, cch - 1)
Else
vValue = Empty
End If
' For DWORDS
Case REG_DWORD:
lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, _
lValue, cch)
If lrc = ERROR_NONE Then vValue = lValue
Case Else
'all other data types not supported
lrc = -1
End Select
QueryValueExExit:
QueryValueEx = lrc
Exit Function
QueryValueExError:
Resume QueryValueExExit
End Function
Private Sub CreateNewKey(sNewKeyName As String, lPredefinedKey As Long)
Dim hNewKey As Long 'handle to the new key
Dim lRetVal As Long 'result of the RegCreateKeyEx
function
lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, _
vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS,
_
0&, hNewKey, lRetVal)
RegCloseKey (hNewKey)
End Sub
Private Function SetKeyValue(sKeyName As String, sValueName As String, _
vValueSetting As Variant, lValueType As Long) As
Long
Dim lRetVal As Long 'result of the SetValueEx function
Dim hKey As Long 'handle of open key
'open the specified key, use create,so if it does not exist, it is
created
lRetVal = RegCreateKeyEx(mlRootKey, sKeyName, 0&, vbNullString,
REG_OPTION_NON_VOLATILE, _
KEY_ALL_ACCESS, 0&, hKey, lRetVal)
If lRetVal = ERROR_NONE Then
lRetVal = SetValueEx(hKey, sValueName, lValueType,
vValueSetting)
RegCloseKey (hKey)
End If
SetKeyValue = lRetVal
End Function
Private Function QueryValue(sKeyName As String, sValueName As String) As
String
Dim lRetVal As Long 'result of the API functions
Dim hKey As Long 'handle of opened key
Dim vValue As Variant 'setting of queried value
lRetVal = RegOpenKeyEx(mlRootKey, sKeyName, 0, KEY_QUERY_VALUE,
hKey)
If lRetVal = ERROR_NONE Then
lRetVal = QueryValueEx(hKey, sValueName, vValue)
If lRetVal = ERROR_NONE Then
QueryValue = vValue
Else
QueryValue = "" ' Null
End If
RegCloseKey (hKey)
Else
QueryValue = "" ' Null
End If
End Function
-----Original Message-----
From: amy.bender@p... [mailto:amy.bender@p...]
Sent: Thursday, December 19, 2002 11:51 AM
To: Access
Subject: [access] Retrieving a Value from the Win2000 Registry
I have a report database that has linked SQL tables. A certain value
within the O/S registry will determine what reports I show the user.
Does anyone know how to obtain that value from the registry from
Access??
Thanks!!
O/S: Windows 2000
DB: Access 2000
This message is intended for the addressee named
and may contain confidential information.
If you are not the intended recipient, please
delete it and notify the sender.
Views expressed in this message are those of the
individual sender, and are not necessarily the
views of Hunter Health.
Message #5 by "Carnley, Dave" <dcarnley@a...> on Fri, 20 Dec 2002 09:15:37 -0600
|
|
Sorry!!!
This is in a seperate global module (not a class module)
Option Explicit
' Registry Root Keys
Public Const REG_HKEY_CLASSES_ROOT = &H80000000
Public Const REG_HKEY_CURRENT_USER = &H80000001
Public Const REG_HKEY_LOCAL_MACHINE = &H80000002
Public Const REG_HKEY_USERS = &H80000003
Public Const REG_HKEY_PERFORMANCE_DATA = &H80000004
' Registry Errors
Public Const REG_ERR_SUCCESS As Long = 0
Public Const REG_ERR_KEY_NOT_FOUND = -201
Public Const REG_ERR_VALUE_NOT_FOUND = -202
Public Const REG_ERR_CANT_SET_VALUE = -203
Public Const REG_ERR_SUB_KEY_NOT_FOUND = -204
Public Const REG_ERR_TYPE_NOT_SUPPORTED = -205
Public Const REG_ERR_CANT_CREATE_KEY = -206
' Registry Datatypes
Public Const REG_DATATYPE_STRING = 1
Public Const REG_DATATYPE_LONG = 4
Public Const REG_SZ As Long = 1
Public Const REG_DWORD As Long = 4
Public Const ERROR_NONE = 0
Public Const ERROR_BADDB = 1
Public Const ERROR_BADKEY = 2
Public Const ERROR_CANTOPEN = 3
Public Const ERROR_CANTREAD = 4
Public Const ERROR_CANTWRITE = 5
Public Const ERROR_OUTOFMEMORY = 6
Public Const ERROR_ARENA_TRASHED = 7
Public Const ERROR_ACCESS_DENIED = 8
Public Const ERROR_INVALID_PARAMETERS = 87
Public Const ERROR_NO_MORE_ITEMS = 259
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_SET_VALUE = &H2
Public Const KEY_ALL_ACCESS = &H3F
Public Const REG_OPTION_NON_VOLATILE = 0
-----Original Message-----
From: John Fejsa [mailto:John.Fejsa@h...]
Sent: Thursday, December 19, 2002 3:32 PM
To: Access
Subject: [access] Re: Retrieving a Value from the Win2000 Registry
I tried playing with your code to see how it works but when I tried to
compile the code it generated "Variable NOt Defined" error. It pointed
to "REG_DATATYPE_STRING" variable. Is this a custom constant you
defined somewhere else. If it is can you send definition, if not can
you tell us what kind of a variable are we looking for and where to
find/define it. Thanks.
____________________________________________________
John Fejsa
Systems Analyst/Computer Programmer
Hunter Centre for Health Advancement
Locked Bag 10, WALLSEND NSW 2287
Phone: (02) 4924 6336 Fax: (02) 4924 6209
www.hcha.org.au
____________________________________________________
The doors we open and close each day decide the lives we live
____________________________________________________
CONFIDENTIALITY & PRIVILEGE NOTICE
>>> dcarnley@a... 20/12/2002 5:26:17 >>>
try this... it's from VB6 but it should mostly work. I use this as
part of
a registry-reading DLL that I wroteand use form wiothin my Access
projects.
Option Explicit
Private Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long
Private 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
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 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
Private 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
Private Declare Function RegQueryValueExNULL 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
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, ByVal lpValue As _
String, ByVal cbData As Long) As Long
Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias _
"RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, _
ByVal cbData As Long) As Long
Private mlRootKey As Long
Private msSubKeyPath As String
Private mvKeyName As Variant
Private mvKeyValue As Variant
Private mlDataType As Long
Private mlNumberSubKeys As Long
Private mlNumberValues As Long
Private mvValueIndex As Variant
Private Const mcMaxLength As Long = 500
Private Sub class_initialize()
mlDataType = REG_DATATYPE_STRING
mlNumberSubKeys = 0
mlNumberValues = 0
End Sub
Public Property Get Value() As Variant
Value = mvKeyValue
End Property
Public Property Let Value(ByVal vNewValue As Variant)
mvKeyValue = vNewValue
End Property
Public Property Get RootKey() As Long
RootKey = mlRootKey
End Property
Public Property Let RootKey(ByVal vNewValue As Long)
Select Case vNewValue
Case REG_HKEY_CLASSES_ROOT, REG_HKEY_CURRENT_USER,
REG_HKEY_LOCAL_MACHINE, REG_HKEY_PERFORMANCE_DATA, REG_HKEY_USERS
mlRootKey = vNewValue
Case Else
Err.Raise vbObjectError + REG_ERR_KEY_NOT_FOUND, "clsRegistry",
"Invalid Root Key"
End Select
End Property
Public Property Get SubKeyPath() As Variant
SubKeyPath = msSubKeyPath
End Property
Public Property Let SubKeyPath(ByVal vNewValue As Variant)
msSubKeyPath = vNewValue
End Property
Public Property Get KeyName() As Variant
KeyName = mvKeyName
End Property
Public Property Let KeyName(ByVal vNewValue As Variant)
mvKeyName = vNewValue
End Property
Public Property Get DataType() As Long
DataType = mlDataType
End Property
Public Property Let DataType(ByVal vNewValue As Long)
Select Case vNewValue
Case REG_DATATYPE_LONG, REG_DATATYPE_STRING
mlDataType = vNewValue
Case Else
Err.Raise vbObjectError + REG_ERR_TYPE_NOT_SUPPORTED,
"clsRegistry",
"Invalid Data Type"
End Select
End Property
Public Function SaveValue() As Long
Dim lngReturnValue As Long
lngReturnValue = SetKeyValue(msSubKeyPath, CStr(mvKeyName),
mvKeyValue,
mlDataType)
SaveValue = lngReturnValue
End Function
Public Function Find() As Long
Dim lngReturnValue As Long
Dim hKey As Long
lngReturnValue = RegOpenKeyEx(mlRootKey, msSubKeyPath, 0,
KEY_QUERY_VALUE, hKey)
If lngReturnValue = ERROR_NONE Then ' key was found
Select Case mlDataType
Case REG_DATATYPE_STRING
mvKeyValue = QueryValue(msSubKeyPath, CStr(mvKeyName))
Case REG_DATATYPE_LONG
mvKeyValue = QueryValue(msSubKeyPath, CStr(mvKeyName))
Case Else
mvKeyValue = Null
lngReturnValue = REG_ERR_TYPE_NOT_SUPPORTED
End Select
' if mvKeyValue is "", then no value was found in the key.
If mvKeyValue = "" Then
mvKeyValue = Null
lngReturnValue = REG_ERR_VALUE_NOT_FOUND
End If
End If
Find = lngReturnValue
End Function
Public Property Get NumberOfSubKeys() As Long
NumberOfSubKeys = mlNumberSubKeys
End Property
Public Property Get NumberOfValues() As Long
NumberOfValues = mlNumberValues
End Property
Public Property Get ValueIndex() As Variant
ValueIndex = mvValueIndex
End Property
Public Property Let ValueIndex(ByVal vNewValue As Variant)
If Not IsNull(vNewValue) And _
Not IsEmpty(vNewValue) Then
If IsNumeric(vNewValue) Then
mvValueIndex = vNewValue
Else
Err.Raise vbObjectError + REG_ERR_TYPE_NOT_SUPPORTED,
"clsRegistry", "ValueIndex must be numeric or null"
End If
Else
mvValueIndex = vNewValue
End If
End Property
Public Function SetValueEx(ByVal hKey As Long, sValueName As String,
_
lType As Long, vValue As Variant) As Long
Dim lValue As Long
Dim sValue As String
Select Case lType
Case REG_SZ
sValue = vValue & Chr$(0)
SetValueEx = RegSetValueExString(hKey, sValueName, 0&, _
lType, sValue,
Len(sValue))
Case REG_DWORD
lValue = vValue
SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, _
lType, lValue, 4)
End Select
End Function
Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As _
String, vValue As Variant) As Long
Dim cch As Long
Dim lrc As Long
Dim lType As Long
Dim lValue As Long
Dim sValue As String
On Error GoTo QueryValueExError
' Determine the size and type of data to be read
lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
If lrc <> ERROR_NONE Then Error 5
Select Case lType
' For strings
Case REG_SZ:
sValue = String(cch, 0)
lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, _
sValue, cch)
If lrc = ERROR_NONE Then
vValue = Left$(sValue, cch - 1)
Else
vValue = Empty
End If
' For DWORDS
Case REG_DWORD:
lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, _
lValue, cch)
If lrc = ERROR_NONE Then vValue = lValue
Case Else
'all other data types not supported
lrc = -1
End Select
QueryValueExExit:
QueryValueEx = lrc
Exit Function
QueryValueExError:
Resume QueryValueExExit
End Function
Private Sub CreateNewKey(sNewKeyName As String, lPredefinedKey As Long)
Dim hNewKey As Long 'handle to the new key
Dim lRetVal As Long 'result of the RegCreateKeyEx
function
lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, _
vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS,
_
0&, hNewKey, lRetVal)
RegCloseKey (hNewKey)
End Sub
Private Function SetKeyValue(sKeyName As String, sValueName As String, _
vValueSetting As Variant, lValueType As Long) As
Long
Dim lRetVal As Long 'result of the SetValueEx function
Dim hKey As Long 'handle of open key
'open the specified key, use create,so if it does not exist, it is
created
lRetVal = RegCreateKeyEx(mlRootKey, sKeyName, 0&, vbNullString,
REG_OPTION_NON_VOLATILE, _
KEY_ALL_ACCESS, 0&, hKey, lRetVal)
If lRetVal = ERROR_NONE Then
lRetVal = SetValueEx(hKey, sValueName, lValueType,
vValueSetting)
RegCloseKey (hKey)
End If
SetKeyValue = lRetVal
End Function
Private Function QueryValue(sKeyName As String, sValueName As String) As
String
Dim lRetVal As Long 'result of the API functions
Dim hKey As Long 'handle of opened key
Dim vValue As Variant 'setting of queried value
lRetVal = RegOpenKeyEx(mlRootKey, sKeyName, 0, KEY_QUERY_VALUE,
hKey)
If lRetVal = ERROR_NONE Then
lRetVal = QueryValueEx(hKey, sValueName, vValue)
If lRetVal = ERROR_NONE Then
QueryValue = vValue
Else
QueryValue = "" ' Null
End If
RegCloseKey (hKey)
Else
QueryValue = "" ' Null
End If
End Function
-----Original Message-----
From: amy.bender@p... [mailto:amy.bender@p...]
Sent: Thursday, December 19, 2002 11:51 AM
To: Access
Subject: [access] Retrieving a Value from the Win2000 Registry
I have a report database that has linked SQL tables. A certain value
within the O/S registry will determine what reports I show the user.
Does anyone know how to obtain that value from the registry from
Access??
Thanks!!
O/S: Windows 2000
DB: Access 2000
This message is intended for the addressee named
and may contain confidential information.
If you are not the intended recipient, please
delete it and notify the sender.
Views expressed in this message are those of the
individual sender, and are not necessarily the
views of Hunter Health.
|
|
|
View Cart
