Tag: Lotus Notes

@RegQueryValue
Queries the Windows registry for a specified value.
(from @RegQueryValue, Notes Designer Help database)

Although this function can be used in LotusScript by means of an Evaluate, it doesn’t work at all for the registry (Default) values. So here is a LotusScript RegQueryValue full blown function, in its own RegistryAccess library.

'RegistryAccess:

Option Public
Option Declare

' http://msdn.microsoft.com/library/default.asp?url=/library/en-us/sysinfo/base/registry_functions.asp
' http://www.windowsdevcenter.com/lpt/a/4923

Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Public Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type

%REM
LONG RegOpenKeyEx(
  HKEY hKey,
  LPCTSTR lpSubKey,
  DWORD ulOptions,
  REGSAM samDesired,
  PHKEY phkResult
);
%END REM
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

%REM
LONG RegCloseKey(
  HKEY hKey
);
%END REM
Declare Function RegCloseKey _
Lib "advapi32.dll" _
( Byval hKey As Long ) _
As Long

%REM
LONG RegQueryValueEx(
  HKEY hKey,
  LPCTSTR lpValueName,
  LPDWORD lpReserved,
  LPDWORD lpType,
  LPBYTE lpData,
  LPDWORD lpcbData
);
%END REM
Declare Function RegQueryValueEx _
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

%REM
LONG RegEnumKeyEx(
  HKEY hKey,
  DWORD dwIndex,
  LPTSTR lpName,
  LPDWORD lpcName,
  LPDWORD lpReserved,
  LPTSTR lpClass,
  LPDWORD lpcClass,
  PFILETIME lpftLastWriteTime
);
%END REM
Declare Function RegEnumKeyEx _
Lib "advapi32.dll" _
Alias "RegEnumKeyExA" _
( Byval hKey As Long _
, Byval dwIndex As Long _
, Byval lpname As String _
, lpcbName As Long _
, Byval lpReserved As Long _
, Byval lpClass As String _
, lpcbClass As Long _
, lpftLastWriteTime As FILETIME ) _
As Long

%REM
LONG RegSetValueEx(
  HKEY hKey,
  LPCTSTR lpValueName,
  DWORD Reserved,
  DWORD dwType,
  const BYTE* lpData,
  DWORD cbData
);
%END REM
Declare Function RegSetValueEx _
Lib "advapi32.dll" _
Alias "RegSetValueExA" _
( Byval hKey As Long _
, Byval lpValueName As String _
, Byval Reserved As Long _
, Byval dwType As Long _
, Byval lpData As String _
, Byval cbData As Long ) _
As Long

%REM
LONG RegCreateKeyEx(
  HKEY hKey,
  LPCTSTR lpSubKey,
  DWORD Reserved,
  LPTSTR lpClass,
  DWORD dwOptions,
  REGSAM samDesired,
  LPSECURITY_ATTRIBUTES lpSecurityAttributes,
  PHKEY phkResult,
  LPDWORD lpdwDisposition
);
%END REM
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 SECURITY_ATTRIBUTES _
, phkResult As Long _
, lpdwDisposition As Long ) _
As Long

%REM
LONG RegQueryInfoKey(
  HKEY hKey,
  LPTSTR lpClass,
  LPDWORD lpcClass,
  LPDWORD lpReserved,
  LPDWORD lpcSubKeys,
  LPDWORD lpcMaxSubKeyLen,
  LPDWORD lpcMaxClassLen,
  LPDWORD lpcValues,
  LPDWORD lpcMaxValueNameLen,
  LPDWORD lpcMaxValueLen,
  LPDWORD lpcbSecurityDescriptor,
  PFILETIME lpftLastWriteTime
);
%END REM
Declare Function RegQueryInfoKey _
Lib "advapi32.dll" _
Alias "RegQueryInfoKeyA" _
( Byval hKey As Long _
, Byval lpClass As String _
, lpcbClass As Long _
, Byval lpReserved As Long _
, lpcSubKeys As Long _
, lpcbMaxSubKeyLen As Long _
, lpcbMaxClassLen As Long _
, lpcValues As Long _
, lpcbMaxValueNameLen As Long _
, lpcbMaxValueLen As Long _
, lpcbSecurityDescriptor As Long _
, lpftLastWriteTime As FILETIME ) _
As Long

Declare Function SHDeleteKey _
Lib "shlwapi.dll" _
Alias "SHDeleteKeyA" _
( Byval hKey As Long _
, Byval pszSubKey As String ) _
As Long

'-- Constant Definitions for WIN32API
Dim regKey List As Long
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_CONFIG = &H80000005
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_PERFORMANCE_DATA = &H80000004

