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, prepares the select and insert statements again. When the user selects the Quit menu item, all pending changes are rolled back and the program is terminated.
Note: Use your system function to obtain the address.
Note: Sample Program
C
C Program: Dynamic_FRS
C Purpose: Main body of Dynamic SQL forms application. Prompt for
C database, form and table name. Call Describe_Form
C to obtain a profile of the form and set up the SQL
C statements. Then allow the user to interactively browse
C database table and append new data.
C
C
C The UNIX compiler will generate - "Warning: %LOC function
C treated as LOC". This is for compatibility with VMS.
C Just ignore the message. Or Change %LOC to LOC.
C
program Dynamic_FRS
C Declare the SQLCA and the SQLDA
exec sql include sqlca
exec sql include sqlda
record /IISQLDA/ sqlda
common /sqlda_are/ sqlda
exec sql declare sel_stmt statement
exec sql declare ins_stmt statement
exec sql declare csr cursor for sel_stmt
logical Describe_Form
exec sql begin declare section
character*40 dbname
character*40 formname
character*40 tabname
character*1000 sel_buf
character*1000 ins_buf
integer*4 err
character*1 ret
exec sql end declare section
exec frs forms
C 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
C
C Prompt for table name - later a Dynamic SQL SELECT statement
C will be built from it.
C
exec frs prompt ('Table name: ', :tabname)
C
C Prompt for form name. Check forms errors reported
C through INQUIRE_FRS.
C
exec frs prompt ('Form name: ', :formname)
exec frs message 'Loading form ...'
exec frs forminit :formname
exec frs inquire_frs frs (:err = ERRORNO)
if (err .gt. 0) then
exec frs message 'Could not load form. Exiting.'
exec frs endforms
exec sql disconnect
stop
end if
C Commit any work done so far - access of forms catalogs
exec sql commit
C Describe the form and build the SQL statement strings
if (.not. Describe_Form(formname, tabname, sel_buf, ins_buf))
1 then
exec frs message 'Could not describe form. Exiting.'
exec frs endforms
exec sql disconnect
stop
end if
C
C PREPARE the SELECT and INSERT statements that correspond to the
C menu items Browse and Insert. If the Save menu item is chosen
C the statements are reprepared.
C
exec sql prepare sel_stmt from :sel_buf
err = sqlcod
exec sql prepare ins_stmt from :ins_buf
if ((err .lt. 0) .or. (sqlcod .lt. 0)) then
exec frs message 'Could not prepare SQL statements. Exiting'
exec frs endforms
exec sql disconnect
stop
end if
C
C Display the form and interact with user, allowing browsing
C and the inserting of new data.
C
exec frs display :formname fill
exec frs initialize
exec frs activate menuitem 'Browse'
exec frs begin
C
C Retrieve data and display the first row on the form,
C allowing the user to browse through successive rows. If
C data types from the database table are not consistent
C with data descriptions obtained from the form, a
C retrieval error will occur. Inform the user of this or other
C errors.
C
C Note that the data will return sorted by the first field
C that was described, as the SELECT statement, sel_stmt,
C included an ORDER BY clause.
C
exec sql open csr
C Fetch and display each row
do while (sqlcod .eq. 0)
exec sql fetch csr using descriptor :sqlda
if (sqlcod .ne. 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 .gt. 0) then
exec sql close csr
exec frs resume
end if
C Display data before prompting user with submenu
exec frs redisplay
exec frs submenu
exec frs activate menuitem 'Next', frskey4
exec frs begin
C 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 do
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 .gt. 0) then
exec frs clear field all
exec frs resume
end if
exec sql execute ins_stmt using descriptor :sqlda
if ((sqlcod .lt. 0) .or. (sqlerr(3) .eq. 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
C
C COMMIT any changes and then re-PREPARE the SELECT and INSERT
C statements as the COMMIT statements discards them.
C
exec sql commit
exec sql prepare sel_stmt from :sel_buf
err = sqlcod
exec sql prepare ins_stmt from :ins_buf
if ((err .lt. 0) .or. (sqlcod .lt. 0)) then
exec frs prompt noecho
1 ('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
end
C
C Procedure: Describe_Form
C Purpose: Profile the specified form for name and data type
C information.
C Using the DESCRIBE FORM statement, the SQLDA is loaded
C with field information from the form. This procedure
C processes this information to allocate result storage,
C point at storage C for dynamic FRS data retrieval and
C assignment, and build C SQL statements strings for
C subsequent dynamic SELECT and INSERT statements. For
C example, assume the form (and table) 'emp' has the
C following fields:
C
C Field Name Type Nullable?
C ---------- ---- ---------
C name char(10) No
C age integer4 Yes
C salary money Yes
C
C Based on 'emp', this procedure will construct the SQLDA.
C The procedure allocates variables from a result variable
C pool (integers, floats and a large character string
C space). The SQLDATA and SQLIND fields are pointed at the
C addresses of the result variables in the pool. The
C following SQLDA is built:
C
C sqlvar(1)
C sqltype = IISQ_CHA_TYPE
C sqllen = 10
C sqldata = pointer into characters array
C sqlind = null
C sqlname = 'name'
C sqlvar(2)
C sqltype = -IISQ_INT_TYPE
C sqllen = 4
C sqldata = address of integers(2)
C sqlind = address of indicators(2)
C sqlname = 'age'
C sqlvar(3)
C sqltype = -IISQ_FLT_TYPE
C sqllen = 8
C sqldata = address of floats(3)
C sqlind = address of indicators(3)
C sqlname = 'salary'
C
C This procedure also builds two dynamic SQL statements
C strings. Note that the procedure should be extended to
C verify that the statement strings do fit into
C the statement buffers (this was not done in this example).
C The above example would construct the following
C statement strings:
C
C 'SELECT name, age, salary FROM emp ORDER BY name'
C 'INSERT INTO emp (name, age, salary) VALUES (?, ?, ?)'
C
C Parameters:
C formname - Name of form to profile.
C tabname - Name of database table.
C sel_buf - Buffer to hold SELECT statement string.
C ins_buf - Buffer to hold INSERT statement string.
C Returns:
C TRUE/FALSE - Success/failure - will fail on error
C or upon finding a table field.
C
logical function
1 Describe_Form (formname, tabname, sel_buf, ins_buf)
character*(*) formname, tabname, sel_buf, ins_buf
C Declare the SQLCA and the SQLDA
exec sql include sqlca
exec sql include sqlda
record /IISQLDA/ sqlda
common /sqlda_area/ sqlda
C Global result data storage
integer*4 integers(IISQ_MAX_COLS)
real*8 reals(IISQ_MAX_COLS)
integer*2 inds(IISQ_MAX_COLS)
character*2500 characters
common /result_area/ integers, reals, inds, characters
integer char_cnt
integer char_cur
integer i
integer base_type
logical nullable
character*1000 names
integer name_cnt
integer name_cur
character*1000 marks
integer mark_cnt
integer*4 err
character* ret
C
C Initialize the SQLDA and DESCRIBE the form. If we cannot fully
C describe the form (our SQLDA is too small) then report an error
C and return.
C
sqlda.sqln = IISQ_MAX_COLS
exec frs describe form :formname all into :sqlda
exec frs inquire_frs frs (:err = ERRORNO)
if (err .gt. 0) then
Describe_Form = .false.
return
end if
if (sqlda.sqld .gt. sqlda.sqln) then
exec frs prompt noecho ('SQLDA is too small for form :',
1 :ret)
Describe_Form = .false.
return
else if (sqlda.sqld .eq. 0) then
exec frs prompt noecho
1 ('There are no fields in the form :', :ret)
Describe_Form = .false.
return
end if
C
C For each field determine the size and type of the result data
C area. This data area will be allocated out of the result
C variable pool (integers, floats and characters) and will be
C pointed at by SQLDATA and SQLIND.
C
C If a table field type is returned then issue an error.
C
C Also, for each field add the field name to the 'names' buffer
C and the SQL place holders '?' to the 'marks' buffer, which
C will be used to build the final SELECT and INSERT statements.
C
char_cnt = 1
name_cnt = 1
mark_cnt = 1
do 20, i = 1, sqlda.sqld
C Find the base-type of the result (non-nullable).
if (sqlda.sqlvar(i).sqltype .gt. 0) then
base_type = sqlda.sqlvar(i).sqltype
nullable = .false.
else
base_type = -sqlda.sqlvar(i).sqltype
nullable = .true.
end if
C
C Collapse all different types into one of INTEGER, REAL
C or CHARACTER. Figure out where to point SQLDATA and
C SQLIND - which member of the result variable pool is
C compatible with the data.
C
if (base_type .eq. IISQ_INT_TYPE) then
sqlda.sqlvar(i).sqltype = IISQ_INT_TYPE
sqlda.sqlvar(i).sqllen = 4
sqlda.sqlvar(i).sqldata = %loc(integers(i))
else if ((base_type .eq. IISQ_FLT_TYPE) .or.
1 (base_type .eq. IISQ_DEC_TYPE) .or.
2 (base_type .eq. IISQ_MNY_TYPE)) then
sqlda.sqlvar(i).sqltype = IISQ_FLT_TYPE
sqlda.sqlvar(i).sqllen = 8
sqlda.sqlvar(i).sqldata = %loc(reals(i))
else if ((base_type .eq. IISQ_CHA_TYPE) .or.
1 (base_type .eq. IISQ_VCH_TYPE) .or.
2 (base_type .eq. IISQ_DTE_TYPE)) then
C
C Determine the length of the sub-string required from the
C the large character array. If we have enough space left
C then point at the start of the corresponding substring,
C otherwise display an error and return.
C
if (base_type .eq. IISQ_DTE_TYPE) then
char_cur = IISQ_DTE_LEN
else
char_cur = sqlda.sqlvar(i).sqllen
end if
if ((char_cnt + char_cur) .gt. len(characters))
1 then
exec frs prompt noecho
1 ('Character pool buffer overflow :', :ret)
Describe_Form = .false.
return
end if
C
C Grab space out of the large character buffer and accumulate used
C characters.
C
sqlda.sqlvar(i).sqltype = IISQ_CHA_TYPE
sqlda.sqlvar(i).sqllen = char_cur
sqlda.sqlvar(i).sqldata
1 = %loc(characters(char_cnt:))
char_cnt = char_cnt + char_cur
else if (base_type .eq. IISQ_TBL_TYPE) then
exec frs prompt noecho
1 ('Table field found in form :', :ret)
Describe_Form = .false.
return
else
exec frs prompt noecho
1 ('Invalid field type :', :ret)
Describe_Form = .false.
return
end if
C Remember to save the null indicator
if (nullable) then
sqlda.sqlvar(i).sqltype = -sqlda.sqlvar(i).sqltype
sqlda.sqlvar(i).sqlind = %loc(inds(i))
else
sqlda.sqlvar(i).sqlind = 0
end if
C
C Store field names and place holders (separated by commas)
C for the SQL statements.
C
if (i .gt. 1) then
names(name_cnt:name_cnt) = ','
name_cnt = name_cnt + 1
marks(mark_cnt:mark_cnt) = ','
mark_cnt = mark_cnt + 1
end if
name_cur = sqlda.sqlvar(i).sqlname.sqlnamel
names(name_cnt:name_cnt+name_cur) =
1 sqlda.sqlvar(i).sqlname.sqlnamec(1:name_cur)
name_cnt = name_cnt + name_cur
marks(mark_cnt:mark_cnt) = '?'
mark_cnt = mark_cnt + 1
20 continue
C
C Create final SELECT and INSERT statements. For the SELECT
C statement ORDER BY the first field.
C
name_cur = sqlda.sqlvar(1).sqlname.sqlnamel
sel_buf = 'select ' // names(1:name_cnt-1) // ' from '
1 // tabname // ' order by '
2 // sqlda.sqlvar(1).sqlname.sqlnamec(1:name_cur)
ins_buf = 'insert into ' // tabname // ' ('
1 // names(1:name_cnt-1) // ') values ('
2 // marks(1:mark_cnt-1) // ')'
Describe_Form = .true.
return
end