Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Using ADO with Fujitsu NETCOBOL

Cobol Code Examples

Using ADO with Fujitsu NETCOBOL

by  fredericofonseca  Posted    (Edited  )
Two samples of how to use ADO with NETCOBOL v7 (and probably V6 and V5).

Sample 1 - uses the ADO connection object and recordset object
Opens a connection, executes a simple SQL select.
Once the recordset is available it loops through the fields collection and displays the name and type of fields.
then it loops through the Recordset records and prints each field in the record returned (only type numeric and char).
Code:
 IDENTIFICATION DIVISION.
 PROGRAM-ID. "ADODEMO".
 ENVIRONMENT DIVISION.
 CONFIGURATION SECTION.
 REPOSITORY.
     CLASS COM-EXCEPTION AS "*COM-EXCEPTION"
     CLASS COM AS "*COM".
 DATA            DIVISION.
 WORKING-STORAGE SECTION.
 01  VARIABLES.
     05  ADO-CONNECTION-TYPE   PIC X(8192) VALUE "ADODB.Connection".  
     05  ADO-RECORDSET-TYPE   PIC X(8192) VALUE "ADODB.Recordset".  
     05  ADO-COMMAND-TYPE   PIC X(8192) VALUE "ADODB.Command".  
     05  OBJ-CONNECTION  OBJECT REFERENCE COM .
     05  OBJ-RECORDSET   OBJECT REFERENCE COM.
     05  OBJ-COMMAND   OBJECT REFERENCE COM.

     05  OBJ-FIELD   OBJECT REFERENCE COM OCCURS 10.
     05  OBJ-FIELDS   OBJECT REFERENCE COM.
     05  OBJ-FIELDS-COUNT  PIC S9(9) COMP-5 VALUE 0.
     05  RECORDCOUNT  PIC S9(9) COMP-5 VALUE 0.
     05  NUMBER-FIELD PIC S9(9)V9(9)  VALUE 0.
     05  NUMBER-FIELD-EDT PIC -(10).9(9).
     05  ALPHA-FIELD PIC X(200).
     05  RETURN-ERROR   PIC 9(9) COMP-5.
     05  WLOCK PIC S9(9) COMP-5 VALUE 1.
     05  WCURSOR PIC S9(9) COMP-5 VALUE 1.
     05  WOPTION PIC S9(9) COMP-5 VALUE -1.
     05  W-INDEX            PIC 99.
     05  W-INDEX-1          PIC 99.
     05  EOF PIC S9(9) COMP-5.
     05  BOF PIC S9(9) COMP-5.

     05  FIELD-NAME                 PIC X(25).
     05  FIELD-TYPE                 PIC 9(9) OCCURS 10.

     05  ADO-STRING.
         10              PIC X(30) VALUE
      "DSN=LOCALSERVER;UID=user;".
         10              PIC X(30) VALUE
      "PWD=password;DATABASE=mydatabase;".
     05  ADO-CONNECT-STRING REDEFINES ADO-STRING PIC X(60).
     05  ADO-SQL-STRING PIC X(500).

 PROCEDURE DIVISION.
 MAIN SECTION.
     *> CREATE MAIN OBJECTS. 
     INVOKE COM "CREATE-OBJECT" 
            USING ADO-CONNECTION-TYPE
            RETURNING OBJ-CONNECTION.
     INVOKE COM "CREATE-OBJECT" 
            USING ADO-RECORDSET-TYPE
            RETURNING OBJ-RECORDSET.
     *> DEFINE AND OPEN CONNECTION
     INVOKE OBJ-CONNECTION "SET-CONNECTIONSTRING"
            USING ADO-CONNECT-STRING 
            RETURNING RETURN-ERROR.

     INVOKE OBJ-CONNECTION "OPEN" 
            RETURNING RETURN-ERROR.
     *> DEFINE SQL AND EXECUTE IT
     STRING "SELECT * FROM PAISES ORDER BY PAIS;" 
            LOW-VALUE DELIMITED BY SIZE
       INTO ADO-SQL-STRING.
     INVOKE OBJ-RECORDSET "OPEN" 
            USING ADO-SQL-STRING
                  OBJ-CONNECTION 
                  WLOCK 
                  WCURSOR 
            RETURNING RETURN-ERROR.
     *> ASSUMING THE SQL WORKED WE WILL HAVE A FIELDS COLLECTION. GET IT'S OBJECT AND THE COUNT OF ITEMS.

     INVOKE OBJ-RECORDSET "GET-FIELDS" 
            RETURNING OBJ-FIELDS.
     INVOKE OBJ-FIELDS "GET-COUNT" 
            RETURNING OBJ-FIELDS-COUNT.
     *> NOW LOAD EACH FIELD OBJECT AND IT'S TYPE.
     *> ON REAL LIFE WE CAN BYPASS THE TYPE AS WE WILL NORMALLY KNOW THAT. EXCEPTIONS ARE ON DYNAMIC SQL SOLUTIONS.
     PERFORM VARYING W-INDEX
             FROM 0 BY 1 
             UNTIL W-INDEX > (OBJ-FIELDS-COUNT - 1)
        INVOKE OBJ-FIELDS "GET-ITEM" USING W-INDEX RETURNING
OBJ-FIELD(W-INDEX + 1)
        MOVE SPACES TO FIELD-NAME
        MOVE ZEROS TO FIELD-TYPE(W-INDEX + 1)
        INVOKE OBJ-FIELD(W-INDEX + 1) "GET-NAME"
               RETURNING FIELD-NAME
        INVOKE OBJ-FIELD(W-INDEX + 1) "GET-TYPE" 
               RETURNING FIELD-TYPE(W-INDEX + 1)
        DISPLAY "FIELD N. " W-INDEX " NAME=" FIELD-NAME " FIELD TYPE="