'Dim regError List As Long
Const ERROR_SUCCESS = 0&
Const ERROR_FILE_NOT_FOUND = 2&                  ' Registry path does not exist
Const ERROR_ACCESS_DENIED = 5&                   ' Requested permissions not available
Const ERROR_INVALID_HANDLE = 6&                  ' Invalid handle or top-level key
Const ERROR_BAD_NETPATH = 53&                    ' Network path not found
Const ERROR_INVALID_PARAMETER = 87&              ' Bad parameter to a Win32 API function
Const ERROR_CALL_NOT_IMPLEMENTED = 120&          ' Function valid only in WinNT/2000?XP
Const ERROR_INSUFFICIENT_BUFFER = 122&           ' Buffer too small to hold data
Const ERROR_BAD_PATHNAME = 161&                  ' Registry path does not exist
Const ERROR_NO_MORE_ITEMS = 259&                 ' Invalid enumerated value
Const ERROR_BADDB = 1009&                        ' Corrupted registry
Const ERROR_BADKEY = 1010&                       ' Invalid registry key
Const ERROR_CANTOPEN = 1011&                     ' Cannot open registry key
Const ERROR_CANTREAD = 1012&                     ' Cannot read from registry key
Const ERROR_CANTWRITE = 1013&                    ' Cannot write to registry key
Const ERROR_REGISTRY_RECOVERED = 1014&           ' Recovery of part of registry successful
Const ERROR_REGISTRY_CORRUPT = 1015&             ' Corrupted registry
Const ERROR_REGISTRY_IO_FAILED = 1016&           ' Input/output operation failed
Const ERROR_NOT_REGISTRY_FILE = 1017&            ' Input file not in registry file format
Const ERROR_KEY_DELETED = 1018&                  ' Key already deleted
Const ERROR_KEY_HAS_CHILDREN = 1020&             ' Key has subkeys & cannot be deleted

Const SYNCHRONIZE = &H100000

'Dim regStandard List As Long
Const STANDARD_RIGHTS_READ = &H20000
Const STANDARD_RIGHTS_WRITE = &H20000
Const STANDARD_RIGHTS_EXECUTE = &H20000
Const STANDARD_RIGHTS_REQUIRED = &HF0000
Const STANDARD_RIGHTS_ALL = &H1F0000

'Dim regAction List As Long
Const KEY_CREATE_LINK = &H20
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_QUERY_VALUE = &H1
Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Const KEY_SET_VALUE = &H2
Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
Const KEY_EXECUTE = (KEY_READ)
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))

Const REG_OPTION_BACKUP_RESTORE = 4
Const REG_OPTION_NON_VOLATILE = 0
Const REG_OPTION_VOLATILE = 1
Const REG_CREATED_NEW_KEY = &H1                  ' A new key was created
Const REG_OPENED_EXISTING_KEY = &H2              ' An existing key was opened

' Reg Data Types...
Const RRF_RT_ANY = &H0000FFFF
Const REG_NONE = 0                               ' No value type
Const REG_SZ = 1                                 ' Unicode nul terminated string
Const REG_EXPAND_SZ = 2                          ' Unicode nul terminated string
Const REG_BINARY = 3                             ' Free form binary
Const REG_DWORD = 4                              ' 32-bit number
Const REG_DWORD_LITTLE_ENDIAN = 4                ' 32-bit number (same as REG_DWORD)
Const REG_DWORD_BIG_ENDIAN = 5                   ' 32-bit number
Const REG_LINK = 6                               ' Symbolic Link (unicode)
Const REG_MULTI_SZ = 7                           ' Multiple Unicode strings

Function RegQueryValue( keyName As String, subKeyName As String, valueName As String ) As String
%INCLUDE "error_handling"

    Dim sKeyType As Long ' to return the key type
    Dim lpHKey As Long ' return handle to opened key
    Dim lpcbData As Long ' length of data in returned string

    Dim MainKey As Long
    MainKey = regKey( keyName )
    ' Open key
    If RegOpenKeyEx( MainKey, SubKeyName, 0&, KEY_READ, lpHKey ) <> ERROR_SUCCESS Then
        RegQueryValue = ""
        Exit Function ' No key open, so leave
    End If

    Dim lBuffer As Long
    lBuffer = 0
    ' Ask for buffer size for this value
    Call RegQueryValueEx( lpHKey, valueName, 0, sKeyType, 0, lBuffer )

    ' Initialize buffer
    Dim sBuffer As String
    sBuffer = Space( lBuffer ) & Chr( 0 )
    lBuffer = Len( sBuffer )
    If RegQueryValueEx( lpHKey, valueName, 0, sKeyType, sBuffer, lBuffer ) <> ERROR_SUCCESS Then
        RegQueryValue = ""   'Value probably doesn't exist
        Exit Function
    End If

    ' Trim returned buffer to extract key name
    sBuffer = Left( sBuffer, lBuffer - 1 )
    RegQueryValue = sBuffer

    ' Always close opened keys
    Call RegCloseKey( lpHKey )
