×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Contact US

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Using the Registry API
2

Using the Registry API

Using the Registry API

(OP)
I need to find the loaction of MSACCESS.

I know the reg key is

HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\8.0\BinDirPath

Can anyone provide sample code for this API.

Many thanks.

WP

Bill Paton
wpaton@neptune400.co.uk
www.neptune400.co.uk

RE: Using the Registry API

Below is a VB module for reg stuff

look for "Sub Main()" for the example code

-ml


Attribute VB_Name = "RegistryCalls"
'API Function and Constant Declarations
'--------------------------------------

Option Explicit

'***Declare the value data types
Global Const REG_SZ As Long = 1 '***Registry string
Global Const REG_DWORD As Long = 4 '***Registry number (32-bit number)

'***Declare the keys that should exist.
'***Typically applications will put information under HKEY_CURRENT_USER
Global Const HKEY_CLASSES_ROOT = &H80000000
Global Const HKEY_CURRENT_USER = &H80000001
Global Const HKEY_LOCAL_MACHINE = &H80000002
Global Const HKEY_USERS = &H80000003

'***Errors
Global Const ERROR_NONE = 0
Global Const ERROR_BADDB = 1
Global Const ERROR_BADKEY = 2
Global Const ERROR_CANTOPEN = 3
Global Const ERROR_CANTREAD = 4
Global Const ERROR_CANTWRITE = 5
Global Const ERROR_OUTOFMEMORY = 6
Global Const ERROR_INVALID_PARAMETER = 7
Global Const ERROR_ACCESS_DENIED = 8
Global Const ERROR_INVALID_PARAMETERS = 87
Global Const ERROR_NO_MORE_ITEMS = 259

'***Gives all users full access to the key
Global Const KEY_ALL_ACCESS = &H3F

'***Creates a key that is persistent
Global Const REG_OPTION_NON_VOLATILE = 0

Global gstrAppVersion As String

'***Registry API declarations
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

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

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

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

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

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

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

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


Public Function SetValueEx(ByVal hKey As Long, sValueName As String, _
lType As Long, vValue As Variant) As Long
'*** Called By: SetKeyValue
'*** Description: Wrapper function around the registry API calls
'*** RegSetValueExString/Long. Determines if the value
'*** is a string or a long and calls the appropriate API.
'*** Return Value: Returns the API call's return value, which is its
'*** status (successful, error).

Dim lValue As Long
Dim sValue As String

Select Case lType
'***String?
Case REG_SZ
sValue = vValue
SetValueEx = RegSetValueExString(hKey, sValueName, 0&, _
lType, sValue, Len(sValue))
'***32-bit number?
Case REG_DWORD
lValue = vValue
SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, _
lType, lValue, 4)
End Select
End Function
Private Function QueryValueEx( _
ByVal lhKey As Long, _
ByVal szValueName As String, _
vValue As Variant _
) As Long
'*** Called By: QueryValue
'*** Description: Wrapper function around the registry API calls to
'*** RegQueryValueExLong and RegQueryValueExString.
'*** Determines size and type of data to be read.
'*** Determines if the value is a string or a long
'*** and calls the appropriate API.
'*** Return Value: Returns the API call's return value, which is its
'*** status (successful, error). The parameter vValue
'*** contains the value queried.

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
If Mid(sValue, cch, 1) = Chr(0) Then
vValue = Left$(sValue, cch - 1) ' get rid of trailing AsciiZ
Else
vValue = Left$(sValue, cch)
End If
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

Public Sub CreateNewKey(sNewKeyName As String, lPredefinedKey As Long)
'***With this procedure a call of
'*** CreateNewKey "TestKey", HKEY_CURRENT_USER
'***will create a key called TestKey immediately under HKEY_CURRENT_USER.
'***Calling CreateNewKey like this
'*** CreateNewKey "TestKey\SubKey1\SubKey2", HKEY_CURRENT_USER
'***will create a three-nested keys beginning with TestKey immediately under
'***HKEY_CURRENT_USER, Subkey1 subordinate to TestKey, and SubKey3 under
'***SubKey2.

'*** Called by: your own code to create keys
'*** Description: Wrapper around the RegCreateKeyEx API call.

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
Public Sub SetKeyValue( _
ByVal lpParentKey As Long, _
sKeyName As String, _
sValueName As String, _
vValueSetting As Variant, lValueType As Long _
)
'*** Called By: Your code when you want to set a KeyValue
'*** Description: Opens the key you want to set, calls the wrapper
'*** function SetValueEx, and closes key.
'*** ADD ERROR HANDLING!!

Dim lRetVal As Long 'result of the SetValueEx function
Dim hKey As Long 'handle of open key

