Was this helpful?
A Dynamic SQL/Forms Database Browser
This program lets the user browse data from and insert data into any table in any database, using a dynamically defined form. The program uses Dynamic SQL and Dynamic FRS statements to process the interactive data. You should already have used VIFRED to create a Default Form based on the database table that you want to browse. VIFRED will build a form with fields that have the same names and data types as the columns of the specified database table.
When run, the program prompts the user for the name of the database, the table and the form. The form is profiled using the describe form statement, and the field name, data type and length information is processed. From this information, the program fills in the SQLDA data and null indicator areas, and builds two Dynamic SQL statement strings to select data from and insert data into the database.
The Browse menu item retrieves the data from the database using an SQL cursor associated with the dynamic select statement, and displays that data using the dynamic putform statement. A submenu allows the user to continue with the next row or return to the main menu. The Insert menu item retrieves the data from the form using the dynamic getform statement, and adds the data to the database table using a prepared insert statement. The Save menu item commits the user's changes and, because prepared statements are discarded, reprepares the select and insert statements. When the Quit menu item is selected, all pending changes are rolled back and the program is terminated.
For readability, all Embedded SQL words are in uppercase.
       IDENTIFICATION DIVISION.
       PROGRAM-ID.  DYNAMIC-FRS.
       ENVIRONMENT DIVISION.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
*      Include SQL Communications and Descriptor Areas
       EXEC SQL INCLUDE SQLCA END-EXEC.
       EXEC SQL INCLUDE SQLDA END-EXEC.
       
*      Dynamic SQL SELECT and INSERT statements (documentary only)
       EXEC SQL DECLARE sel_stmt STATEMENT END-EXEC.
       EXEC SQL DECLARE ins_stmt STATEMENT END-EXEC.
*      Cursor declaration for dynamic statement
       EXEC SQL DECLARE csr CURSOR FOR sel_stmt END-EXEC.
       EXEC SQL BEGIN DECLARE SECTION END-EXEC.
*      Database, form and table names
       01 DB-NAME        PIC X(40).
       01 FORM-NAME      PIC X(40).
       01 TABLE-NAME     PIC X(40).
*      Dynamic SQL SELECT and INSERT statement buffers
       01 SEL-BUF        PIC X(1000).
       01 INS-BUF        PIC X(1000).
*      Error status and prompt error return buffer
       01 ERR            PIC S9(8) USAGE COMP.
       01 RET            PIC X.
       EXEC SQL END DECLARE SECTION END-EXEC.
*      DESCRIBE-FORM (form profiler) return state
       01 DESCRIBED          PIC S9(4) USAGE COMP.
          88 DESCRIBE-FAIL   VALUE 0.
          88 DESCRIBE-OK     VALUE 1.
*      Index into SQLVAR table
       01 COLN               PIC S9(4) USAGE COMP.
*      Base data type of SQLVAR item without nullability
       01 BASE-TYPE          PIC S9(4) USAGE COMP.
*      Is a result column type nullable
       01 IS-NULLABLE        PIC S9(4) USAGE COMP.
          88 NOT-NULLABLE   VALUE 0.
          88 NULLABLE       VALUE 1.
*      Global result data storage.  This pool of data includes the
*      maximum number of data items needed to execute a dynamic
*      retrieval or insertion.  There is a table of 1024 integer,
*      decimal and null indicator data items, and a large
*      character string buffer from which sub-strings are
*      allocated.  Floating-point and money types are stored
*      in decimal variables.
       01 RESULT-DATA.
          02 ARRAY-STORAGE OCCURS IISQ-MAX-COLS TIMES.
              03 INTEGERS          PIC S9(9) USAGE COMP-5 SYNC.
              03 DECIMALS          PIC S9(10)V9(8) USAGE COMP-3.
              03 INDICATORS        PIC S9(4) USAGE COMP-5 SYNC.
          02 CHARS                PIC X(3000).
