IDENTIFICATION DIVISION.
      *-------------------
       PROGRAM-ID. SQLEXCBL.
 
      *
      * EXECUTION D'UN ORDRE SQL RECU EN PARAMETRE.
      *  ne nessecite pas QSQL pour l'utilisation (la compil, si)
      * REFUSE TOUT ORDRE "SELECT", accepte CREATE,UPDAT,DELETE,...
      *
       ENVIRONMENT DIVISION.
      *-------------------
 
       CONFIGURATION SECTION.
       SOURCE-COMPUTER. IBM-AS400.
       OBJECT-COMPUTER. IBM-AS400.
       DATA DIVISION.
      *-------------------
       WORKING-STORAGE SECTION.
           EXEC SQL
            INCLUDE SQLCA
           END-EXEC.
 
       77 CPT PIC 99 COMP-3 VALUE ZERO.
       77 TBL PIC X(10) VALUE "QSYSTRNTBL".
       77 LIB PIC X(10) VALUE "*LIBL".
       77 LEN PIC 99999 COMP-3  VALUE 2000.
       77 ORDR2 PIC X(2000).
       LINKAGE SECTION.
       01 ORDRE PIC X(2000).
       01 SCOD  PIC S99999 COMP-3.
       01 ERLEN PIC S99999 COMP-3.
       01 ERTXT PIC X(70).
 
      *-----------------------------------------------------
       PROCEDURE DIVISION USING ORDRE SCOD ERLEN ERTXT.
      *-----------------------------------------------------
       PGM.
           MOVE ORDRE TO ORDR2.
      * convertion minuscule -> MAJUSCULE
           CALL 'QDCXLATE'  USING LEN ORDR2 TBL LIB.
      * verification pas de SELECT avant la clause WHERE.
           INSPECT ORDR2 TALLYING CPT FOR ALL "SELECT"
                   BEFORE INITIAL "WHERE".
 

           IF CPT > 0        MOVE "SELECT" TO ORDRE
              GO TO FIN.
      * remplace ' par "
           INSPECT ORDRE REPLACING ALL "'" BY QUOTES.
           EXEC SQL
            WHENEVER SQLERROR GO TO PROBLEM
           END-EXEC.
      * preparation de l'ordre SQL (si UPDATE,DELTE sans WHERE SQLWARN4 =W)
           EXEC SQL
            PREPARE P1 FROM :ORDRE
           END-EXEC.
           IF SQLWARN4 = "W" MOVE "WARNING" TO ORDRE
              GO TO FIN.
           EXEC SQL
            EXECUTE P1
           END-EXEC.
       PROBLEM.
           move SQLCODE to SCOD
           move SQLERRML to ERLEN
           move SQLERRMC to ERTXT.
       FIN.
           stop run.