SSL P9.cob   Sprache: Cobol

      ***********************************************************************
      ** Licensed Materials - Property of IBM
      **
      ** Governed under the terms of the International
      ** License Agreement for Non-Warranted Sample Code.
      **
      ** (C) COPYRIGHT International Business Machines Corp. 1995 - 2002
      ** All Rights Reserved.
      **
      ** US Government Users Restricted Rights - Use, duplication or
      ** disclosure restricted by GSA ADP Schedule Contract with IBM Corp.
      ***********************************************************************
      **
      ** SOURCE FILE NAME: openftch.sqb
      **
      ** SAMPLE: How to modify table data using cursor statically
      **
      **         This sample program demonstrates the use of a CURSOR.
      **         The CURSOR is processed using static SQL.  This program
      **         obtains all managers in the STAFF tables of the SAMPLE
      **         database and changes their job from "Mgr" to "Clerk"
      **         or DELETE the row dependant upon the "dept" value.
      **         A ROLLBACK is done so that the SAMPLE database remains
      **         unchanged.
      **
      ** SQL STATEMENTS USED:
      **         BEGIN DECLARE SECTION
      **         END DECLARE SECTION
      **         ROLLBACK
      **         CONNECT
      **         DECLARE
      **         FETCH
      **         OPEN
      **         DELETE
      **         UPDATE
      **         CLOSE
      **
      ** OUTPUT FILE: openftch.out (available in the online documentation)
      ***********************************************************************
      **
      ** For more information on the sample programs, see the README file.
      **
      ** For information on developing COBOL applications, see the
      ** Application Development Guide.
      **
      ** For information on using SQL statements, see the SQL Reference.
      **
      ** For the latest information on programming, compiling, and running
      ** DB2 applications, visit the DB2 application development website:
      **     http://www.software.ibm.com/data/db2/udb/ad
      ***********************************************************************

                 EXEC SQL ROLLBACK END-EXEC.
       Program-ID. "openftch".

       Data Division.
       Working-Storage Section.

           copy "sqlca.cbl".

           EXEC SQL BEGIN DECLARE SECTION END-EXEC.
       01 pname             pic x(10).
       01 dept              pic s9(4) comp-5.
       01 userid            pic x(8).
       01 passwd.
         49 passwd-length   pic s9(4) comp-5 value 0.
         49 passwd-name     pic x(18).
           EXEC SQL END DECLARE SECTION END-EXEC.

       77 errloc          pic x(80).

       Procedure Division.
       Main Section.
           display "Sample COBOL program: OPENFTCH".

      * Get database connection information.
           display "Enter your user id (default none): "
                with no advancing.
           accept userid.

           if userid = spaces
             EXEC SQL CONNECT TO sample END-EXEC
           else
             display "Enter your password : " with no advancing
             accept           move"" to .

      * Passwords in a CONNECT statement must be entered in a VARCHAR format
      * with the length of the input string.
           inspect passwd-nameEXEC CONNECT .
              move "to

           EXEC SQL CONNECT TO       .
               END-EXEC.
           move "CONNECT TO" to errloc.
           call "checkerr" using SQLCA       Fetch-Loop Section

           EXEC SQL            SQLCODEequal
SELECTnameFROM
                    WHERE job='Mgr'
                    FOR UPDATE

           EXEC SQL OPEN c1 END-EXEC                                    
           move "OPEN" to errloc.
           call "checkerr" using SQLCA errloc.

      * call the FETCH and UPDATE/DELETE loop.
           perform Fetch-Loop thru End-Fetch-Loop
              until SQLCODE not equal 0.

           EXEC SQL CLOSE c1 END-EXEC.                                  
           move "CLOSE" to errloc.
           call "checkerr" using SQLCA errloc.

           EXEC SQL ROLLBACK END-EXEC.
           move "ROLLBACK" to errloc.
           call "checkerr" using SQLCA errloc.
           display "On second thought -- changes rolled back.".

           EXEC SQL CONNECT RESET END-EXEC.
           move "CONNECT RESET" to errloc.
           call "checkerr" using SQLCA errloc.
       End-Main.
           go to End-Prog.

       Fetch-Loop Section.
           EXEC SQL FETCH c1 INTO :pname, :dept END-EXEC.               
           if SQLCODE not equal 0
              go to End-Fetch-Loop.

           if dept greater than 40
              go to Update-Staff.

       Delete-Staff.
           display pname, " in dept. ", dept,
              " will be DELETED!".

           EXEC SQL DELETE FROM staff WHERE CURRENT OF c1 END-EXEC.
           move "DELETE" to errloc.
           call "checkerr" using SQLCA errloc.

           go to End-Fetch-Loop.

       Update-Staff.
           display pname, " in dept. ", dept,
              " will be demoted to Clerk".

           EXEC SQL UPDATE staff SET job = 'Clerk'                      
                    WHERE CURRENT OF c1 END-EXEC.
           move "UPDATE" to errloc.
           call "checkerr" using SQLCA errloc.

       End-Fetch-Loop. exit.

       End-Prog.
           stop run.