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 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
-- Declare the SQLCA and SQLDA records
exec sql include sqlca;
exec sql include sqlda;
--
-- Program:
-- Dynamic_FRS
-- Purpose:
-- Main entry of Dynamic SQL forms application
--
procedure Dynamic_FRS is
-- Global SQLDA. Discriminant SQLN is implicitly
-- set to IISQ_MAX_COLS
sqlda: IISQLDA(IISQ_MAX_COLS);
-- String object maximums
MAX_NAME: constant := 40; -- Input name size
MAX_STRING: constant := 3000; -- Large string buffer size
MAX_STMT: constant := 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 slices will be allocated. Each
-- SQLDA SQLVAR sets its SQLDATA and SQLIND address pointers
-- to variables from this pool.
--
integers:array(1..IISQ_MAX_COLS) of Integer; -- 4-byte integer
floats: array(1..IISQ_MAX_COLS) of Long_Float; -- 8-byte float
indicators:array(1..IISQ_MAX_COLS) of Short_Integer; -- 2-byte
-- indicator
characters: String(1..MAX_STRING); -- String pool
exec sql begin declare section;
dbname: String(1..MAX_NAME); -- Database name
formname: String(1..MAX_NAME); -- Form name
tabname: String(1..MAX_NAME); -- Database table name
sel_buf: String(1..MAX_STMT); -- Prepared SELECT and
ins_buf: String(1..MAX_STMT); -- INSERT statements
err: Integer; -- Error status
ret: String(1..1); -- 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 (globals):
-- formname - (in) Name of form to profile.
-- tabname - (in) Name of database table.
-- sel_buf - (out) Buffer to hold SELECT statement string.
-- ins_buf - (out) Buffer to hold INSERT statement string.
-- Returns:
-- TRUE/FALSE - Success/failure - will fail on error
-- or upon finding a table field.
--
function Describe_Form return Boolean is
names: String(1..MAX_STMT); -- Names for SQL statements
name_cur: Integer; -- Current name length
name_cnt: Integer; -- Bytes used in 'names'
marks: String(1..MAX_STMT); -- Place holders for INSERT
mark_cnt: Integer; -- Bytes used in 'marks
nullable: Boolean; -- Is nullable (SQLTYPE < 0)
char_cnt: Integer; -- Total string length
char_cur: Integer; -- Current string length
begin -- Describe_Form
--
-- DESCRIBE the form - if we cannot fully describe the
-- form (our SQLDA is too small) then report an error and
-- return.
exec frs describe form :formname all into :sqlda;
exec frs inquire_frs frs (:err = ERRORNO);
if (err > 0) then
return FALSE; -- Error already displayed
elsif (sqlda.sqld > sqlda.sqln) then
exec frs prompt noecho
('SQLDA is too small for form :', :ret);
return FALSE;
elsif (sqlda.sqld = 0) then
exec frs prompt noecho
('There are no fields in the form :', :ret);
return FALSE;
end if;
--
-- 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
for i in 1 .. sqlda.sqld loop
declare
sqv: IISQL_VAR renames sqlda.sqlvar(i); -- Shorthand
col: Integer := Integer(i);
begin
--
-- Collapse all different types into Integers, Floats
-- or Characters.
--
if (sqv.sqltype < 0) then --Null indicator handled later
nullable := TRUE;
else
nullable := FALSE;
end if;
case (abs(sqv.sqltype)) is
-- Integers - use 4-byte integer
when IISQ_INT_TYPE =>
sqv.sqltype := IISQ_INT_TYPE;
sqv.sqllen := 4;
sqv.sqldata := integers(col)'Address;
-- Floating points - use 8-byte floats
when IISQ_MNY_TYPE | IISQ_FLT_TYPE =>
sqv.sqltype := IISQ_FLT_TYPE;
sqv.sqllen := 8;
sqv.sqldata := floats(col)'Address;
-- Character strings
when
IISQ_DTE_TYPE | IISQ_CHA_TYPE | IISQ_VCH_TYPE =>
--
-- Determine the length of the slic
-- required from the large character buffer.
-- If we have enough space left then point
-- at the start of
-- the corresponding slice, otherwise print
-- an error and return.
--
-- Note that for DATE types we must set
-- the length.
--
if (abs(sqv.sqltype) = IISQ_DTE_TYPE) then
char_cur := IISQ_DTE_LEN;
else
char_cur := Integer(sqv.sqllen);
end if;
-- Enough room in large string buffer ?
if (char_cnt + char_cur >
characters'length) then
exec frs prompt noecho
('Character pool buffer overflow :', :ret);
return FALSE;
end if;
-- Allocate slice out of buffer
sqv.sqltype = IISQ_CHA_TYPE;
sqv.sqllen = Short_Integer(char_cur);
sqv.sqldata = characters(char_cnt)'Address;
char_cnt = char_cnt + char_cur;
when IISQ_TBL_TYPE =>
exec frs prompt noecho
('Table field found in form :', :ret);
return FALSE;
when others =>
exec frs prompt noecho
('Invalid field type :', :ret);
return FALSE;
end case; -- Of data types
-- Assign pointers to null indicators and toggle type
if (nullable) then
sqv.sqltype := -sqv.sqltype;
sqv.sqlind := indicators(col)'Address;
else
sqv.sqlind := IISQ_ADR_ZERO;
end if;
--
-- Store field names and place holders (separated by
-- commas) for the SQL statements.
--
if (col = 1) then
name_cnt = 1;
mark_cnt := 1;
else
names(name_cnt) = ',';
name_cnt := name_cnt + 1;
marks(mark_cnt) = ',';
mark_cnt := mark_cnt + 1;
end if;
name_cur := Integer(sqv.sqlname.sqlnamel);
names(name_cnt..name_cnt+name_cur-1) :=
sqv.sqlname.sqlnamec(1..name_cur);
name_cnt := name_cnt + name_cur;
marks(mark_cnt) := '?';
mark_cnt := mark_cnt + 1;
end; -- Declare (renames) block
end loop; -- While processing columns
--
-- Create final SELECT and INSERT statements. For the
-- SELECT statement ORDER BY the first field.
--
sel_buf := (1..sel_buf'length => ' ');
ins_buf := (1..ins_buf'length => ' ');
name_cur := Integer(sqlda.sqlvar(1).sqlname.sqlnamel);
sel_buf(1..7 + name_cnt-1 + 6 + tabname'length +
10 + name_cur)
:= "SELECT " & names(1..name_cnt-1) &
" FROM " & tabname &
" ORDER BY " &
sqlda.sqlvar(1).sqlname.sqlnamec(1..name_cur);
ins_buf(1..12 + tabname'length + 2 + name_cnt-1 + 10 +
mark_cnt-1 + 1)
:= "INSERT INTO " & tabname & " (" &
names(1..name_cnt-1) & ") VALUES (" &
marks(1..mark_cnt-1) & ")";
return TRUE;
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
exec frs message 'Could not load form. Exiting.';
exec frs endforms;
exec sql disconnect;
return;
end if;
-- 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) then
exec frs message 'Could not describe form. Exiting.';
exec frs endforms;
exec sql disconnect;
return;
end if;
--
-- 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
exec frs message 'Could not prepare SQL statements. Exiting.';
exec frs endforms;
exec sql disconnect;
return;
end if;
--
-- 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) loop
exec sql fetch csr using descriptor :sqlda;
if (sqlca.sqlcode <= 0) then
exec sql close csr;
exec frs prompt noecho ('No more rows :', :ret);
exec frs clear field all;
exec frs resume;
end if;
exec frs putform :formname using descriptor :sqlda;
exec frs inquire_frs frs (:err = ERRORNO);
if (err > 0) then
exec sql close csr;
exec frs resume;
end if;
-- 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 loop; -- 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
exec frs clear field all;
exec frs resume;
end if;
exec sql execute ins_stmt using descriptor :sqlda;
if ((sqlca.sqlcode < 0) or (sqlca.sqlerrd(3) = 0)) then
exec frs prompt noecho ('No rows inserted :', :ret);
else
exec frs prompt noecho ('One row inserted :', :ret);
end if;
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
exec frs prompt noecho
('Could not reprepare SQL statements :', :ret);
exec frs breakdisplay;
end if;
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;
exception
when others =>
exec frs prompt noecho
('Unexpected exception encountered :', :ret);
raise;
end Dynamic_FRS;