*      Total used length of data buffer
          02 CHAR-CNT             PIC S9(4) USAGE COMP VALUE 1.
*      Current length required from character data buffer
          02 CHAR-CUR             PIC S9(4) USAGE COMP.
*      Buffer for building Dynamic SQL statement string names
       01 NAMES                    PIC X(1000) VALUE SPACES.
       01 NAME-CNT                 PIC S9(4) USAGE COMP VALUE 1.
*      Buffer for collecting Dynamic SQL place holders
       01 MARKS                    PIC X(1000) VALUE SPACES.
       01 MARK-CNT                 PIC S9(4) USAGE COMP VALUE 1.

**
* Procedure Division: DYNAMIC-FRS
*
*     Main body of Dynamic SQL forms application.  Prompt for
*     database, form and table name.  Perform DESCRIBE-FORM
*     to obtain a profile of the form and set up the SQL
*     statements.  Then allow the user to interactively browse
*     the database table and append new data.
**
       PROCEDURE DIVISION.
       EXAMPLE SECTION.
       XBEGIN.
*      Turn on forms system
       EXEC FRS FORMS END-EXEC.
*      Prompt for database name - will abort on errors
       EXEC SQL WHENEVER SQLERROR STOP END-EXEC.
       EXEC FRS PROMPT ('Database name: ', :DB-NAME) END-EXEC.
       EXEC SQL CONNECT :DB-NAME END-EXEC.

       EXEC SQL WHENEVER SQLERROR CALL SQLPRINT END-EXEC.
*      Prompt for table name - later a Dynamic SQL SELECT
*      statement will be built from it.
       EXEC FRS PROMPT ('Table name: ', :TABLE-NAME) END-EXEC.
*      Prompt for form name.  Check forms errors through
*      INQUIRE_FRS.
       EXEC FRS PROMPT ('Form name: ', :FORM-NAME) END-EXEC.
       EXEC FRS MESSAGE 'Loading form ...' END-EXEC.
       EXEC FRS FORMINIT :FORM-NAME END-EXEC.
       EXEC FRS INQUIRE_FRS FRS (:ERR = ERRORNO) END-EXEC.
       IF (ERR > 0) THEN
            EXEC FRS MESSAGE 'Could not load form.
                   Exiting.' END-EXEC
            EXEC FRS ENDFORMS END-EXEC
            EXEC SQL DISCONNECT END-EXEC
            STOP RUN.
*      Commit any work done so far - access of forms catalogs
       EXEC SQL COMMIT END-EXEC.
*      Describe the form and build the SQL statement strings
       PERFORM DESCRIBE-FORM THROUGH END-DESCRIBE.
       IF (DESCRIBE-FAIL) THEN
           EXEC FRS MESSAGE 'Could not describe form.  Exiting.'
               END-EXEC
           EXEC FRS ENDFORMS END-EXEC
           EXEC SQL DISCONNECT END-EXEC
           STOP RUN.
*      PREPARE the SELECT and INSERT statements that correspond
*      to the menu items Browse and Insert.  If the Save menu item
*      is chosen the statements are reprepared.
       EXEC SQL PREPARE sel_stmt FROM :SEL-BUF END-EXEC.
       MOVE SQLCODE TO ERR.
       EXEC SQL PREPARE ins_stmt FROM :INS-BUF END-EXEC.
       IF (ERR < 0) OR (SQLCODE < 0) THEN
           EXEC FRS MESSAGE 
                'Could not prepare SQL statements.
                           Exiting.' END-EXEC
           EXEC FRS ENDFORMS END-EXEC
           EXEC SQL DISCONNECT END-EXEC
           STOP RUN.
*      Display the form and interact with user, allowing browsing
*      and the inserting of new data.
       EXEC FRS DISPLAY :FORM-NAME FILL END-EXEC
       EXEC FRS INITIALIZE END-EXEC
       EXEC FRS ACTIVATE MENUITEM 'Browse' END-EXEC
       EXEC FRS BEGIN END-EXEC
