13.1.3.1 Example COBOl Code for ExternQuerySecurity

Listing Example COBOL Code for ExternQuerySecurity

IDENTIFICATION DIVISION.
        PROGRAM-ID. "ExternQuerySecurity".
        DATA DIVISION.
        WORKING-STORAGE SECTION.
        copy "ctypes".
        01 ret-code             usage int.
        01 cvda-logmessage        pic s9(8) comp-5.
           88 LOG                 value 54.
           88 NOLOG               value 55.
        01 cvda-read              pic s9(8) comp-5.
           88 READABLE            value 35.
           88 NOTREADABLE         value 36.
        01 cvda-update            pic s9(8) comp-5.
           88 UPDATABLE           value 37.
           88 NOTUPDATABLE        value 38.
        01 cvda-control           pic s9(8) comp-5.
           88 CTRLABLE            value 56.
           88 NOTCTRLABLE         value 57.
        01 cvda-alter             pic s9(8) comp-5.
           88 ALTERABLE           value 52.
           88 NOTALTERABLE        value 53.      
        LINKAGE SECTION.
        01 LK-restype                   pic x(7).
        01 LK-restype-data-value        pic x(12).
        01 LK-resclass                  pic x(8).
        01 LK-resclass-data-value       pic x(8).
        01 LK-residlength               pic x(11).
        01 LK-residlength-data-value    pic s9(8) comp-5.
        01 LK-resid                     pic x(5).
        01 LK-resid-data-value          pic x(246).
        01 LK-logmessage                pic x(10).
        01 LK-logmessage-cvda           pic s9(8) comp-5.
        01 LK-read                      pic x(10).
        01 LK-read-cvda                 pic s9(8) comp-5.
        01 LK-update                    pic x(10).
        01 LK-update-cvda               pic s9(8) comp-5.
        01 LK-control                   pic x(10).
        01 LK-control-cvda              pic s9(8) comp-5.
        01 LK-alter                     pic x(10).
        01 LK-alter-cvda                pic s9(8) comp-5.
        01 LK-resp                      pic s9(8) comp-5.
        01 LK-resp2                     pic s9(8) comp-5.
        01 LK-userid                    pic x(8).
        PROCEDURE DIVISION USING LK-restype
                                 LK-restype-data-value
                                 LK-resclass
                                 LK-resclass-data-value
                                 LK-residlength
                                 LK-residlength-data-value
                                 LK-resid
                                 LK-resid-data-value
                                 LK-logmessage
                                 LK-logmessage-cvda
                                 LK-read
                                 LK-read-cvda
                                 LK-update
                                 LK-update-cvda
                                 LK-control
                                 LK-control-cvda
                                 LK-alter
                                 LK-alter-cvda
                                 LK-resp
                                 LK-resp2
                                 LK-userid
                                 .
*     * display "ExternQuerySecurity : LK-restype             =" LK-restype
*     * display "ExternQuerySecurity : LK-restype-data-value        ="
LK-restype-data-value
*     * display "ExternQuerySecurity : LK-resclass                  ="
LK-resclass
*     * display "ExternQuerySecurity : LK-resclass-data-value       ="
LK-resclass-data-value
*     * display "ExternQuerySecurity : LK-residlength               ="
LK-residlength
*     * display "ExternQuerySecurity : LK-residlength-data-value    ="
LK-residlength-data-value
*     * display "ExternQuerySecurity : LK-resid                     =" LK-resid
*     * display "ExternQuerySecurity : LK-resid-data-value          ="
LK-resid-data-value
*     * display "ExternQuerySecurity : LK-logmessage                ="
LK-logmessage
*     * display "ExternQuerySecurity : LK-logmessage-cvda           ="
LK-logmessage-cvda
*     * display "ExternQuerySecurity : LK-read                      =" LK-read
*     * display "ExternQuerySecurity : LK-read-cvda                 ="
LK-read-cvda
*     * display "ExternQuerySecurity : LK-update                    =" LK-update
*     * display "ExternQuerySecurity : LK-update-cvda               ="
LK-update-cvda
*     * display "ExternQuerySecurity : LK-control                    =" LK-control
*     * display "ExternQuerySecurity : LK-control-cvda               ="
LK-control-cvda
*     * display "ExternQuerySecurity : LK-alter                       =" LK-alter
*     * display "ExternQuerySecurity : LK-alter-cvda                  ="
LK-alter-cvda
*     * display "ExternQuerySecurity : LK-resp                        =" LK-resp
*     * display "ExternQuerySecurity : LK-resp2                       =" LK-resp2


        if address of LK-read not = null
            if LK-read = "READ"
              set READABLE         to true
              move cvda-read       to LK-read-cvda
        end-if
      end-if
      if address of LK-update not = null
          if LK-update = "UPDATE"
          set UPDATABLE           to true
          move cvda-update        to LK-update-cvda
      end-if
    end-if
    if address of LK-control not = null
        if LK-control = "CONTROL"
        set CTRLABLE           to true
        move cvda-control      to LK-control-cvda
      end-if
    end-if
    if address of LK-alter not = null
        if LK-alter = "ALTER"
        set ALTERABLE          to true
        move cvda-alter        to LK-alter-cvda
      end-if
    end-if

    move zero to LK-resp LK-resp2


      move zero to ret-code
* *   return code
* *   0 = OK
* *   -1 = operation failed (INVREC wil returned to the user program)

GOBACK returning ret-code.