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 }