Quelle  P6.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. 1998 - 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: lobeval.sqb
      **
      ** SAMPLE: Demonstrates how to use a Large Object (LOB)
      **
      **         This sample program demonstrates the use of LOB values.
      **         The program creates a CURSOR , and fetches the contents
      **         of the "emp_resume" table (the SAMPLE database must be
      **         installed with the "db2sampl" executable), and then
      **         outputs the first 15 lines of the resume.
      **
      ** SQL STATEMENTS USED:
      **         BEGIN DECLARE SECTION
      **         END DECLARE SECTION
      **         FREE LOCATOR
      **         CONNECT
      **         SELECT
      **         DELETE
      **         VALUES
      **         INSERT
      **
      ** OUTPUT FILE: lobeval.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
      ***********************************************************************

       Identification Division.
       Program-ID. "lobeval".

       Data Division.
       Working-Storage Section.

           copy "sqlenv.cbl".
           copy "sql.cbl".
           copy "sqlca.cbl".

           EXEC SQL BEGIN DECLARE SECTION END-EXEC.                     
       01 userid            pic x(8).
       01 passwd.
         49 passwd-length   pic s9(4) comp-5 value 0.
         49 passwd-name     pic x(18).
       01 hv-start-deptinfo pic s9(9) comp-5.
       01 hv-start-educ     pic s9(9) comp-5.
       01 hv-return-code    pic s9(9) comp-5.
       01 hv-new-section-buffer USAGE IS SQL TYPE IS CLOB(5K).
       01 hv-doc-locator1   USAGE IS SQL TYPE IS CLOB-LOCATOR.
       01 hv-doc-locator2   USAGE IS SQL TYPE IS CLOB-LOCATOR.
       01 hv-doc-locator3   USAGE IS SQL TYPE IS CLOB-LOCATOR.
           EXEC SQL END DECLARE SECTION END-EXEC.

       77 errloc          pic x(80).

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

      * 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 passwd-name.

      * Passwords in a CONNECT statement must be entered in a VARCHAR
      * format with the length of the input string.
           inspect passwd-name tallying passwd-length for characters
              before initial " ".

           EXEC SQL CONNECT TO sample USER :userid USING :passwd
               END-EXEC.
           move "CONNECT TO" to errloc.
           call "checkerr" using SQLCA errloc.

      * Delete any instance of "A00130" from previous executions
           EXEC SQL DELETE FROM emp_resume
                    WHERE empno = 'A00130' END-EXEC.

      * use a single row select to get the document
           EXEC SQL SELECT resume INTO :hv-doc-locator1                 
                    FROM emp_resume
                    WHERE empno = '000130'
                    AND resume_format = 'ascii' END-EXEC.
           move "SELECT" to errloc.
           call "checkerr" using SQLCA errloc.

      * use the POSSTR function to locate the start of sections
      * "Department Information" & "Education"
           EXEC SQL VALUES (POSSTR(:hv-doc-locator1,
                    'Department Information'))
                    INTO :hv-start-deptinfo END-EXEC.                   
           move "VALUES1" to errloc.
           call "checkerr" using SQLCA errloc.

           EXEC SQL VALUES (POSSTR(:hv-doc-locator1,
                    'Education')) INTO :hv-start-educ END-EXEC.
           move "VALUES2" to errloc.
           call "checkerr" using SQLCA errloc.

      * replace Department Information section with nothing
           EXEC SQL VALUES (SUBSTR(:hv-doc-locator1, 1,
                    :hv-start-deptinfo - 1) ||
                    SUBSTR(:hv-doc-locator1, :hv-start-educ))
                    INTO :hv-doc-locator2 END-EXEC.
           move "VALUES3" to errloc.
           call "checkerr" using SQLCA errloc.

      * move Department Information section into hv-new-section-buffer
           EXEC SQL VALUES (SUBSTR(:hv-doc-locator1,
                    :hv-start-deptinfo,
                    :hv-start-educ - :hv-start-deptinfo))
                    INTO :hv-new-section-buffer END-EXEC.
           move "VALUES4" to errloc.
           call "checkerr" using SQLCA errloc.

      * Append the new section to the end (assume it has been filled)
      * Effectively, this just moves the Dept Info to the bottom of
      * the resume.
           EXEC SQL VALUES (:hv-doc-locator2 ||
                    :hv-new-section-buffer)
                    INTO :hv-doc-locator3 END-EXEC.
           move "VALUES5" to errloc.
           call "checkerr" using SQLCA errloc.

      * Store this resume in the table.
      * This is where the LOB value bytes really move.
           EXEC SQL INSERT INTO emp_resume                              
                    VALUES ('A00130', 'ascii', :hv-doc-locator3)
                    END-EXEC.
           move "INSERT" to errloc.
           call "checkerr" using SQLCA errloc.

           display "LOBEVAL completed".

           EXEC SQL FREE LOCATOR :hv-doc-locator1, :hv-doc-locator2,    
                    :hv-doc-locator3 END-EXEC.
           move "FREE LOCATOR" to errloc.
           call "checkerr" using SQLCA errloc.

           EXEC SQL CONNECT RESET END-EXEC.
           move "CONNECT RESET" to errloc.
           call "checkerr" using SQLCA errloc.

       End-Prog.
           stop run.