End Function

Sub Initialize
%INCLUDE "error_handling"

    regKey( "HKEY_CLASSES_ROOT" ) = HKEY_CLASSES_ROOT
    regKey( "HKEY_CURRENT_CONFIG" ) = HKEY_CURRENT_CONFIG
    regKey( "HKEY_CURRENT_USER" ) = HKEY_CURRENT_USER
    regKey( "HKEY_LOCAL_MACHINE" ) = HKEY_LOCAL_MACHINE
    regKey( "HKEY_USERS" ) = HKEY_USERS
    regKey( "HKEY_PERFORMANCE_DATA" ) = HKEY_PERFORMANCE_DATA
End Sub

Sub Terminate

End Sub

Field validation formulas can quickly become very annoying for the user, because they pop up a new messagebox at each document refresh. To overcome this, you can prefix them with a line like: @If( @IsDocBeingSaved; "Continue"; @Return( @Success ) );.

A problem arises if you need a QuerySave event script for full blown validation. In fact Notes executes field validation formulas after the QuerySave event script has completed. If the QuerySave validation fails, usually you notify the user with a messagebox [1st]. After the user presses OK, Notes resumes from the field validation formulas. If one of them fails, a new messagebox [2nd] for the error will be displayed.

To overcome this redundancy, you can prefix the validation code in the QuerySave event script with a line like this: Call Source.Refresh. This will force Notes to execute field validation formulas before any other validation code. But the execution of the field validation formulas is prevented by the @IsDocBeingSaved test. So you remove it and try.

Now, if a field validation fails, Notes displays a messagebox [1st] with the message in the @Failure clause of the validation formula. After the user presses OK, Notes displays a messagebox [2nd] for the error lsERR_LSXUI_NOTES_ERROR. After the user presses OK, maybe your code displays a messagebox [3rd] with any other error. After the user presses OK, Notes executes the field validation formulas again, and the same one of them fails for the second time in a row, so a new messagebox [4th] for that error will be displayed.

To overcome this squared redundancy, you can catch the error 4412 thrown by Notes and end the execution there, by setting Continue = False and calling End afterwards. This will cause only the first messagebox to pop up and it certainly works, but having removed the @IsDocBeingSaved test, field validation formulas still pop up a new messagebox at each document refresh.

To overcome this, you can use a special item for tracking the current event down. You set the $_CurrentEvent item in the current underlying document upon entering the QuerySave event and remove it upon exiting. Finally you replace the @IsDocBeingSaved test with the following one: $_CurrentEvent = "QUERYSAVE".

This works pretty well!

Usage

Sub Querysave(Source As Notesuidocument, Continue As Variant)
%INCLUDE "error_handling_ui"

    ' 1st: execute field validation formulas
    Call Source.Refresh

    ' 2nd: validate whatever else
    Call Validate( Source ) 

    ' 3rd: do whatever else
    Call Process( Source )

    ' 4th: maybe you also need to save and reload
    Call Source.Document.Save( True, True, True )
    Call Source.Reload
End Sub

Sub Validate( Source As NotesUIDocument )
%INCLUDE "error_handling"

    'just throw any needed Error
End Sub

Sub Process( Source As NotesUIDocument )
%INCLUDE "error_handling"

    'do something here
End Sub

Call this file error_handling_ui.lss and store it in the notes folder

' $_CurrentEvent can be used for executing validation formulas only on QuerySave
    ' NOTE: there's no need for having an explicit $_CurrentEvent field on the form
    ' Field validation formulas can be prepended with something like
    '   @If( $_CurrentEvent = "QUERYSAVE"; "Continue"; @Return( @Success ) );

    Call Source.Document.ReplaceItemValue( "$_CurrentEvent", Getthreadinfo( 1 ) )
    Source.Document.GetFirstItem( "$_CurrentEvent" ).SaveToDisk = False
    On Error Goto HandleError
    Goto EnterProc

HandleError:
    If Err <> 4412 Then ' any other error than "field didn't pass validation formula"
        Msgbox Getthreadinfo( 1 ) & " : " & Erl & Chr$( 10 ) & Error$, 16, "Error " & Err
    End If
    Continue = False
    End

EnterProc:

This minimal error handling suite does very little, but it’s also very useful: any error is caught, context info is appended and the error is thrown again. To simplify and clarify all the code, the suite must be included in a LotusScript file at the very top of each Sub or Function.

Usage

Sub Initialize
%INCLUDE "error_handling"

    Dim args As Variant

    args = "RAPUTA"

    Call Outer( args )

End Sub

Call this file error_handling.lss and store it in the notes folder

'catch any error & throws it again, decorated
	On Error Goto HandleError
	Goto EnterProc  
HandleError:     
	Error Err, Getthreadinfo( 1 ) & " : " & Erl & Chr$( 10 ) & Error$ 
EnterProc: