100        !

        ! Program: SQL_Monitor
        ! Purpose: Main entry of SQL Monitor application. Prompt
        !           for database name and connect to the database.
        !         Run the monitor and disconnect from the database.
        !         Before disconnecting roll back any pending updates.
        !

        program SQL_Monitor
            exec sql include sqlca
            exec sql begin declare section
                declare string dbname         ! Database name
                exec sql end declare section
            linput 'SQL Database'; dbname     ! Prompt for database name
            if (dbname = '') then
                exit program
            end if
            print '-- SQL Terminal Monitor --'

            exec sql whenever sqlerror stop     ! Connection errors are fatal
            exec sql connect :dbname
            call Run_Monitor
            exec sql whenever sqlerror continue
            print 'SQL: Exiting monitor program.'

            exec sql rollback
            exec sql disconnect
        end program ! SQL_Monitor
        !
        ! Subroutine:    Run_Monitor
        ! Purpose:     Run the SQL monitor. Initialize the global
        !            SQLDA with the number of SQLVAR elements. Loop
        !            while prompting the user for input and processing
        !            the SQL statement;if end-of-file is typed then
        !            return to the main program.
       !
       !            If the statement is not a SELECT statement
        !            then EXECUTE it, otherwise open a cursor a process
        !            a dynamic SELECT statement (using Execute_Select).
        !

200        sub Run_Monitor
        ! Declare the global SQLCA and the SQLDA records
        exec sql include sqlca
        exec sql include sqlda
        common (sqlda_area) IISQLDA sqlda
        exec sql begin declare section
        declare string stmt_buf         ! SQL statement input buffer
        exec sql end declare section
        declare integer stmt_num         ! SQL statement number
       declare integer rows             ! Rows affected
       external byte function Read_Stmt     ! Function to read input
       external integer function Execute_Select  ! and to execute SELECTs
        exec sql declare stmt statement         ! Dynamic SQL statement
        sqlda::sqln = IISQ_MAX_COLS ! Initialize the SQLDA
        stmt_num = 1

        !
       ! Now we are set for input. Call Read_Stmt each time through
       ! the loop. Read_Stmt prompts the user for input (into
       ! stmt_buf) and returns 0 if end-of-file was typed.
       !
       while (Read_Stmt(stmt_num, stmt_buf))

            stmt_num = stmt_num + 1
            ! SQL errors cause current statement to be aborted.
            exec sql whenever sqlerror goto Stmt_Err
            !
            ! PREPARE and DESCRIBE the statement. If the statement
            ! is not a SELECT then EXECUTE it, otherwise inspect the
            ! contents of the SQLDA and call Execute_Select.
            !

            exec sql prepare stmt from :stmt_buf
            exec sql describe stmt into :sqlda
            !
            ! If SQLD = 0 then this is not a SELECT statement. Otherwise
            ! call Execute_Select to process a dynamic cursor.
            !
            if (sqlda::sqld = 0) then
                exec sql execute stmt
                rows = sqlerrd(2)

            else
                rows = Execute_Select
            end if                 ! If SELECT or not
            exec sql whenever sqlerror continue
        Stmt_Err:
            !
            ! Only display error message if we arrived here because
            ! of the SQLERROR condition. Otherwise print the rows
            ! processed and continue with the loop.
            !
            if (sqlcode < 0) then
                call Print_Error
            else
                print '[' + str$(rows) + ' row(s)]'
            end if
        next                     ! While reading statements
    end sub ! Run_Monitor

    !
    ! Function:   Execute_Select
    ! Purpose:    Run a dynamic SELECT statement. The SQLDA has
    !             already been described. This routine calls Print_Header
    !             to print column headers and set up result storage
    !             information. A Dynamic SQL cursor is then opened, and
    !             each row is fetched and printed by Print_Row.
   !             Any error causes the cursor to be closed.
   ! Returns:    Number of rows fetched from cursor.
    !

300 function integer execute_select
    ! Declare the global SQLCA and the SQLDA records
    exec sql include sqlca
    exec sql include sqlda
    common (sqlda_area) IISQLDA sqlda
    declare integer rows                     ! Counter for rows fetched
    external byte function Print_Header      ! Function to set up header
    exec sql declare csr cursor for stmt     ! Cursor for dynamic statement
    !
    ! Print the result column names and set up the result data
    ! types and variables. Print_Header returns 0 if it fails.
    !

    if (not Print_Header) then
        Execute_Select = 0
        exit function
    end if
    exec sql whenever sqlerror goto Close_Csr
    rows = 0
    ! Open the dynamic cursor.
    exec sql open csr
    ! Fetch and print each row.
    while (sqlcode = 0)

        exec sql fetch csr using descriptor :sqlda
        if (sqlcode = 0) then
            rows = rows + 1                 ! Count the rows
            call Print_Row
        end if
    next                         ! While there are more rows
    Close_Csr:
        ! Display error message if the SQLERROR condition was set.
        if (sqlcode < 0) then
            call Print_Error
        end if
        exec sql whenever sqlerror continue
        exec sql close csr for readonly
        Execute_Select = rows
    end function ! Execute_Select
        !
        ! Function:  Print_Header
        ! Purpose:   A statement has just been described so set up
        !            the SQLDA for result processing. Print all the
        !            column names and allocate result variables for
        !            retrieving data. The result variables are chosen out
        !            of a global pool of numeric variables (integers,
       !            floats and 2-byte indicators) and a large character
        !            buffer. The SQLDATA and SQLIND fields are pointed
        !            at the addresses of the result variables.
       ! Returns:   TRUE (-1) if successfully set up the SQLDA for
        !            result variables,
        !            FALSE (0) if an error occurred.
        !

400        function byte Print_Header
            ! Declare global SQLDA record
            exec sql include sqlda
            common (sqlda_area) IISQLDA sqlda
            !
            ! Global result data storage. This area includes an array
            ! of numerics (integers, floats and indicator variables), as
            ! well as a large character buffer from which sub-strings are
            ! chosen for string retrieval.
            !
            declare word constant CHAR_MAX = 2500
            record num_store             ! Pool of numeric variables
                long     int4
                double     flt8
                word     indicator
            end record num_store
            record char_store             ! Pool of string data
                word buf_used
                string charbuf(CHAR_MAX) = 1
                end record char_store
            common (result_area) num_store nums(IISQ_MAX_COLS), &
                    char_store chars
            declare integer i              ! Index into SQLVAR
            declare integer base_type      ! Base type w/o nullability
            declare byte nullable          ! Is column nullable
            declare integer ch_len         ! Required character length
            !
            ! Verify that there are enough result variables.
            ! If not print error and return.
            !
            if (sqlda::sqld > sqlda::sqln) then
                print 'SQL Error: SQLDA requires ' +             &
                    str$(sqlda::sqld) +                 &
                    ' variables, but has only ' +             &
                    str$(sqlda::sqln) + '.'
                    Print_Header = 0             ! FALSE
                    exit function
            end if
            !
            ! For each column print the number and title. For example:
            !         [1] name [2] age [3] salary
            ! While processing each column determine the type of the
            ! column and to where SQLDATA and SQLIND must point in
            !    order to retrieve type-compatible results. Note that the
            ! index into SQLVAR begins at 0 and not 1 because the
            !    array is zero-based.
            !
            chars::buf_used = 1                  ! Nothing used yet
            for i = 0 to sqlda::sqld - 1         ! For each column
                ! Print column name and number
                print '[' + str$(i+1) + '] ' + &
                    left$(sqlda::sqlvar(i)::sqlnamec, &
                        sqlda::sqlvar(i)::sqlnamel) + ' ';

            !
            ! Process the column for type and length information. Use
            ! global result area from which variables can be allocated.
            !

            ! Find the base-type of the result (non-nullable).
            if (sqlda::sqlvar(i)::sqltype > 0) then
                base_type = sqlda::sqlvar(i)::sqltype
                nullable = 0                     ! FALSE
            else
                base_type = -sqlda::sqlvar(i)::sqltype
                nullable = -1 ! TRUE
            end if
            !
            !     Collapse all different types into one of 4-byte integer,
            ! 8-byte floating-point, or fixed length character. Figure
            ! out where to point SQLDATA and SQLIND - which member of
            ! the global result storage area will retrieve the data.
            !
            select base_type
                case IISQ_INT_TYPE             ! Use 4-byte integer
                        sqlda::sqlvar(i)::sqltype = IISQ_INT_TYPE
                        sqlda::sqlvar(i)::sqllen = 4
                        sqlda::sqlvar(i)::sqldata = loc(nums(i)::int4)

                case IISQ_FLT_TYPE, IISQ_MNY_TYPE ! Use 8-byte float
                        sqlda::sqlvar(i)::sqltype = IISQ_FLT_TYPE
                       sqlda::sqlvar(i)::sqllen = 8
                       sqlda::sqlvar(i)::sqldata = loc(nums(i)::flt8)

                case IISQ_CHA_TYPE, IISQ_VCH_TYPE, IISQ_DTE_TYPE
                !
                ! Determine the length of the sub-string required
                ! from the large character buffer. If we have enough
                ! space left then point at the start of the
                ! corresponding sub-string, otherwise print an
                !    error and return.
                !
                ! Note that for DATE types we must set the length.
                !
                if (base_type = IISQ_DTE_TYPE) then
                    ch_len = IISQ_DTE_LEN
                else
                    ch_len = sqlda::sqlvar(i)::sqllen
                end if
                if ((chars::buf_used + ch_len) > CHAR_MAX) then
                    print 'SQL Error: Character data overflow.' +    &
                        ' Need more than '          +              &
                        str$(CHAR_MAX) + ' bytes.'
                    Print_Header = 0             ! FALSE
                    exit function
                end if                 ! If too many characters
                !
                ! Grab space out of the large character buffer and
                ! keep track of the amount of space used so far.
                !
                sqlda::sqlvar(i)::sqltype = IISQ_CHA_TYPE
                sqlda::sqlvar(i)::sqllen = ch_len
                sqlda::sqlvar(i)::sqldata =                 &
                    loc(chars::charbuf(chars::buf_used))
                chars::buf_used = chars::buf_used + ch_len
            case else                         ! Bad data type
                print 'SQL Error: Unknown data type returned: ' + &
                    str$(sqlda::sqlvar(i)::sqltype)
                Print_Header = 0                 ! FALSE
                exit function
            end select                     ! Of checking types
            ! If nullable then point at a null indicator and negate type id
            if (nullable) then
                sqlda::sqlvar(i)::sqltype = -sqlda::sqlvar(i)::sqltype
                sqlda::sqlvar(i)::sqlind = loc(nums(i)::indicator)
            else
                sqlda::sqlvar(i)::sqlind = 0
            end if
        next i                     ! End of processing each column
        print ''                   ! Add separator line
        print '--------------------------------------'

        Print_header = -1             ! TRUE
    end function ! Print_Header
    !
    ! Subroutine: Print_Row
    ! Purpose:    For each element inside the SQLDA, print the value.
    !             Print its column number too in order to identify it with
    !             the column name printed earlier. If the value is NULL
    !             print 'N/A'. This routine prints the values using very
    !             basic formats and does not try to tabulate the results.
    !

