isCOBOL Evolve : Appendices : Library Routines : REG : REG_OPEN_KEY, DISPLAY_REG_OPEN_KEY
REG_OPEN_KEY, DISPLAY_REG_OPEN_KEY
The REG_OPEN_KEY library routine opens the specified registry key.
To perform this action on the Windows client machine in an Application Server architecture, use DISPLAY_REG_OPEN_KEY instead of REG_OPEN_KEY.
Syntax:
 CALL "REG_OPEN_KEY" USING openKey 
                           subKey
                           resultKey
                    GIVING returnCode
Parameters:
openKey
USAGE UNSIGNED-LONG
Specifies the handle to an open registry key.
 
This handle is returned by the REG_CREATE_KEY, REG_CREATE_KEY_EX, REG_OPEN_KEY or REG_OPEN_KEY_EX library routine, or it can be one of the following predefined keys, defined in isreg.def:
 
HKEY_CLASSES_ROOT
HKEY_CURRENT_CONFIG
HKEY_CURRENT_USER
HKEY_LOCAL_MACHINE
HKEY_USERS
HKEY_DYN_DATA
subKey
PIC X(n)
Specifies the name of the registry key to be opened. This key must be a subkey of the key identified by the openKey parameter.
 
Key names are not case sensitive.
 
If this parameter is NULL or an empty string, the function returns the same handle that was passed in.
resultKey
USAGE UNSIGNED-LONG
It receives a handle to the opened key. If the key is not one of the predefined registry keys, call the REG_CLOSE_KEY library routine after you have finished using the handle.
Return code:
returnCode can be any signed numeric data item and provides additional information:
-1
Invalid or missing parameters, or not running on Windows
0
Operation successful.
Non zero
Operation failed. Click here for a list of error codes.
Examples:
Example - Open a key
working-storage section.
copy "isreg.def".
01  open-key-handle         usage unsigned-long.
01  subkey-handle           usage unsigned-long.
77  status-code             pic 9(3).
...
procedure division.
...
open-key.
   move hkey_local_machine to open-key-handle
   call "reg_open_key"  using open-key-handle
                              "SOFTWARE"
                              subkey-handle
                       giving status-code.