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(b) 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.
Sample Application
program Dynamic_FRS;
    exec sql labeL exit_program;    { Exit on error }
    exec sql include sqlca;         { Declare the SQLCA and }
    exec sql include sqlda;         { and the SQLDA records }
    var
        sqlda: IIsqlda;             { Global SQLDA record }
    const
        MAX_NAME = 50;              { Input name size }
        MAX_STRING = 3000;          { Large string buffer size }
        MAX_STMT = 1000;            { SQL statement string size }
    {
    | Result storage pool for Dynamic SQL and FRS statements.
    | This result pool consists of arrays of 4-byte integers,
    | 8-byte floating-points, 2-byte indicators, and a large
    | string buffer from which sub-strings will be allocated.
    | Each SQLDA SQLVAR sets its SQLDATA and SQLIND address pointers
    | to variables from this pool.
    |
    | Note that the arrays are declared as volatile so that the
    | IADDRESS and ADDRESS functions can correctly point SQLDATA
    | and SQLIND at the various elements.
    }
    var
            integers: [volatile] array[1..IISQ_MAX_COLS] of Integer;
            floats: [volatile] array[1..IISQ_MAX_COLS] of Double;
            indicators: [volatile] array[1..IISQ_MAX_COLS] of Indicator;
            characters: [volatile] array[1..MAX_STRING] of Char;

    exec sql begin declare section;
        type
            Statement_Buf = varying[MAX_STMT]
                of Char;                  { Statement string }
            Input_Name = varying[MAX_NAME] of Char;     { Input name }
        var
            dbname: Input_Name;           { Database name }
            formname: Input_Name;         { Form name }
            tabname: Input_Name;          { Database table name }
            sel_buf: Statement_Buf;       { Prepared SELECT statement }
            ins_buf: Statement_Buf;       { Prepared INSERT statement }
            err: Integer;                 { Error status }
            ret: Char;                    { Prompt error buffer }
    exec sql end declare section;

    {
    | Function: Describe_Form
    | Purpose: 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 procedure processes this 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 procedure will construct the
    |         SQLDA. The procedure 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 = IISQ_CHA_TYPE
    |             sqllen = 10
    |             sqldata = pointer into characters array
    |             sqlind = null
    |             sqlname = 'name'
    |             sqlvar[2]
    |             sqltype = -IISQ_INT_TYPE
    |             sqllen = 4
    |             sqldata = address of integers[2]
    |             sqlind = address of indicators[2]
    |             sqlname = 'age'
    |             sqlvar[3]
    |             sqltype = -IISQ_FLT_TYPE
    |             sqllen = 8
    |             sqldata = address of floats[3]
    |             sqlind = address of indicators[3]
    |             sqlname = 'salary'
    |
    |         This procedure also builds two dynamic SQL statements
    |         strings. Note that the procedure 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 (?, ?, ?)'
    |
    | Parameters:
    |             formname - Name of form to profile.
    |             tabname - Name of database table.
    |             sel_buf - Buffer to hold SELECT statement string.
    |             ins_buf - Buffer to hold INSERT statement string.
    | Returns:
    |             TRUE/FALSE - Success/failure - will fail on error
    |             or upon finding a table field.
    }
    function Describe_Form (formname, tabname: Input_Name;
            var sel_buf, ins_buf: Statement_Buf): Boolean;

    var
        names: Statement_Buf;         { Names for SQL statements }
        marks: Statement_Buf;         { Place holders for INSERT }
        col: Integer;             { Index into SQLVAR }
        nullable: Boolean;         { Is nullable (SQLTYPE 0) }
        char_cnt: Integer;         { Total string length }
        char_cur: Integer;         { Current string length }
        described:Boolean;         { Return value }
    begin                     { 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.
        }
        sqlda.sqln := IISQ_MAX_COLS;
        described := TRUE;

        exec frs describe form :formname all into :sqlda;
        exec frs inquire_frs frs (:err = ERRORNO);
        if (err > 0) then begin
            described := FALSE;     { Error already displayed }
        end else if (sqlda.sqld > sqlda.sqln) then begin
            exec frs prompt noecho ('SQLDA is too small for
                    form :', :ret);
            described := FALSE;
        end else if (sqlda.sqld = 0) then begin
            exec frs prompt noecho
                    ('There are no fields in the form :', :ret);
            described := FALSE;
        end;

        {
        | For each field determine the size and type of the
        | result data area. This data area will be allocated out
        | of the result variable pool (integers, floats and
        | characters) and will be pointed at by SQLDATA and SQLIND.
        |
        | 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.
        }
        char_cnt := 1;             { No strings used yet }
        col := 1;

        while (col <= sqlda.sqld) and (described) do begin
            with sqlda.sqlvar[col] do begin
                {
                | Collapse all different types into Integers, Floats
                | or Characters.
                }
                if (sqltype < 0) then { Null indicator handled later }
                    nullable := TRUE
                else
                    nullable := FALSE;
                case (abs(sqltype)) of
                    IISQ_INT_TYPE:         { Integers }
                        begin
                            sqltype := IISQ_INT_TYPE;
                            sqllen := 4;
                            sqldata := iaddress(integers[col]);
                        end;

                    IISQ_MNY_TYPE,         { Floating-points }
                    IISQ_FLT_TYPE:
                        begin
                            sqltype := IISQ_FLT_TYPE;
                            sqllen := 8;
                            sqldata := iaddress(floats[col]);
                        end;

                    IISQ_DTE_TYPE,         { Characters }
                    IISQ_CHA_TYPE,
                    IISQ_VCH_TYPE:
                        begin
                            { First determine required length }
                            if (abs(sqltype) = IISQ_DTE_TYPE) then
                                char_cur := IISQ_DTE_LEN
                            else
                                char_cur := sqllen;

                            { Enough room in large string buffer ? }
                            if ((char_cnt + char_cur) > MAX_STRING)
                                 then begin
                                exec frs prompt noecho
                                    ('Character pool buffer
                                    overflow :', :ret);
                                    described := FALSE;
                            end else begin
                             { Point at a sub-string in buffer}
                                sqltype := IISQ_CHA_TYPE;
                                sqllen := char_cur;
                                sqldata :=iaddress
                                (characters[char_cnt]);
                                char_cnt := char_cnt + char_cur;
                            end; { If room in string }
                        end;

                    IISQ_TBL_TYPE:
                        begin
                            exec frs prompt noecho
                            ('Table field found in form :', :ret);
                                described := FALSE;
                        end;

                    otherwise
                        begin
                            exec frs prompt noecho
                            ('Invalid field type :', :ret);
                                described := FALSE;
                        end;

                end;             { Case of data types }
                { Assign pointers to null indicators and toggle type }
                if (nullable) then begin
                    sqltype := -sqltype;
                    sqlind := iaddress(indicators[col]);
                end else begin
                    sqlind := 0;
                end;

                {
                | Store field names and place holders (separated by commas)
                | for the SQL statements.
                }
                if (col = 1) then begin
                    names := sqlname;
                    marks := '?';
                end else begin
                    names := names + ',' + sqlname;
                    marks := marks + ',?';
                end;

            end;                 { With current column }
            col := col + 1;

end;                             { While processing columns }
{
| Create final SELECT and INSERT statements. For the SELECT
| statement ORDER BY the first field.
}
if (described) then begin
        sel_buf := 'SELECT ' + names + ' FROM ' + tabname
                 + ' ORDER BY ' + sqlda.sqlvar[1].sqlname;
        ins_buf := 'INSERT INTO ' + tabname + ' (' + names
                + ') VALUES (' + marks + ')';
end;

Describe_Form := described;

end;                             { Describe_Form }

{
| Program: Dynamic_FRS Main
| Purpose: Main body of Dynamic SQL forms application. Prompt for
| database, form and table name. Call 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.
}

begin { Dynamic_FRS Main }
    exec sql declare sel_stmt
             statement;             { Dynamic SQL SELECT statement }
    exec sql declare
             ins_stmt statement;    { Dynamic SQL INSERT statement }
    exec sql declare csr cursor
             for sel_stmt;          { Cursor for SELECT statement }
    exec frs forms;

    { Prompt for database name - will abort on errors }
    exec sql whenever sqlerror stop;
    exec frs prompt ('Database name: ', :dbname);
    exec sql connect :dbname;

    exec sql whenever sqlerror call sqlprint;

    {
    | Prompt for table name - later a Dynamic sql select statement
    | will be built from it.
    }
    exec frs prompt ('Table name: ', :tabname);

    {
    | Prompt for form name. Check forms errors reported
    | through inquire_frs.
    }
    exec frs prompt ('Form name: ', :formname);
    exec frs message 'Loading form ...';
    exec frs forminit :formname;
    exec frs inquire_frs frs (:err = ERRORNO);
    if (err > 0) then begin
        exec frs message 'Could not load form. Exiting.';
        exec frs endforms;
        exec sql disconnect;
        goto exit_program;
    end;

    { Commit any work done so far - access of forms catalogs }
    exec sql commit;

    { Describe the form and build the SQL statement strings }
    if (not Describe_Form(formname, tabname, sel_buf, ins_buf))
        then begin
            exec frs message 'Could not describe form. Exiting.';
            exec frs endforms;
            exec sql disconnect;
            goto exit_program;
        end;

        {
        | 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;
        err := sqlca.sqlcode;
        exec sql prepare ins_stmt from :ins_buf;
        if ((err < 0) or (sqlca.sqlcode < 0)) then begin
            exec frs message 'Could not prepare SQL statements. Exiting.';
            exec frs endforms;
            exec sql disconnect;
            goto exit_program;
        end;

        {
        | Display the form and interact with user, allowing browsing
        | and the inserting of new data.
        }
        exec frs display :formname FILL;
        exec frs initialize;
        exec frs activate menuitem 'Browse';
        exec frs begin;
            {
            | 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;

            { Fetch and display each row }
            while (sqlca.sqlcode = 0) do begin
            exec sql fetch csr using descriptor :sqlda;
            if (sqlca.sqlcode <> 0) then begin
                exec sql close csr;
                exec frs prompt noecho ('No more rows :', :ret);
                exec frs clear field all;
                exec frs resume;
            end;

            exec frs putform :formname using descriptor :sqlda;
            exec frs inquire_frs frs (:err = errorno);
            if (err > 0) then begin
                exec sql close csr;
                exec frs resume;
            end;

            { Display data before prompting user with submenu }
            exec frs redisplay;

            exec frs submenu;
            exec frs activate menuitem 'Next', FRSKEY4;
            exec frs begin;
                 { Continue with cursor loop }
                 exec frs message 'Next row ...';
                 exec frs clear field all;
            exec frs end;
            exec frs activate menuitem 'End', FRSKEY3;
            exec frs begin;
                 exec sql close csr;
                 exec frs clear field all;
                 exec frs resume;
            exec frs end;

        end;                 { While there are more rows }
exec frs end;

exec frs activate menuitem 'Insert';
exec frs begin;
    exec frs getform :formname using descriptor :sqlda;
    exec frs inquire_frs frs (:err = ERRORNO);
    if (err > 0) then begin
        exec frs clear field all;
        exec frs resume;
    end;
    exec sql execute ins_stmt using descriptor :sqlda;
    if ((sqlca.sqlcode < 0) or (sqlca.sqlerrd[3] = 0)) then begin
        exec frs prompt noecho ('No rows inserted :', :ret);
    end else begin
        exec frs prompt noecho ('One row inserted :', :ret);
    end;
exec frs end;

exec frs activate menuitem 'Save';
exec frs begin;
    {
    | COMMIT any changes and then re-PREPARE the SELECT and INSERT
    | statements as the COMMIT statements discards them.
    }
    exec sql commit;
    exec sql prepare sel_stmt from :sel_buf;
    err := sqlca.sqlcode;
    exec sql prepare ins_stmt from :ins_buf;
    if ((err < 0) or (sqlca.sqlcode < 0)) then begin
        exec frs prompt
             noecho ('Could not reprepare SQL statements :',:ret);
        exec frs breakdisplay;
    end;
exec frs end;

exec frs activate menuitem 'Clear';
exec frs begin;
    exec frs clear field all;
exec frs end;

exec frs activate menuitem 'Quit', FRSKEY2;
exec frs begin;
    exec sql rollback;
    exec frs breakdisplay;
exec frs end;
exec frs finalize;

exec frs endforms;
exec sql disconnect;

exit_program:;

exec sql end. { Dynamic_FRS Main }
Last modified date: 11/09/2022