Re: Creating tables

From: Frederico Fonseca (real-email-in-msg-spam_at_email.com)
Date: 10/16/04 

Date: Sat, 16 Oct 2004 17:46:13 +0100

On Tue, 12 Oct 2004 11:56:51 +0300, "Dionisis Vrionis"
<diovr@dksoft.gr> wrote:

>I Have a database named test.mdb without tables.
>How can i create a table in a database from netcobol.
>

And to be absolutelly clear on how to use ADO

fully working 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
* 123456789 0523456789 05234567890
      "DSN=LOCALSERVER;UID=FREDERICO;".
         10 PIC X(30) VALUE
      "PWD=FREDE1;DATABASE=FACTUCLI;".
     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 NOW
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.
     

Frederico Fonseca
ema il: frederico_fonseca at syssoft-int.com