500 sub Print_Row
            ! Declare global SQLDA record
            exec sql include sqlda
            common (sqlda_area) IISQLDA sqlda
            !
            ! Global result data storage. Variables from these
            !    pools were pointed at by the Print_Header routine.
            !
            declare word constant char_max = 2500
            record num_store             ! Pool of numeric variables
                long     int4
                double     flt8
                word     indicator
            end record num_store
            record char_store             ! Pool of string data
                word buf_used
                string charbuf(char_max) = 1
            end record char_store
            common (result_area) num_store nums(IISQ_MAX_COLS), &
                    char_store chars
            declare integer i              ! Index into SQLVAR
            declare integer ch             ! Index for print characters
            declare integer ch_len         ! Required character length
            !
            ! For each column, print the column number and the data. The
            ! number identifies the column with the column name
            !    printed in Print_Header. NULL columns are
            !    printed as 'N/A'.
            !
           chars::buf_used = 1               ! No characters printed yet
            for i = 0 to sqlda::sqld - 1      ! For each column
                print '[' + str$(i+1) + '] '; ! Print column number
                ! If nullable and is NULL then print 'N/A'
                if (sqlda::sqlvar(i)::sqltype > 0) and          &
                     (nums(i)::indicator = -1) then
                    print 'N/A';

                else
                    !
                    ! The type is either not nullable, or nullable
                    ! but not NULL. Print the result using very basic
                    ! output formats.
                    !
                    select abs(sqlda::sqlvar(i)::sqltype)

                    case IISQ_INT_TYPE
                        print str$(nums(i)::int4);

                    case IISQ_FLT_TYPE
                        ! This format may lose precision
                        print str$(nums(i)::flt8);

                    case IISQ_CHA_TYPE
                        !
                        ! Use a current-length sub-string from the large
                        ! character buffer, as allocated in Print_Header.
                        !
                        ch_len = sqlda::sqlvar(i)::sqllen
                        for ch = 0 to ch_len - 1
                        print chars::charbuf(chars::buf_used + ch);
                    next ch
                    chars::buf_used = chars::buf_used + ch_len
                end select             ! Of different types
        end if                     ! If null or not
            if (i < sqlda::sqld - 1) then     ! Add trailing space
                print ' ';
            end if
            next i                   ! End of each column
            print ''                 ! Print new line
        end sub                      ! Print_Row
        !
        ! Subroutine: Print_Error
        ! Purpose: SQLCA error detected. Retrieve the error message
        !          and print it.
        !

600 sub Print_Error
            exec sql include sqlca
            exec sql begin declare section
                declare string error_buf     ! For error text retrieval
            exec sql end declare section
            exec sql inquire_sql (:error_buf = errortext)
            print 'SQL Error:'
            print error_buf
        end sub                     ! Print_Error
        !
        ! Function:    Read_Stmt
        ! Purpose:     Read a statement from standard input. This
        !              routine issues a prompt with the current statement
        !              number, and reads the statement from the screen into
        !              the parameter 'stmt_buf'. No special scanning is done
        !              to look for terminators, string delimiters or line
        !              continuations.
        !
        !             This routine can be extended to allow line
        !              continuation, SQL-style comments, and a semicolon
        !              terminator.
        ! Parameters:
        !             stmt_num - Statement number for prompt.
        !             stmt_buf - Input statement buffer.
        ! Returns:
        !              TRUE (-1) - If a statement is typed in.
        !             FALSE (0) - If end-of-file is typed in,
        !              or an error occurred.
        !

700 function byte Read_Stmt(integer stmt_num, string stmt_buf)

        declare byte was_input                 ! Return value
        stmt_buf = ''
        was_input = -1                         ! TRUE
        ! Ignore empty lines and stop on error
        while (stmt_buf = '') and (was_input = -1)
            when error in
            print ' ' + str$(stmt_num);
            linput ' '; stmt_buf
            use
            was_input = 0                      ! FALSE
        end when
        next
    Read_Stmt = was_input

end function                     ! Read_Stmt