products/Sources/formale Sprachen/COBOL/verschiedene-Autoren/IBM image not shown  

Quellcode-Bibliothek

© Kompilation durch diese Firma

[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]

Datei:   Sprache: Cobol

Original von: verschiedene©

      ***********************************************************************
      ** 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: lobloc.sqb
      **
      ** SAMPLE: Demonstrates the use of LOB locators
      **
      **         This sample program demonstrates the use of LOB
      **         locators.  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
      **         obtains the information specified to the "Department".
      **         This  informations is then copied over to a buffer.
      **         After the whole table has been scanned, the program
      **         outputs the content of the buffer (information specific
      **         to the "department" for all the resumes in the
      **         "emp_resume" table.
      **
      ** SQL STATEMENTS USED:
      **         BEGIN DECLARE SECTION
      **         END DECLARE SECTION
      **         FREE LOCATOR
      **         CONNECT
      **         DECLARE
      **         VALUES
      **         FETCH
      **         CLOSE
      **         OPEN
      **
      ** OUTPUT FILE: lobloc.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"lobloc".

       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 empnum            pic x(6).
       01 di-begin-loc      pic s9(9) comp-5.
       01 di-end-loc        pic s9(9) comp-5.
       01 resume            USAGE IS SQL TYPE IS CLOB-LOCATOR.
       01 di-buffer         USAGE IS SQL TYPE IS CLOB-LOCATOR.
       01 lobind            pic s9(4) comp-5.
       01 buffer            USAGE IS SQL TYPE IS CLOB(1K).
           EXEC SQL END DECLARE SECTION END-EXEC.

       77 errloc          pic x(80).

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

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

      * Employee A10030 is not included in the following select, because
      * the lobeval program manipulates the record for A10030 so that it is
      * not compatible with lobloc

           EXEC SQL DECLARE c1 CURSOR FOR
                    SELECT empno, resume FROM emp_resume
                    WHERE resume_format = 'ascii'
                    AND empno <> 'A00130' END-EXEC.

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

           Move 0 to buffer-length.

           perform Fetch-Loop thru End-Fetch-Loop
              until SQLCODE not equal 0.

      * display contents of the buffer.
           display buffer-data(1:buffer-length).

           EXEC SQL FREE LOCATOR :resume, :di-buffer END-EXEC.          
           move "FREE LOCATOR" to errloc.
           call "checkerr" using SQLCA errloc.

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

           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 :empnum, :resume :lobind              
              END-EXEC.

           if SQLCODE not equal 0
              go to End-Fetch-Loop.

      * check to see if the host variable indicator returns NULL.
           if lobind less than 0 go to NULL-lob-indicated.

      * Value exists.  Evaluate the LOB locator.
      * Locate the beginning of "Department Information" section.
           EXEC SQL VALUES (POSSTR(:resume, 'Department Information'))
                    INTO :di-begin-loc END-EXEC.
           move "VALUES1" to errloc.
           call "checkerr" using SQLCA errloc.

      * Locate the beginning of "Education" section (end of Dept.Info)
           EXEC SQL VALUES (POSSTR(:resume, 'Education'))
                     INTO :di-end-loc END-EXEC.
           move "VALUES2" to errloc.
           call "checkerr" using SQLCA errloc.

           subtract di-begin-loc from di-end-loc.

      * Obtain ONLY the "Department Information" section by using SUBSTR
           EXEC SQL VALUES (SUBSTR(:resume, :di-begin-loc,
                    :di-end-loc))
                    INTO :di-buffer END-EXEC.
           move "VALUES3" to errloc.
           call "checkerr" using SQLCA errloc.

      * Append the "Department Information" section to the :buffer var
           EXEC SQL VALUES (:buffer || :di-buffer) INTO :buffer
                    END-EXEC.
           move "VALUES4" to errloc.
           call "checkerr" using SQLCA errloc.

           go to End-Fetch-Loop.

       NULL-lob-indicated.
           display "NULL LOB indicated".

       End-Fetch-Loop. exit.

       End-Prog.
                  stop run.


¤ Dauer der Verarbeitung: 0.16 Sekunden  (vorverarbeitet)  ¤





Download des
Quellennavigators
Download des
sprechenden Kalenders

in der Quellcodebibliothek suchen




Haftungshinweis

Die Informationen auf dieser Webseite wurden nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit, noch Qualität der bereit gestellten Informationen zugesichert.


Bemerkung:

Die farbliche Syntaxdarstellung ist noch experimentell.


Bot Zugriff