FIELD-TYPE (W-INDEX + 1)
     END-PERFORM.

     INVOKE OBJ-RECORDSET "GET-RECORDCOUNT" RETURNING RECORDCOUNT.
    *> AS THE RECORD COUNT PROPERTY ONLY WORKS WITH CERTAIN TYPES OF
CURSORS WE RETRIEVE
    *> THE EOF/BOF VALUES ALSO TO DETERMINE IF WE HAVE RECORDS.
     INVOKE OBJ-RECORDSET "GET-EOF" RETURNING EOF.
     INVOKE OBJ-RECORDSET "GET-BOF" RETURNING BOF.


    *> NOW LOAD THE RECORDS UNTIL END OF FILE. DISPLAY ON THIS CASE.
     IF RECORDCOUNT NOT < 0
     OR (NOT BOF = 0 AND EOF = 0)
        PERFORM UNTIL EOF = 1
            INVOKE OBJ-RECORDSET "GET-EOF" RETURNING EOF
            IF EOF = 0
               PERFORM VARYING W-INDEX
                       FROM 1 BY 1
                       UNTIL W-INDEX > OBJ-FIELDS-COUNT
                     EVALUATE FIELD-TYPE(W-INDEX)
                     WHEN 131 *> Numeric
                             INVOKE OBJ-FIELD(W-INDEX) "GET-VALUE"
                                 RETURNING NUMBER-FIELD
                          MOVE NUMBER-FIELD TO NUMBER-FIELD-EDT
                          DISPLAY "FIELD " W-INDEX " VALUE = "
NUMBER-FIELD-EDT
                     WHEN 129 *> CHAR
                          INVOKE OBJ-FIELD(W-INDEX) "GET-VALUE"
                                 RETURNING ALPHA-FIELD
                          DISPLAY "FIELD " W-INDEX " VALUE = "
ALPHA-FIELD (1:50)
                     END-EVALUATE
               END-PERFORM
               INVOKE OBJ-RECORDSET "MOVENEXT" RETURNING RETURN-ERROR
            END-IF
        END-PERFORM
     END-IF.

Sample 2 - Uses the ADO connection object and command object.
Uses each object to create a new table on the Database.
Code:
 IDENTIFICATION DIVISION.
 PROGRAM-ID. "ADODEMO1".
 ENVIRONMENT DIVISION.
 CONFIGURATION SECTION.
 REPOSITORY.
     CLASS COM-EXCEPTION AS "*COM-EXCEPTION"
     CLASS COM AS "*COM".
 DATA            DIVISION.
 WORKING-STORAGE SECTION.
 01  VARIABLES.
     05  ADO-CONNECTION-TYPE   PIC X(8192) VALUE "ADODB.Connection".  
     05  ADO-COMMAND-TYPE   PIC X(8192) VALUE "ADODB.COMMAND".  
     05  OBJ-CONNECTION  OBJECT REFERENCE COM .
     05  OBJ-COMMAND   OBJECT REFERENCE COM.

     05  RETURN-ERROR   PIC 9(9) COMP-5.
     05  ZERO-RECORDS   PIC 9(9) COMP-5.
     05  ADO-SQL-CMDTEXT   PIC 9(9) COMP-5 VALUE 1.
     05  ADO-STRING.
         10              PIC X(30) VALUE
      "DSN=LOCALSERVER;UID=user;".
         10              PIC X(30) VALUE
      "PWD=password;DATABASE=mydatabase;".
     05  ADO-CONNECT-STRING REDEFINES ADO-STRING PIC X(60).
     05  ADO-SQL-STRING PIC X(500).

 PROCEDURE DIVISION.
 MAIN SECTION.
     *> CREATE MAIN OBJECTS. 
     INVOKE COM "CREATE-OBJECT" 
            USING ADO-CONNECTION-TYPE
            RETURNING OBJ-CONNECTION.
     INVOKE COM "CREATE-OBJECT" 
            USING ADO-COMMAND-TYPE
            RETURNING OBJ-COMMAND.
     *> DEFINE AND OPEN CONNECTION
     INVOKE OBJ-CONNECTION "SET-CONNECTIONSTRING"
            USING ADO-CONNECT-STRING 
            RETURNING RETURN-ERROR.

     INVOKE OBJ-CONNECTION "OPEN"
            RETURNING RETURN-ERROR.

     *> Create a table using the connection object
     STRING "CREATE TABLE DEMO2 (DEMO CHAR)" 
            LOW-VALUE DELIMITED BY SIZE
       INTO ADO-SQL-STRING.
     INVOKE OBJ-CONNECTION "EXECUTE"
            USING ADO-SQL-STRING
                  ZERO-RECORDS

     *> Create a table using the command object
     STRING "CREATE TABLE DEMO3 (DEMO CHAR)" 
            LOW-VALUE DELIMITED BY SIZE
       INTO ADO-SQL-STRING.
     INVOKE OBJ-COMMAND "SET-ACTIVECONNECTION" 
            USING OBJ-CONNECTION
     INVOKE OBJ-COMMAND "SET-COMMANDTYPE"
            USING ADO-SQL-CMDTEXT
     INVOKE OBJ-COMMAND "SET-COMMANDTEXT"
            USING ADO-SQL-STRING
     INVOKE OBJ-COMMAND "EXECUTE"
            USING ZERO-RECORDS.
Register to rate this FAQ  : BAD 1 2 3 4 5 6 7 8 9 10 GOOD
Please Note: 1 is Bad, 10 is Good :-)

Part and Inventory Search

Back
Top