Domino Code Fragment

Code Name*
API calls and declarations to access the Win Registry
Date*
04/29/2024
Source (or email address if you prefer)*
Rlatulippe@romac.com
IP address:.18.218.38.125
Description*
This will return the path of the Notes Data directory
Type*
LotusScript
Categories*
(Misc)
Implementation:
Required Client:
Server:
Limitations:
Comments:
Files/Graphics attachments (if applicable): Code:

' *********************************************************
' Registry Module for Visual Basic for Applications under Windows 95 & Win NT
' Declarations and Control Module
' *********************************************************
' **********************************************
' Declare the specific key path for your
' application's settings in the registry.
' **********************************************
Const AppReg = "SOFTWARE\Lotus\Notes"
Private Const REG_APP_KEYS_PATH = AppReg
' **********************************************
' Specify constants to specific branches in the
' registry.
' **********************************************
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Private Const ERROR_SUCCESS = 0&
Private Const ERROR_NO_MORE_ITEMS = 259&
' **********************************************
' Specify constants to registry data types.
' These are declared Public for outside module
' usage in the GetAppRegValue() function.

' **********************************************
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
'***********************************************
' Specify constants to registry action types.
' **********************************************
Private Const REG_OPTION_NON_VOLATILE = 0
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private Const SYNCHRONIZE = &H100000
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or _
KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or _
KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
' **********************************************
' Security mask attributes for Windows NT (SAM).

' **********************************************
Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Integer
End Type
Declare Function RegCreateKey Lib "advapi32" Alias "RegCreateKeyA" _
(Byval hKey As Long, _
Byval lpszSubKey As String, _
phkResult 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, _
lpSecurityAttributes As Any, _
phkResult As Long, lpdwDisposition As Long) _
As Long


Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" _
(Byval hKey As Long, _
Byval lpSubKey As String) _
As Long


Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" _
(Byval hKey As Long, _
Byval lpValueName As String) _
As Long


Declare Function RegCloseKey Lib "advapi32.dll" _
(Byval hKey As Long) _
As Long
Declare Function RegEnumKeyEx Lib "advapi32" Alias "RegEnumKeyA" _
(Byval hKey As Long, _
Byval iSubKey As Long, _
Byval lpszName As String, _
Byval cchName As Long) _
As Long


Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" _
(Byval hKey As Long, _
Byval lpszSubKey As String, _
Byval ulOptions As Long, _
Byval samDesired As Long, _
phkResult As Long) _
As Long


Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" _
(Byval hKey As Long, _
Byval lpszValueName As String, _
Byval dwReserved As Long, _
lpdwType As Long, _
lpbData As Any, _
cbData As Long) _
As Long


Declare Function RegSetValueEx Lib "advapi32" Alias "RegSetValueExA" _
(Byval hKey As Long, _
Byval lpszValueName As String, _
Byval dwReserved As Long, _
Byval fdwType As Long, _
lpbData As Any, _
Byval cbData As Long) _
As Long
Declare Function RegSetStringEx Lib "advapi32" Alias "RegSetValueExA" _
(Byval hKey As Long, _
Byval lpszValueName As String, _
Byval dwReserved As Long, _
Byval fdwType As Long, _
lpbData As String, _
Byval cbData As Long) _
As Long
Declare Function GetCurrentProcessId Lib "Kernel32" () As Long


Function GetAppRegValue(WhatKey As String, KeyDataType As Variant, KeyValue As Variant, IsVerbose As Integer) As Integer
On Error Goto GetAppRegValue_Err
' ***********************************************
' Declare local usage variables.
' ***********************************************
Dim lResult As Long
Dim dwResult As Long
Dim dwType As Long
Dim cbData As Long
Dim varStrData As String
Dim varLngData As Long
Dim Msg As String
' ***********************************************
' Open the key for application's path.
' ***********************************************
lResult = RegOpenKeyEx(HKEY_LOCAL_MACHINE, REG_APP_KEYS_PATH, Byval 0&, KEY_ALL_ACCESS, dwResult)
If Not (lResult = ERROR_SUCCESS) Then
GetAppRegValue = False
If IsVerbose Then
Msg = "Error" '"Error Opening Registry Key Entry:" & vbCrLf
Msg = Msg & "Key/Path=" & REG_APP_KEYS_PATH '& CrLf
Msg = Msg & "DLL Returned=" & Format$(lResult)

Msgbox Msg, 32, "ODBC Registry"
End If
Goto GetAppRegValue_End
End If
' ***********************************************
' Set up passed variables and retrieve value.
' ***********************************************
Select Case KeyDataType
Case REG_SZ
varStrData = String$(255, 0)
cbData = Len(varStrData)
lResult = RegQueryValueEx(dwResult, WhatKey, Byval 0&, _
dwType, Byval varStrData, cbData)
Case REG_DWORD
varLngData = False
cbData = Len(varLngData)
lResult = RegQueryValueEx(dwResult, WhatKey, Byval 0&, _
dwType, varLngData, cbData)
End Select
If Not (lResult = ERROR_SUCCESS) Then
GetAppRegValue = False
If IsVerbose Then
Msg = "Error Retrieving Registry Key Entry:"
Msg = Msg & "Key=" & WhatKey
Msg = Msg & "DLL Returned=" & Format$(lResult)
Msgbox Msg, 32, "ODBC Registry"
End If

lResult = RegCloseKey(dwResult)
Goto GetAppRegValue_End
End If
' ***********************************************
' Close key.
' ***********************************************
lResult = RegCloseKey(dwResult)
' ***********************************************
' Select data type (for the needed types
' used in the values) and assign value.
' ***********************************************
Select Case dwType
Case REG_NONE
KeyValue = Null
Case REG_SZ
KeyValue = Left$(varStrData, cbData)
Case REG_DWORD
KeyValue = varLngData
Case Else
KeyValue = Null
End Select
GetAppRegValue = True
Msgbox KeyValue
GetAppRegValue_End:
Exit Function
GetAppRegValue_Err:
Msgbox "Error", 32, "YourAppName"
Resume GetAppRegValue_End
End Function


Sub Click(Source As Button)
Dim KeyValue As String

'Here I am calling the string "Help File Path"
If Not GetAppRegValue("DataPath", REG_SZ, KeyValue, False) Then
Msgbox "Key Does not exist"
End If

End Sub