'open the specified key
lRetVal = RegOpenKeyEx(lpParentKey, sKeyName, 0, _
KEY_ALL_ACCESS, hKey)
lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
RegCloseKey (hKey)
End Sub
Public Function QueryValue( _
ByVal lpParentKey As Long, _
sKeyName As String, _
sValueName As String _
) As Variant

'*** Called By: Your code when you want to set a read a KeyValue
'*** Description: Opens the key you want to set, calls the wrapper
'*** function QueryValueEx, closes key.
'*** Return Value: The value you are querying
'*** ADD ERROR HANDLING!!

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(lpParentKey, sKeyName, 0, _
KEY_ALL_ACCESS, hKey)
lRetVal = QueryValueEx(hKey, sValueName, vValue)
RegCloseKey (hKey)
QueryValue = vValue
End Function

Sub Main()
'This is the main procedure. This is where the appliation
'starts.

CreateKeyDriver
Debug.Print "Created key Cosmic Example and TestVals"

SetStringValueDriver
Debug.Print "Created the TestStringVal"

SetNumberValueDriver
Debug.Print "Created the TestNumVal"

ReadValueDriver

End
End Sub

Sub CreateKeyDriver()
'*** Calls the CreateNewKey procedure
'*** Description: Creates Cosmic Example key and TestVals subkey under
'*** HKEY_CURRENT_USER\Software\VB and VBA Program Settings
'*** If Software and/or VB and VBA Program Settings do not
'*** exist, they are created.
'*** Usage: Use this as an example of how you would use the CreateNewKey
'*** procedure.

Dim sNewKey As String
Dim lPredefinedKeyValue As Long

sNewKey = "Software\VB and VBA Program Settings\Cosmic Example\TestVals"
lPredefinedKeyValue = HKEY_CURRENT_USER

CreateNewKey sNewKey, lPredefinedKeyValue
End Sub

Sub SetStringValueDriver()
'*** Calls the SetKeyValue procedure
'*** Description: Sets the value TestStringVal under the
'*** Cosmic Example\TestVals key and sets it to
'*** VB App Created. If it doesn't exist, it creates it.
'*** Usage: Use this as an example of how you would use the SetKeyValue
'*** procedure.

Dim sKey As String '***Key under which to create the value
Dim sValue As String '***Value name to set
Dim vSetting As Variant '***What to set the Value to
Dim sType As Long '***Value type -- string or number

sKey = "Software\VB and VBA Program Settings\Cosmic Example\TestVals"
sValue = "TestStringVal"
vSetting = "VB App Created"
sType = REG_SZ

SetKeyValue HKEY_CURRENT_USER, sKey, sValue, vSetting, sType

End Sub
Sub SetNumberValueDriver()
'*** Calls the SetKeyValue procedure
'*** Description: Sets the value TestNumVal under the
'*** Cosmic Example\TestVals key and sets it to 5.
'*** If it doesn't exist, it creates it.
'*** Usage: Use this as an example of how you would use the SetKeyValue
'*** procedure.

Dim sKey As String '***Key under which to create the value
Dim sValue As String '***Value name to set
Dim vSetting As Variant '***Wht to set the Value to
Dim sType As Long '***Value type -- string or number

sKey = "Software\VB and VBA Program Settings\Cosmic Example\TestVals"
sValue = "TestNumVal"
vSetting = 5
sType = REG_DWORD

SetKeyValue HKEY_CURRENT_USER, sKey, sValue, vSetting, sType

End Sub
Sub ReadValueDriver()
'*** Calls the QueryValue function
'*** Description: Reads the value TestNumVal and TestStringVal under
'*** the Cosmic Example\TestVals key.
'*** Usage: Use this as an example of how you would use the QueryValue
'*** procedure.

Dim sKey As String '***Key under which to create the value
Dim sValue As String '***Value name to set
Dim vSetting As Variant

sKey = "Software\VB and VBA Program Settings\Cosmic Example\TestVals"
sValue = "TestStringVal"

'***Read the String value
vSetting = QueryValue(HKEY_CURRENT_USER, sKey, sValue)
Debug.Print "TestStringVal is " & vSetting

sValue = "TestNumVal"
'***Read the number value
vSetting = QueryValue(HKEY_CURRENT_USER, sKey, sValue)
Debug.Print "TestNumVal is " & vSetting

End Sub

Mike Lacey
Mike_Lacey@Cargill.Com
Cargill's Corporate Web Site

RE: Using the Registry API

Try downloading the "regobj.dll" from the microsoft web site, it may not be as precise but works.

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members! Already a Member? Login

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close