Example: ILE RPG program for deleting retained keys

Change this program example to suit your needs for deleting retained keys.

Note: Read the Code license and disclaimer information for important legal information.
     D*************************************************************
     D* DLTRTNKEY
     D*
     D* Sample program to delete a retained key
     D*
     D*
     D* COPYRIGHT 5769-SS1 (C) IBM CORP. 2000, 2000
     D*
     D* This material contains programming source code for your
     D* consideration.  These example has not been thoroughly
     D* tested under all conditions.  IBM, therefore, cannot
     D* guarantee or imply reliability, serviceability, or function
     D* of these programs.  All programs contained herein are
     D* provided to you "AS IS".  THE IMPLIED WARRANTIES OF
     D* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
     D* ARE EXPRESSLY DISCLAIMED.  IBM provides no program services for
     D* these programs and files.
     D*
     D*
     D* Note: Input format is more fully described in Chapter 2 of
     D*       IBM  CCA Basic Services Reference and Guide
     D*       (SC31-8609) publication.
     D*
     D* Parameters:
     D*   Retained key label name
     D*     (64 chacters - pad with blanks on the right)
     D*
     D* Example:
     D*
     D* CALL DLTRTNKEY +
     D* 'PKA.RETAINED.KEY.123                                             '
     D*
     D* Use these commands to compile this program on the system:
     D* CRTRPGMOD MODULE(DLTRTNKEY) SRCFILE(SAMPLE)
     D* CRTPGM  PGM(DLTRTNKEY) MODULE(DLTRTNKEY)
     D*         BNDSRVPGM(QCCA/CSNDRKD)
     D*
     D* Note: Authority to the CSNDRKD service program in the
     D*       QCCA library is assumed.
     D*
     D* The Common Cryptographic Architecture (CCA) verbs used are
     D* Retained_Key_Delete (CSNDRKD)
     D*
     D**************************************************************
     D*------------------------------------------------
     D* Declare variables for CCA SAPI calls
     D*------------------------------------------------
     D*                **  Return code
     DRETURNCODE       S              9B 0
     D*                **  Reason code
     DREASONCODE       S              9B 0
     D*                **  Exit data length
     DEXITDATALEN      S              9B 0
     D*                **  Exit data
     DEXITDATA         S              4
     D*                **  Rule array count
     DRULEARRAYCNT     S              9B 0
     D*                **  Rule array
     DRULEARRAY        S             16
     D*                **  Retained key label
     DKEYNAME          S             64
     D*
     D**********************************************************
     D* Prototype for Retained_Key_Delete (CSNDRKD)
     D**********************************************************
     DCSNDRKD          PR
     DRETCODE                         9B 0
     DRSNCODE                         9B 0
     DEXTDTALEN                       9B 0
     DEXTDTA                          4
     DRARRAYCT                        9B 0
     DRARRAY                         16
     DKEYNAM                         64
     D*
     D*-------------------------------------------------------------
     D*                **  Declares for sending messages to the
     D*                **  job log using the QMHSNDPM API
     D*-------------------------------------------------------------
     DMSG              S             75    DIM(2) CTDATA PERRCD(1)
     DMSGLENGTH        S              9B 0 INZ(75)
     D                 DS
     DMSGTEXT                  1     75
     DFAILMSGTEXT              1     50
     DFAILRETC                41     44
     DFAILRSNC                46     49
     DMESSAGEID        S              7    INZ('       ')
     DMESSAGEFILE      S             21    INZ('                     ')
     DMSGKEY           S              4    INZ('    ')
     DMSGTYPE          S             10    INZ('*INFO     ')
     DSTACKENTRY       S             10    INZ('*         ')
     DSTACKCOUNTER     S              9B 0 INZ(2)
     DERRCODE          DS
     DBYTESIN                  1      4B 0 INZ(0)
     DBYTESOUT                 5      8B 0 INZ(0)
     D*
     C**************************************************************
     C* START OF PROGRAM                                           *
     C*                                                            *
     C     *ENTRY        PLIST
     C                   PARM                    KEYNAME
     C*                                                            *
     C*------------------------------------------------------------*
     C* Set the keywords in the rule array                         *
     C*------------------------------------------------------------*
     C                   Z-ADD     0             RULEARRAYCNT
     C*------------------------------------------------------------*
     C* Call Retained Key Delete SAPI                              *
     C*------------------------------------------------------------*
     C                   CALLP     CSNDRKD       (RETURNCODE:
     C                                            REASONCODE:
     C                                            EXITDATALEN:
     C                                            EXITDATA:
     C                                            RULEARRAYCNT:
     C                                            RULEARRAY:
     C                                            KEYNAME)
     C*-----------------------*
     C* Check the return code *
     C*-----------------------*
     C     RETURNCODE    IFGT      4
     C*            *----------------------*
     C*            * Send error message   *
     C*            *----------------------*
     C                   MOVE      MSG(1)        MSGTEXT
     C                   MOVE      RETURNCODE    FAILRETC
     C                   MOVE      REASONCODE    FAILRSNC
     C                   EXSR      SNDMSG
     C*
     C                   ELSE
     C*            *----------------------*
     C*            * Send success message *
     C*            *----------------------*
     C                   MOVE      MSG(2)        MSGTEXT
     C                   EXSR      SNDMSG
     C*
     C                   ENDIF
     C*
     C                   SETON                                            LR
     C*
     C**************************************************************
     C* Subroutine to send a message
     C**************************************************************
     C     SNDMSG        BEGSR
     C                   CALL      'QMHSNDPM'
     C                   PARM                    MESSAGEID
     C                   PARM                    MESSAGEFILE
     C                   PARM                    MSGTEXT
     C                   PARM                    MSGLENGTH
     C                   PARM                    MSGTYPE
     C                   PARM                    STACKENTRY
     C                   PARM                    STACKCOUNTER
     C                   PARM                    MSGKEY
     C                   PARM                    ERRCODE
     C                   ENDSR
     C*
**
CSNDRKD failed with return/reason codes 9999/9999'
The request completed successfully