*      Retrieve data and display the first row on the form,
*      allowing the user to browse through successive rows.  If
*      data types from the database table are not consistent with
*      data descriptions obtained from the form, a retrieval
*      error will occur.  Inform the user of this or other errors.
*  
*      Note that the data will return sorted by the first field
*      that was described, as the SELECT statement, sel_stmt,
*      included an ORDER BY clause.
             EXEC SQL OPEN csr FOR READONLY END-EXEC.
*      Fetch and display each row
       FETCH-NEXT-ROW.
             IF (SQLCODE NOT= 0) THEN
                  GO TO END-FETCH-NEXT.
             EXEC SQL FETCH csr USING DESCRIPTOR :SQLDA END-EXEC.
             IF (SQLCODE NOT= 0) THEN
                  EXEC SQL CLOSE csr END-EXEC
                  EXEC FRS PROMPT NOECHO ('No more rows :', :RET)
                       END-EXEC
                  EXEC FRS CLEAR FIELD ALL END-EXEC
                  EXEC FRS RESUME END-EXEC.
             EXEC FRS PUTFORM :FORM-NAME USING DESCRIPTOR :SQLDA
                 END-EXEC.
             EXEC FRS INQUIRE_FRS FRS (:ERR = ERRORNO) END-EXEC.
             IF (ERR > 0) THEN
                  EXEC SQL CLOSE csr END-EXEC
                  EXEC FRS RESUME END-EXEC.
*      Display data before prompting user with submenu
             EXEC FRS REDISPLAY END-EXEC.
             EXEC FRS SUBMENU END-EXEC
             EXEC FRS ACTIVATE MENUITEM 'Next', FRSKEY4 END-EXEC
             EXEC FRS BEGIN END-EXEC
*      Continue with cursor loop
                  EXEC FRS MESSAGE 'Next row ...' END-EXEC.
                  EXEC FRS CLEAR FIELD ALL END-EXEC.
             EXEC FRS END END-EXEC
             EXEC FRS ACTIVATE MENUITEM 'End', FRSKEY3 END-EXEC
             EXEC FRS BEGIN END-EXEC
                 EXEC SQL CLOSE csr END-EXEC.
                 EXEC FRS CLEAR FIELD ALL END-EXEC.
                 EXEC FRS RESUME END-EXEC.
             EXEC FRS END END-EXEC
*      Fetch next row
             GO TO FETCH-NEXT-ROW.
*      End of row processing
       END-FETCH-NEXT.
             CONTINUE.
       EXEC FRS END END-EXEC
       EXEC FRS ACTIVATE MENUITEM 'Insert' END-EXEC
       EXEC FRS BEGIN END-EXEC
           EXEC FRS GETFORM :FORM-NAME USING DESCRIPTOR :SQLDA
                END-EXEC.
           EXEC FRS INQUIRE_FRS FRS (:ERR = ERRORNO) END-EXEC.
           IF (ERR > 0) THEN
                EXEC FRS CLEAR FIELD ALL END-EXEC
                EXEC FRS RESUME END-EXEC.
 
                EXEC SQL EXECUTE ins_stmt USING DESCRIPTOR :SQLDA
                   END-EXEC.
                IF (SQLCODE < 0) OR (SQLERRD(3) = 0) THEN
                EXEC FRS PROMPT NOECHO 
                     ('No rows inserted :', :RET) END-EXEC
           ELSE
                EXEC FRS PROMPT NOECHO
                    ('One row inserted :', :ret) END-EXEC.
        EXEC FRS END END-EXEC
        EXEC FRS ACTIVATE MENUITEM 'Save' END-EXEC
        EXEC FRS BEGIN END-EXEC
