tldm-universe/Ardent/UV/BP/SQLBCIDEMO
2024-09-09 17:51:08 -04:00

469 lines
13 KiB
Plaintext
Executable File

******************************************************************************
*
* uniVerse/SQL BCI Demo Program
*
* Module %M% Version %I% Date %H%
*
* (c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
* This is unpublished proprietary source code of Ardent Software Inc.
* The copyright notice above does not evidence any actual or intended
* publication of such source code.
*
*******************************************************************************
*
* Maintenence log - insert most recent change descriptions at top
*
* Date.... GTAR# WHO Description........................................
* 10/14/98 23801 SAP Change copyrights.
* 09/11/96 18854 ENF Re-work to operate with ODBC middleware
* 06/13/95 15921 MGM fix expect state to S0002
* 05/17/95 15921 MGM Modify SQLCODEMO for uniVerse
* 12/16/93 12380 ENF Add UNIVERSE.INCLUDE
* 11/19/93 12380 ENF Fix typo and bogus PRINT statements
* 10/05/93 12380 ENF Initial programming
*
*******************************************************************************
***********************************************************************
* This is a demo program showing how to use the SQL Client BCI.
* The program does the following:
* - Gather information to log onto a data source
* - Connect to the data source
* - Create a local uniVerse table, and populate it with data
* - Drop and create the tables on the server
* - Read the uniVerse file and insert the data into the server table
* - SELECT the file from the server and display it on the screen
***********************************************************************
!
* Include the ODBC definitions
!
$INCLUDE UNIVERSE.INCLUDE ODBC.H
form = "T##########"
dash = "----------"
Expect = ""
!
* Create an ODBC environment & a connection environment. Use the
* SSQLSetConnectOption to specify the Operating system user ID and
* password.
STATUS = SQLAllocEnv(DBCENV)
IF STATUS <> SQL.SUCCESS THEN STOP "Failed to allocate an ODBC environment"
STATUS = SQLAllocConnect(DBCENV,CONENV)
IF STATUS <> SQL.SUCCESS THEN STOP "Failed to allocate a CONNECT environment"
*
* Gather the data source name, userid and password for the server O/S and
* information for the DBMS at the server. The DBMS info is often also
* a user name and password, but not in all cases.
*
PRINT "Please enter the target data source ":
INPUT SOURCE
UID=""
PWD=""
gosub testodbc
if toodbc = 0
then
PRINT "Please enter the username for the server operating system login ":
INPUT OSUID
PRINT "Please enter the operating system password for user ":OSUID:" ":
ECHO OFF
INPUT OSPWD
PRINT ""
ECHO ON
PRINT "Enter name or path of remote schema/account (hit return if local)":
INPUT UID
PWD = ""
PRINT "";PRINT ""
STATUS = SQLSetConnectOption(CONENV, SQL.OS.UID, OSUID)
STATUS = SQLSetConnectOption(CONENV, SQL.OS.PWD, OSPWD)
end
else if toodbc = 1
then
PRINT "Enter the first DBMS connection parameter: ":
input UID
PRINT "Enter the second DBMS connection parameter: ":
echo off
input PWD
echo on
PRINT "";PRINT ""
end
*
* Establish a session to the specified data source
*
PRINT "Connecting to data source: ": SOURCE
Fn = "SQLConnect"
STATUS = SQLConnect(CONENV,SOURCE,UID,PWD)
GOSUB CKCONENV
*
* We're connected. Create the local uniVerse files, and load them with
* some data
*
gosub CREATEFILES
gosub LOADFILES
*
* Now alloacate an SQL statement environment
* to be used for executing SQL statements
*
Fn = "SQLAllocStmt"
STATUS = SQLAllocStmt(CONENV,STMTENV)
GOSUB CKCONENV
*
* Now... go create the tables on the remote system
* When that is done, load the tables with the appropriate data by reading
* the records from the uniVerse files
*
gosub CREATETABLES
gosub LOADTABLES
*
* Now that we've loaded the tables, read them back and display them on the
* screen
gosub SELECTFILES
*
* Now just clean up the environment and leave
*
Fn = "SQLFreeStmt"
STATUS = SQLFreeStmt(STMTENV, SQL.DROP)
GOSUB CKSTMTENV
Fn = "SQLDisconnect"
STATUS = SQLDisconnect(CONENV)
GOSUB CKCONENV
Fn = "SQLFreeConnect"
STATUS = SQLFreeConnect(CONENV)
GOSUB CKCONENV
Fn = "SQLFreeEnv"
STATUS = SQLFreeEnv(DBCENV)
IF STATUS <> SQL.SUCCESS THEN STOP "Failed to release ODBC environment"
STOP "Exiting SQLBCIDEMO"
***********************************************************************
* Function to create a set of local uniVerse files with the data that
* we will eventually upload into a server
***********************************************************************
CREATEFILES:
CREATE.STAFF = "CREATE.FILE SQLCOSTAFF 2 1 1"
DIM DICT(8)
f = @FM
DICT(2) = "EMPNUM": f:"D":f:0:f:f:f:"10L":f:"S":f:f:"CHARACTER,10":f
DICT(3) = "EMPNAME": f:"D":f:1:f:f:f:"10L":f:"S":f:f:"CHARACTER,10":f
DICT(4) = "EMPGRADE":f:"D":f:2:f:"MD0":f:f:"10R":f:"S":f:f:"INTEGER":f
DICT(5) = "EMPCITY": f:"D":f:3:f:f:f:"15L":f:"S":f:f:"CHARACTER,15":f
DICT(6) = "@REVISE": f: "PH":f:f:f:f:f:f:f:f
DICT(7) = "@":f:"PH":f:"ID.SUP EMPNUM EMPNAME EMPGRADE EMPCITY":f:f:f:f:f:f:f
DICT(8) = "@KEY":f:"PH":f:"EMPNUM":f:f:f:f:f:f:f
*
* First let's create the table in the uniVerse account
*
OPEN "SQLCOSTAFF" TO STAFFVAR THEN
CLOSE STAFFVAR
PRINT "Deleting local SQLCOSTAFF file"
EXECUTE "DELETE.FILE SQLCOSTAFF"
PRINT ""
END
EXECUTE CREATE.STAFF
PRINT ""
*
* Now populate the dictionary with definitions that would have been put in
* with the SQL statement:
* CREATE TABLE SQLCOSTAFF (TYPE 2, MODULO 1, SEPARATION 1,
* EMPNUM CHAR(10) NOT NULL PRIMARY KEY,
* EMPNAME CHAR(10), EMPGRADE INTEGER, EMPCITY CHAR(15) );
*
OPEN "DICT", "SQLCOSTAFF" TO STAFFVAR ELSE STOP "Failed to open DICT SQLCOSTAFF"
REC = ""
FOR INDEX = 2 TO 8
ID = DICT(INDEX)<1>
FOR I = 2 TO 9
REC<I-1> = DICT(INDEX)<I>
NEXT I
WRITE REC TO STAFFVAR, ID
NEXT INDEX
CLOSE STAFFVAR
RETURN
***********************************************************************
* Function to insert our data into a local set of uniVerse tables
*
***********************************************************************
LOADFILES:
*
* Setup data to insert into uniVerse tables and data source' tables
*
DIM EMPDATA(5)
EMPDATA(1) = "E1":@FM:"Alice":@FM: 12:@FM:"Deale"
EMPDATA(2) = "E2":@FM:"Betty":@FM: 10:@FM:"Vienna"
EMPDATA(3) = "E3":@FM:"Carmen":@FM: 13:@FM:"Vienna"
EMPDATA(4) = "E4":@FM:"Don":@FM: 12:@FM:"Deale"
EMPDATA(5) = "E5":@FM:"Ed":@FM: 13:@FM:"Akron"
*
* CLear the files and then load them up
*
EXECUTE "CLEAR.FILE SQLCOSTAFF"
OPEN "SQLCOSTAFF" TO STAFFVAR ELSE STOP "Failed to open SQLCOSTAFF File"
FOR INDEX = 1 TO 5
REC = EMPDATA(INDEX)
ID = REC<1>
DREC = REC<2>:@FM:REC<3>:@FM:REC<4>
WRITE DREC TO STAFFVAR, ID
NEXT INDEX
CLOSE STAFFVAR
RETURN
**************************************************************************
* CREATETABLES
* A function that will create tables on the chosen data source
**************************************************************************
CREATETABLES:
* Create Table statement to build the test table. These are in upper case
* because uniVerse systems are often case sensitive. Because this program
* can be run using the local server on uniVerse the table name on the server
* must be different than the file name on the client.
*
CTBL1 = "CREATE TABLE TSQLCOSTAFF( EMPNUM CHAR(10) NOT NULL PRIMARY KEY, EMPNAME CHAR(10), GRADE INT, CITY CHAR(15))"
!
* Drop table statements to alwasy drop the target table before re-creating
* them.
!
DTBL1 = "DROP TABLE TSQLCOSTAFF"
!
* Now create the tables needed for testing on the host DBMS
!
PRINT "Dropping TSQLCOSTAFF table at ":SOURCE
Fn = "SQLExecDirect"; Expect = "S0002"
STATUS = SQLExecDirect(STMTENV, DTBL1)
GOSUB CKSTMTENV
Expect = ""
PRINT ""; PRINT "Creating TSQLCOSTAFF table at ":SOURCE
STATUS = SQLExecDirect(STMTENV,CTBL1)
GOSUB CKSTMTENV
RETURN
**********************************************************************
* Function to insert data into the remote table
*
**********************************************************************
LOADTABLES:
*
* Note that we are using parameter markers in the SQL statement to facilitate
* loading multiple rows of data efficiently
*
INST1 = "INSERT INTO TSQLCOSTAFF VALUES ( ?, ?, ?, ?)"
ROWNUM = 0
Fn = "SQLSetParam"
PRINT ""; PRINT "Setting values for the parameter markers"
*
* Now
STATUS = SQLSetParam(STMTENV, 1, SQL.B.BASIC, SQL.CHAR, 10, 0, EMPNUM)
GOSUB CKSTMTENV
STATUS = SQLSetParam(STMTENV, 2, SQL.B.BASIC, SQL.CHAR, 10, 0, EMPNAME)
GOSUB CKSTMTENV
STATUS = SQLSetParam(STMTENV, 3, SQL.B.BASIC, SQL.INTEGER, 0, 0, GRADE)
GOSUB CKSTMTENV
STATUS = SQLSetParam(STMTENV, 4, SQL.B.BASIC, SQL.CHAR, 15, 0, CITY)
GOSUB CKSTMTENV
PRINT ""; PRINT "Prepare the SQL statement to load TSQLCOSTAFF table"
Fn = "SQLPrepare"
STATUS = SQLPrepare(STMTENV, INST1)
GOSUB CKSTMTENV
*
* Open the local uniVerse SQLCOSTAFF table and read values from it.
* Put the values we read into the SetParam variables we indicated,
* and SQLExecute the insert statement that is now prepared.
*
OPEN "SQLCOSTAFF" TO FILEVAR ELSE STOP "Failed to open SQLCOSTAFF file"
SELECT FILEVAR
NEXTID:
ROWNUM = ROWNUM+1
READNEXT ID ELSE GOTO EOD1
READ REC FROM FILEVAR,ID ELSE STOP "Error reading local SQLCOSTAFF file"
EMPNUM = ID
EMPNAME = REC<1>
GRADE = REC<2>
CITY = REC<3>
PRINT "Loading row ":ROWNUM:" of SQLCOSTAFF"
Fn = "SQLExecute"
STATUS = SQLExecute(STMTENV)
GOSUB CKSTMTENV
GOTO NEXTID
EOD1:
CLOSE FILEVAR
ROWNUM = 0
RETURN
**********************************************************************
* Function to select the data from the remote data source
*
**********************************************************************
SELECTFILES:
!
* Select statements to retrieve data from sqlcostaff table
!
SEL01 = "SELECT EMPNUM, EMPNAME, GRADE, CITY FROM TSQLCOSTAFF"
!
* Now select the data back & list it on the terminal
!
PRINT "Execute a SELECT statement against the TSQLCOSTAFF table"
PRINT ""
!
Fn = "SQLExecDirect"
STATUS = SQLExecDirect(STMTENV,SEL01)
GOSUB CKSTMTENV
!
PRINT ""; PRINT "Bind columns to program variables"
Fn = "SQLBindCol"
STATUS = SQLBindCol(STMTENV, 1, SQL.B.CHAR, EMPNUM.RET)
GOSUB CKSTMTENV
STATUS = SQLBindCol(STMTENV, 2, SQL.B.CHAR, EMPNAME.RET)
GOSUB CKSTMTENV
STATUS = SQLBindCol(STMTENV, 3, SQL.B.NUMBER, GRADE.RET)
GOSUB CKSTMTENV
STATUS = SQLBindCol(STMTENV, 4, SQL.B.CHAR, CITY.RET)
GOSUB CKSTMTENV
!
PRINT "EMPNUM" form:"EMPNAME" form:"GRADE" form :"CITY" form
PRINT dash form:dash form:dash form :dash form
STATUS = 0
LOOP
Fn = "SQLFetch"
WHILE STATUS <> SQL.NO.DATA.FOUND DO
STATUS = SQLFetch(STMTENV)
GOSUB CKSTMTENV
IF STATUS <> SQL.NO.DATA.FOUND
THEN
PRINT EMPNUM.RET form:EMPNAME.RET form:GRADE.RET form:CITY.RET
END
REPEAT
!
STATUS = SQLFreeStmt(STMTENV, SQL.UNBIND)
GOSUB CKSTMTENV
RETURN
CKCONENV:
COUNT = -1
IF STATUS EQ -2 THEN STOP "INVALID CONNECTION HANDLE"
IF STATUS NE 0
THEN
201*
ST = SQLERROR(-1,CONENV,-1,STATE,NATCODE,ERRTXT)
IF ST <> SQL.NO.DATA.FOUND
THEN
PRINT "****************************************"
COUNT = 1
IF Expect NE 0 AND STATE = Expect AND ST <> SQL.NO.DATA.FOUND
THEN
PRINT "Allowed error of ":STATE:" returned for func ":Fn
GOTO 299
END
ELSE
PRINT "Status for ":Fn:" call is: ":STATUS
PRINT "SQLSTATE,NATCOD are:" : STATE:" ":NATCODE
PRINT "Error text is"
PRINT " " : ERRTXT
END
IF ST = SQL.SUCCESS THEN GOTO 201
END
IF STATUS = -1 AND COUNT = 1 THEN STOP "EXITING CKCONENV"
END
299*
IF STATUS <> 0 THEN PRINT "****************************************"
RETURN
CKSTMTENV:
IF STATUS EQ -2 THEN STOP "INVALID STATEMENT HANDLE"
IF STATUS EQ 100 THEN RETURN
IF STATUS NE 0
THEN
301*
ST = SQLERROR(-1,-1,STMTENV,STATE,NATCODE,ERRTXT)
IF ST <> SQL.NO.DATA.FOUND
THEN
PRINT "****************************************"
COUNT = 1
IF Expect NE 0 AND STATE = Expect AND ST <> SQL.NO.DATA.FOUND
THEN
PRINT "Allowed error of ":STATE:" returned for func ":Fn
GOTO 399
END
ELSE
PRINT "Status for ":Fn:" call is: ":STATUS
PRINT "SQLSTATE,NATCOD are:" : STATE:" ":NATCODE
PRINT "Error text is "
PRINT " " : ERRTXT
END
IF ST = 0 THEN GOTO 301
END
IF STATUS = -1 AND COUNT = 1 THEN STOP "EXITING CKSTMTENV"
END
399*
IF STATUS <> 0 THEN PRINT "****************************************"
RETURN
testodbc:
* toodbc as -1 means its localuv
toodbc = -1
print "Testing for data source connectivity...."
status = SQLConnect(CONENV,SOURCE,"(*&#%@#@","(*^^#%@&# ")
if status = SQL.SUCCESS
then
status = SQLDisconnect(CONENV)
return
end
* If the connect returns IM982, then we are on UniVerse. Else it must be
* ODBC
status = SQLError(-1,CONENV,-1,STATE,NATCODE,ERRTXT)
if STATE = "IM003" then stop "The data source DBMSTYPE is neither ODBC or UNIVERSE"
if STATE = "IM002"
then
print "Data source ":SOURCE:" is not a legal data source"
stop
end
toodbc = 0
if STATE <> "IM982" then toodbc = 1
return