isCOBOL Evolve : Appendices : Library Routines : REG : REG_DELETE_KEY, DISPLAY_REG_DELETE_KEY
REG_DELETE_KEY, DISPLAY_REG_DELETE_KEY
The REG_DELETE_KEY library routine deletes the specified registry key.
To perform this action on the Windows client machine in an Application Server architecture, use DISPLAY_REG_DELETE_KEY instead of REG_DELETE_KEY.
Syntax:
 CALL "REG_DELETE_KEY" USING openKey 
                             subKey
                      GIVING returnCode
Parameters:
openKey
USAGE UNSIGNED-LONG
Specifies the handle to an open registry key. The key must have been opened with the DELETE access right.
 
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 key to be deleted. It must be a subkey of the key that openKey identifies, but it cannot have subkeys. This parameter cannot be NULL.
 
Key names are not case sensitive.
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 - Delete a key
working-storage section.
copy "isreg.def".
01  open-key-handle         usage unsigned-long.
01  subkey-handle           usage unsigned-long.
01  subkey-to-be-created    pic x(40).
77  status-code             pic 9(3).
...
procedure division.
...
subkey-creation.
   move "iscobol-test-key" to subkey-to-be-created.
   call "reg_create_key" using open-key-handle
                               subkey-to-be-created
                               subkey-handle
                        giving status-code.
...
delete-key.
    call "reg_delete_key" using open-key-handle
                                "iscobol-test-key"
                         giving status-code.