*        COMMIT any changes and then re-PREPARE the SELECT and
*        INSERT statements as the COMMIT statements discards them.
               EXEC SQL COMMIT END-EXEC.
               EXEC SQL PREPARE sel_stmt FROM :SEL-BUF END-EXEC.
               MOVE SQLCODE TO ERR.
               EXEC SQL PREPARE ins_stmt FROM :INS-BUF END-EXEC.
               IF (ERR < 0) OR (SQLCODE < 0) THEN
                   EXEC FRS PROMPT NOECHO
                        ('Could not reprepare SQL
                                    statements :', :RET)
                         END-EXEC
                   EXEC FRS BREAKDISPLAY END-EXEC.
       EXEC FRS END END-EXEC
       EXEC FRS ACTIVATE MENUITEM 'Clear' END-EXEC
       EXEC FRS BEGIN END-EXEC
               EXEC FRS CLEAR FIELD ALL END-EXEC.
       EXEC FRS END END-EXEC
       EXEC FRS ACTIVATE MENUITEM 'Quit', FRSKEY2 END-EXEC
       EXEC FRS BEGIN END-EXEC
             EXEC SQL ROLLBACK END-EXEC.
             EXEC FRS BREAKDISPLAY END-EXEC.
       EXEC FRS END END-EXEC
       EXEC FRS FINALIZE END-EXEC.
       EXEC FRS ENDFORMS END-EXEC.
       EXEC SQL DISCONNECT END-EXEC.
       STOP RUN.
**
* Paragraph: DESCRIBE-FORM
*
*      Profile the specified form for name and data type
*      information.  Using the DESCRIBE FORM statement, the SQLDA
*      is loaded with field information from the form.  This h
*      paragraph (together with the DESCRIBE-COLUMN paragraph) n
*      processes the form information to allocate result storage,
*      point at storage for dynamic FRS
*      data retrieval and assignment, and build SQL statements
*      strings for subsequent dynamic SELECT and INSERT
*      statements.  For example, assume the form (and table) 'emp'
*      has the following fields:
*                Field Name    Type     Nullable?
*                ----------    ----     ---------
*                name          char(10)  No
*                age           integer4  Yes
*                salary        money     Yes
*
*        Based on 'emp', this paragraph will construct the SQLDA.
*        The paragraph allocates variables from a result variable
*        pool (integers, floats and a large character string
*        space).  The SQLDATA and SQLIND fields are pointed at the
*        addresses of the result variables in the pool.  The
*        following SQLDA is built:
*
*                SQLVAR(1)
*                         SQLTYPE  =  CHAR TYPE
*                         SQLLEN   =  10
*                         SQLDATA  =  pointer into CHARS buffer
*                         SQLIND   =  null
*                         SQLNAME  =  'name'
*                SQLVAR(2)
*                         SQLTYPE   = - INTEGER TYPE
*                         SQLLEN    = 4
*                         SQLDATA   = address of INTEGERS(2)
*                         SQLIND    = address of INDICATORS(2)
*                         SQLNAME   = 'age'
*                SQLVAR(3)
*                         SQLTYPE   = - DECIMAL TYPE
*                         SQLLEN    = 4616 (see below)
*                         SQLDATA   = address of DECIMALS(3)
*                         SQLIND    = address of INDICATORS(3)
*                         SQLNAME   = 'salary'
*
*      This paragraph also builds two dynamic SQL statements
*      strings.
*      Note that the paragraph should be extended to verify that
*      the statement strings do fit into the statement buffers
*      (this was not done in this example).  The above example
*      would construct the following statement strings:
*
*        'SELECT name, age, salary FROM emp ORDER BY name'
*        'INSERT INTO emp (name, age, salary) VALUES (?, ?, ?)'
*
*      This paragraph sets DESCRIBE-OK if it succeeds, and
*      DESCRIBE-FAIL if there was some sort of initialization
*      error.
**
       DESCRIBE-FORM.
*      Initialize the SQLDA and DESCRIBE the form.  If we cannot
*      fully describe the form (our SQLDA is too small) then
*      report an error and return.
       SET DESCRIBE-OK TO TRUE.
       MOVE IISQ-MAX-COLS TO SQLN.
       EXEC FRS DESCRIBE FORM :FORM-NAME ALL INTO
                            :SQLDA END-EXEC.
       EXEC FRS INQUIRE_FRS FRS (:ERR = ERRORNO) END-EXEC.
       IF (ERR > 0) THEN
           SET DESCRIBE-FAIL TO TRUE
           GO TO END-DESCRIBE.
       IF (SQLD > SQLN) THEN
           EXEC FRS PROMPT NOECHO
                 ('SQLDA is too small for form :', :RET) END-EXEC
           SET DESCRIBE-FAIL TO TRUE
            GO TO END-DESCRIBE.
       IF (SQLD = 0) THEN
            EXEC FRS PROMPT NOECHO
            ('There are no fields in the form :', :RET) END-EXEC
            SET DESCRIBE-FAIL TO TRUE
            GO TO END-DESCRIBE.
*      For each field determine the size and type of the
*      result data area.   This is done by DESCRIBE-COLUMN.
*      If a table field type is returned then issue an error.
*
*      Also, for each field add the field name to the 'NAMES'
*      buffer and the SQL place holders '?' to the 'MARKS'
*      buffer, which will be used to build the final SELECT and
*      INSERT statements.
       PERFORM DESCRIBE-COLUMN
             VARYING COLN FROM 1 BY 1
             UNTIL (COLN > SQLD) OR (DESCRIBE-FAIL).
*      At this point we've processed all columns for data type
*      information.
*      Create final SELECT and INSERT statements.  For the SELECT
*      statement ORDER BY the first field.
       STRING "SELECT " NAMES(1: NAME-CNT) " FROM "
             TABLE-NAME " ORDER BY "
             SQLNAMEC(1)(1: SQLNAMEL(1))
             DELIMITED BY SIZE INTO SEL-BUF.
       STRING "INSERT INTO " TABLE-NAME "("
             NAMES(1: NAME-CNT) ") VALUES ("
             MARKS(1: MARK-CNT) ")"
             DELIMITED BY SIZE INTO INS-BUF.
       END-DESCRIBE.
             EXIT.
 
**
*      Paragraph: DESCRIBE-COLUMN
*
*      When setting up data for the SQLDA result data items are
*      chosen out of a pool of variables.  The SQLDATA and SQLIND
*      fields are pointed at the addresses of the result data
*      items and indicators as described in paragraph
*      DESCRIBE-FORM.
*
*      Field names are collected for the building of the Dynamic
*      SQL statement strings as described for paragraph
*      DESCRIBE-FORM.
*
*      Paragraph sets DESCRIBE-FAIL if it fails.
**
       DESCRIBE-COLUMN.
*      Determine the data type of the field and to where SQLDATA
*      and SQLIND must point in order to retrieve type-compatible
*      results.
*      First find the base type of the current column.
*      Normally you should clear the SQLIND pointer if it
*      is not being used using the SET TO NULL statement.  At the
*      time of this writing, however, SET pointer-item TO NULL
*      was not accepted.  The pointer will be ignored by
*      Ingres if the SQLTYPE is positive.
       IF (SQLTYPE(COLN) > 0) THEN
           MOVE SQLTYPE(COLN) TO BASE-TYPE
           SET NOT-NULLABLE TO TRUE
           SET SQLIND(COLN) TO NULL
       ELSE
           COMPUTE BASE-TYPE = 0 - SQLTYPE(COLN)
           SET NULLABLE TO TRUE
           SET SQLIND(COLN) TO ADDRESS OF INDICATORS(COLN)
       END-IF.
*      Collapse all different types into one of integer,
*      float or character.
*      Integer data uses 4-byte COMP.
       IF (BASE-TYPE = IISQ-INT-TYPE) THEN
           MOVE IISQ-INT-TYPE TO SQLTYPE(COLN)
           MOVE 4 TO SQLLEN(COLN)
           SET SQLDATA(COLN) TO ADDRESS OF INTEGERS(COLN)
*      Money and floating-point or decimal use COMP-3.
*
 
*      You must encode precision and length when setting
*      SQLLEN for a decimal data type.  Use the formula: SQLLEN =
*      (256 * p+s) where p is the Ingres precision and s 
*      is scale of the decimal host variable.DEC-DATA is defined
*      as PIC S9(10)V9(8), so p = 10+8 (Ingres precision 
*      is the total number of digits) and s= 8.  Therefore, SQLLEN
*      - (256 * 18 + 8) = 4616.
       ELSE IF (BASE-TYPE = IISQ-MNY-TYPE)
            OR (BASE-TYPE = IISQ-DEC-TYPE)
            OR (BASE-TYPE = IISQ-FLT-TYPE) THEN
              MOVE IISQ-DEC-TYPE TO SQLTYPE(COLN)
              MOVE 4616 TO SQLLEN(COLN)
              SET SQLDATA(COLN) TO ADDRESS OF DECIMALS(COLN)
*      Dates, fixed and varying-length character strings use
*      character data.
       ELSE IF (BASE-TYPE = IISQ-DTE-TYPE)
             OR (BASE-TYPE = IISQ-CHA-TYPE)
             OR (BASE-TYPE = IISQ-VCH-TYPE) THEN
 
*      Fix up the lengths of dates and determine the length of
*      the sub-string required from the large character string
*      buffer.
             IF (BASE-TYPE = IISQ-DTE-TYPE) THEN
                  MOVE IISQ-DTE-LEN TO SQLLEN(COLN)
             END-IF
 
             MOVE IISQ-CHA-TYPE TO SQLTYPE(COLN)
             MOVE SQLLEN(COLN) TO CHAR-CUR
 
*      If we do not have enough character space left display an error.
             IF ((CHAR-CNT + CHAR-CUR) > 3000) THEN
                  EXEC FRS PROMPT NOECHO
                   ('Character pool buffer overflow :', :RET) END-EXEC
                  SET DESCRIBE-FAIL TO TRUE
             ELSE
*      There is enough space so point at the start of the
*      corresponding sub-string.  Allocate space out of character
*      buffer and accumulate the currently used character space.
                SET SQLDATA(COLN) TO ADDRESS OF CHARS(CHAR-CNT:)
                ADD CHAR-CUR TO CHAR-CNT
           END-IF
*      Table fields are not allowed
       ELSE IF (BASE-TYPE = IISQ-TBL-TYPE) THEN
           EXEC FRS PROMPT NOECHO
               ('Table field found in form :', :RET) END-EXEC
           SET DESCRIBE-FAIL TO TRUE
*      Unknown data type
       ELSE
           EXEC FRS PROMPT NOECHO
                   ('Invalid field type :', :RET) END-EXEC
           SET DESCRIBE-FAIL TO TRUE
       END-IF.
*      If nullable negate the data type
       IF (NULLABLE) THEN
            COMPUTE SQLTYPE(COLN) = 0 - SQLTYPE(COLN)
       END-IF.
*      Store field names and place holders (separated by commas)
*      for the SQL statements.
       IF (COLN > 1) THEN
           MOVE "," TO NAMES(NAME-CNT:1)
           ADD 1 TO NAME-CNT
           MOVE "," TO MARKS(MARK-CNT:1)
           ADD 1 TO MARK-CNT.
       END-IF.
       MOVE SQLNAMEC(COLN)(1:SQLNAMEL(COLN)) TO
                   NAMES(NAME-CNT:SQLNAMEL(COLN)).
       ADD SQLNAMEL(COLN) TO NAME-CNT.
       MOVE "?" TO MARKS(MARK-CNT:1).
       ADD 1 TO MARK-CNT. 
 
Last modified date: 11/09/2022