IDENTIFICATION DIVISION.
PROGRAM-ID. FJREG.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 PLATFORM-SDK-CONSTANTS. *> Don't modify ANY VALUE in this group
*
* Types of registry value
*
03 REG-NONE PIC 9(09) COMP-5 VALUE 0.
03 REG-SZ PIC 9(09) COMP-5 VALUE 1.
03 REG-EXPAND-SZ PIC 9(09) COMP-5 VALUE 2.
03 REG-BINARY PIC 9(09) COMP-5 VALUE 3.
03 REG-DWORD PIC 9(09) COMP-5 VALUE 4.
03 REG-DWORD-LITTLE-ENDIAN PIC 9(09) COMP-5 VALUE 4.
03 REG-DWORD-BIG-ENDIAN PIC 9(09) COMP-5 VALUE 5.
03 REG-MULTI-SZ PIC 9(09) COMP-5 VALUE 7.
03 REG-RESOURCE-LIST PIC 9(09) COMP-5 VALUE 8.
*
* What RegCreateKeyEx did
*
03 REG-CREATED-NEW-KEY PIC 9(09) COMP-5 VALUE 1.
03 REG-OPENED-EXISTING-KEY PIC 9(09) COMP-5 VALUE 2.
*
* Options for RegCreateKeyEx
*
03 REG-OPTION-NON-VOLATILE PIC 9(09) COMP-5 VALUE 0.
03 REG-OPTION-VOLATILE PIC 9(09) COMP-5 VALUE 1.
03 REG-OPTION-BACKUP-RESTORE PIC 9(09) COMP-5 VALUE 4.
*
* Types of key access
*
03 KEY-CREATE-LINK PIC 9(09) COMP-5 VALUE 32.
03 KEY-CREATE-SUB-KEY PIC 9(09) COMP-5 VALUE 4.
03 KEY-ENUMERATE-SUB-KEYS PIC 9(09) COMP-5 VALUE 8.
03 KEY-EXECUTE PIC 9(09) COMP-5 VALUE 131097.
03 KEY-NOTIFY PIC 9(09) COMP-5 VALUE 16.
03 KEY-QUERY-VALUE PIC 9(09) COMP-5 VALUE 1.
03 KEY-SET-VALUE PIC 9(09) COMP-5 VALUE 2.
03 KEY-ALL-ACCESS PIC 9(09) COMP-5 VALUE 983103.
03 KEY-READ PIC 9(09) COMP-5 VALUE 131097.
03 KEY-WRITE PIC 9(09) COMP-5 VALUE 131078.
*
* Predefined keys, because their value is > 999999999
* the value can not be declared at once.
*
03 HKCR PIC X(04) VALUE X"00000080".
03 HKEY-CLASSES-ROOT REDEFINES HKCR
PIC 9(09) COMP-5.
03 HKCU PIC X(04) VALUE X"01000080".
03 HKEY-CURRENT-USER REDEFINES HKCU
PIC 9(09) COMP-5.
03 HKLM PIC X(04) VALUE X"02000080".
03 HKEY-LOCAL-MACHINE REDEFINES HKLM
PIC 9(09) COMP-5.
03 HKUS PIC X(04) VALUE X"03000080".
03 HKEY-USERS REDEFINES HKUS
PIC 9(09) COMP-5.
03 HKPD PIC X(04) VALUE X"04000080".
03 HKEY-PERFORMANCE-DATA REDEFINES HKPD
PIC 9(09) COMP-5.
03 HKCC PIC X(04) VALUE X"05000080".
03 HKEY-CURRENT-CONFIG REDEFINES HKCC
PIC 9(09) COMP-5.
03 HKDD PIC X(04) VALUE X"06000080".
03 HKEY-DYN-DATA REDEFINES HKDD
PIC 9(09) COMP-5.
*
* Others
*
03 ERROR-SUCCESS PIC 9(09) COMP-5 VALUE 0.
03 NULL-POINTER PIC 9(09) COMP-5 VALUE 0.
*
* This program rewrites or creates the subkey "My Value" in
* HKEY_CURRENT_USER\SOFTWARE\Fujitsu Cobol". It gets the type
* REG-SZ and the text "Made by Fujitsu COBOL"
*
01 MY-CONSTANTS.
03 REGKEY PIC X(80) VALUE "SOFTWARE\Fujitsu COBOL" & X"00".
03 REGSUB PIC X(80) VALUE "My Value" & X"00".
03 REGVAL PIC X(80) VALUE "Made by Fujitsu COBOL" & X"00".
01 MY-OTHER-FIELDS.
03 CBREGVAL PIC 9(09) COMP-5 VALUE 22.
03 KEY-HANDLE PIC 9(09) COMP-5 VALUE 0.
03 DWDISPOSITION PIC 9(09) COMP-5 VALUE 0.
03 ERROR-RETURN PIC 9(09) COMP-5 VALUE 0.
03 DISPLAYLINE.
05 FILLER PIC X(09) VALUE "Function ".
05 ROUTINE-NAME PIC X(20).
05 FILLER PIC X(17) VALUE " failed, error = ".
05 DISPLAY-ERR PIC Z(8)9.
PROCEDURE DIVISION.
MAIN SECTION.
MAIN01.
CALL "RegCreateKeyExA" WITH STDCALL LINKAGE USING
BY VALUE HKEY-CURRENT-USER
BY REFERENCE REGKEY
BY VALUE NULL-POINTER
BY VALUE NULL-POINTER
BY VALUE REG-OPTION-NON-VOLATILE
BY VALUE KEY-ALL-ACCESS
BY VALUE NULL-POINTER
BY REFERENCE KEY-HANDLE
BY REFERENCE DWDISPOSITION.
MOVE PROGRAM-STATUS TO ERROR-RETURN.
IF ERROR-RETURN NOT = ERROR-SUCCESS
MOVE "RegCreateKeyExA" TO ROUTINE-NAME
PERFORM EINDE.
IF DWDISPOSITION = REG-CREATED-NEW-KEY
DISPLAY "Key created"
ELSE
IF DWDISPOSITION = REG-OPENED-EXISTING-KEY
DISPLAY "Key opened"
ELSE
DISPLAY "Key opened, but status unknown".
CALL "RegSetValueExA" WITH STDCALL LINKAGE USING
BY VALUE KEY-HANDLE
BY REFERENCE REGSUB
BY VALUE NULL-POINTER
BY VALUE REG-SZ
BY REFERENCE REGVAL
BY VALUE CBREGVAL.
MOVE PROGRAM-STATUS TO ERROR-RETURN.
IF ERROR-RETURN NOT = ERROR-SUCCESS
MOVE "RegCreateKeyExA" TO ROUTINE-NAME.
PERFORM EINDE.
MAIN99.
EXIT.
EINDE SECTION.
EINDE01.
IF ERROR-RETURN NOT = 0
MOVE ERROR-RETURN TO DISPLAY-ERR
DISPLAY DISPLAYLINE.
IF KEY-HANDLE NOT = 0
CALL "RegCloseKey" WITH STDCALL LINKAGE USING
BY VALUE KEY-HANDLE
MOVE 0 TO KEY-HANDLE.
STOP RUN.
EINDE99.
EXIT.