*************************************************************************
**
** Source File Name = dcscat.cbl 1.7
**
** Licensed Materials - Property of IBM
**
** (C) COPYRIGHT International Business Machines Corp. 1995, 1999
** All Rights Reserved.
**
** US Government Users Restricted Rights - Use, duplication or
** disclosure restricted by GSA ADP Schedule Contract with
**
** PURPOSE :
** This program is an example of how APIs are implemented in order to
** access DB/2. The order of the program is as follows:
** - create/catalog a DCS database
** - list a directory of DCS databases (showing what was created)
** - uncatalog the DCS database
**
** APIs USED :
** GET DCS DIRECTORY ENTRY sqlggdge()
** CATALOG DCS DIRECTORY ENTRY sqlggdad()
** OPEN DCS DIRECTORY SCAN sqlggdsc()
** GET DCS DIRECTORY ENTRIES sqlggdgt()
** CLOSE DCS DIRECTORY SCAN sqlggdcl()
** UNCATALOG DCS DIRECTORY ENTRY sqlggdel()
**
**
** For more information about these samples see the README file.
**
** For more information on programming in COBOL, see the:
** - "Programming in COBOL" section of the Application Development Guide.
**
** For more information on Building COBOL Applications, see the:
** - "Building COBOL Applications" section of the Application Building Guide.
**
** For more information on the SQL language see the SQL Reference.
**
*************************************************************************
Identification Division.
Program-Id. "dcscat".
Data Division.
Working-Storage Section.
copy "sqlenv.cbl".
copy "sqlca.cbl".
* Local Variables
77 rc pic s9(9) comp-5.
77 errloc pic x(80).
* Variables for the DCS DIRECTORY SCAN APIs
77 dbcount pic s9(4) comp-5.
77 cbl-count pic s9(4) comp-5 value 1.
77 idx pic s9(4) comp-5.
Procedure Division.
dcscat-pgm section.
display "Sample COBOL Program : dcscat.cbl".
move "this is a dcs database" to COMMENT of SQL-DIR-ENTRY.
move "dcsnm" to LDB of SQL-DIR-ENTRY.
move "targetnm" to TDB of SQL-DIR-ENTRY.
move "arName" to AR of SQL-DIR-ENTRY.
move SQL-DCS-STR-ID to
STRUCT-ID of SQL-DIR-ENTRY.
move " " to PARM of SQL-DIR-ENTRY.
display "cataloging the DCS database : ",
TDB of SQL-DIR-ENTRY.
***********************************
* CATALOG DCS DATABASE API called *
***********************************
call "sqlggdad" using
by reference sqlca
by reference SQL-DIR-ENTRY
returning rc.
move "cataloging the database" to errloc.
call "checkerr" using SQLCA errloc.
display "database ", TDB of SQL-DIR-ENTRY,
" has been catalogued".
display "now listing all databases".
perform list-dcs thru end-list-dcs.
display "now uncataloging the database that was created ",
TDB of SQL-DIR-ENTRY.
*************************************
* UNCATALOG DCS DATABASE API called *
*************************************
call "sqlggdel" using
by reference sqlca
by reference SQL-DIR-ENTRY
returning rc.
move "uncataloging the database" to errloc.
call "checkerr" using SQLCA errloc.
display "now listing all databses [after uncatalog DCS]".
perform list-dcs thru end-list-dcs.
end-dcscat. stop run.
list-dcs Section.
**************************************
* OPEN DCS DIRECTORY SCAN API called *
**************************************
call "sqlggdsc" using
by reference sqlca
by reference dbcount
returning rc.
if sqlcode equal SQLE-RC-NO-ENTRY
display "--- DCS directory is empty ---"
go to close-dcs-scan.
move "opening the database directory scan" to errloc.
call "checkerr" using SQLCA errloc.
if dbcount not equal 0 then
perform display-dcs-info thru end-display-dcs-info
varying idx from 1 by 1 until idx equal dbcount.
display-dcs-info Section.
*************************************
* GET DCS DIRECTORY SCAN API called *
*************************************
call "sqlggdgt" using
by reference sqlca
by reference cbl-count
by reference SQL-DIR-ENTRY
returning rc.
display "number of dcs databases : " , cbl-count.
display "Local Database Name :" , LDB of SQL-DIR-ENTRY.
display "Target Database Name:" , TDB of SQL-DIR-ENTRY.
display "App. Requestor Name :" , AR of SQL-DIR-ENTRY.
display "DCS parameters :" , PARM of SQL-DIR-ENTRY.
display "Comment :" , COMMENT of SQL-DIR-ENTRY.
display "DCS Release Level :" ,
RELEASE-LVL of SQL-DIR-ENTRY.
display " ".
end-display-dcs-info. exit.
move "getting dcs database entries" to errloc.
call "checkerr" using SQLCA errloc.
*********************************************
* GET DCS DIRECTORY FOR DATABASE API called *
*********************************************
* use the SQL-DIR-ENTRY from the previous call
call "sqlggdge" using
by reference sqlca
by reference SQL-DIR-ENTRY
returning rc.
close-dcs-scan.
***************************************
* CLOSE DCS DIRECTORY SCAN API called *
***************************************
call "sqlggdcl" using
by reference sqlca
returning rc.
move "closing the database directory scan" to errloc.
call "checkerr" using SQLCA errloc.
end-list-dcs. exit.