| Programmer's Guide to the Oracle7 Server Call Interface |  Library |
 Product |
 Contents |
 Index |
| Programmer's Guide to the Oracle7 Server Call Interface | Library |
Product |
Contents |
Index |
Each of these sample programs is available online. The exact name and storage location of these progams is system dependent. Refer to your Oracle installation or user's guide for details.
This appendix contains listings for the following files:
PROGRAM FDEMO1
*---------------------------------------------------------------
* FDEMO1 is a demonstration program that adds new employee
* rows to the personnel data base. Checking
* is done to insure the integrity of the data base.
* The employee numbers are automatically selected using
* the current maximum employee number as the start.
* If any employee number is a duplicate, it is skipped.
* The program queries the user for data as follows:
*
* Enter employee name :
* Enter employee job :
* Enter employee salary:
* Enter employee dept :
*
* If just <cr> is entered for the employee name,
* the program terminates.
*
* If the row is successfully inserted, the following
* is printed:
*
* ENAME added to DNAME department as employee N.
*
* The maximum lengths of the 'ename', 'job', and 'dname'
* columns are determined by an ODESCR call.
*
* Note: VAX FORTRAN, by default, passes all CHARACTER variables
* (variables declared as CHARACTER*N) by descriptor.
* To compile this program on systems that pass character
* variables by descriptor, insert %REF() where necessary.
*---------------------------------------------------------------
IMPLICIT INTEGER (A-Z)
INTEGER*2 LDA(32)
INTEGER*2 CURS(32,2)
INTEGER*2 HDA(256)
CHARACTER*20 UID, PSW
INTEGER*4 NOBLOK
* CHARACTER string vars to hold the SQL statements
CHARACTER*60 SMAX
CHARACTER*60 SEMP
CHARACTER*150 INS
CHARACTER*60 SEL
INTEGER*4 SMAXL, SEMPL, INSL, SELL
* Program vars to be bound to SQL placeholders and
* select-list fields.
INTEGER*4 EMPNO, DEPTNO, SAL
CHARACTER*10 ENAME
CHARACTER*10 JOB
CHARACTER*14 DNAME
* Actual lengths of columns.
INTEGER*4 ENAMES, JOBS, DNAMES
* Character strings for SQL placeholders.
CHARACTER*6 ENON
CHARACTER*6 ENAN
CHARACTER*4 JOBN
CHARACTER*4 SALN
CHARACTER*7 DEPTN
* Lengths of character strings for SQL placeholders.
INTEGER*4 ENONL, ENANL, JOBNL, SALNL, DEPTNL
* Parameters for OPARSE.
INTEGER*4 NODEFP, V7FLAG
* Parameters for ODESCR.
INTEGER*2 DTYPE, PREC, SCALE, NULLOK
INTEGER*4 DSIZE, CNAMEL
CHARACTER*80 CNAME
*---------------------------------------------------------------
* Initialize variables.
*---------------------------------------------------------------
SMAX = 'SELECT NVL(MAX(EMPNO),0) FROM EMP'
SMAXL = LEN_TRIM(SMAX)
SEMP = 'SELECT ENAME,JOB FROM EMP'
SEMPL= LEN_TRIM(SEMP)
INS = 'INSERT INTO EMP(EMPNO,ENAME,JOB,SAL,
+ DEPTNO) VALUES (:EMPNO,:ENAME,:JOB,:SAL,:DEPTNO)'
INSL = LEN_TRIM(INS)
SEL = 'SELECT DNAME FROM DEPT WHERE DEPTNO = :1'
SELL = LEN_TRIM(SEL)
* All in Deferred Mode
NODEFP = 1
V7FLAG = 2
ENAMEL = 10
JOBL = 10
EMPNOL = 4
DEPTL = 4
SALL = 4
ENON = ':EMPNO'
ENAN = ':ENAME'
JOBN = ':JOB'
SALN = ':SAL'
DEPTN = ':DEPTNO'
ENONL = 6
ENANL = 6
JOBNL = 4
SALNL = 4
DEPTNL = 7
*---------------------------------------------------------------
* Connect to ORACLE in non-blocking mode.
* HDA must be initialized to all zeros before call to OLOG.
*---------------------------------------------------------------
UID = 'SCOTT'
PSW = 'TIGER'
NOBLOK = 0
DATA HDA/256*0/
CALL OLOG(LDA, HDA, UID, LEN_TRIM(UID),
+ PSW, LEN_TRIM(PSW), 0, -1, NOBLOK)
IF (LDA(7).NE.0) THEN
CALL ERRRPT(LDA(1), LDA(1))
GO TO 900
END IF
WRITE (*, '(1X, A, A20)') 'Logged on to ORACLE as user ',
+ UID
*---------------------------------------------------------------
* Open two cursors for the personnel data base.
*---------------------------------------------------------------
CALL OOPEN(CURS(1,1), LDA, 0, -1, -1, 0, -1)
IF (CURS(1,1).NE.0) THEN
CALL ERRRPT(LDA(1), CURS(1,1))
GO TO 700
END IF
CALL OOPEN(CURS(1,2),LDA(1),0, -1, -1, 0, -1)
IF (CURS(1,2).NE.0) THEN
CALL ERRRPT(LDA(1), CURS(1,2))
GO TO 700
END IF
*---------------------------------------------------------------
* Turn off auto-commit. Note: the default is off,
* so this could be omitted.
*---------------------------------------------------------------
CALL OCOF(LDA(1))
IF (LDA(1).NE.0) THEN
CALL ERRRPT(LDA(1), LDA(1))
GO TO 700
END IF
*---------------------------------------------------------------
* Retrieve the current maximum employee number.
*----------------------------------------------------------------
* Parse the SQL statement.
CALL OPARSE(CURS(1,1), SMAX, SMAXL, NODEFP, V7FLAG)
IF (CURS(1,1).NE.0) THEN
CALL ERRRPT(LDA(1), CURS(1,1))
GO TO 700
END IF
* Define a buffer to receive the MAX(EMPNO) from ORACLE.
CALL ODEFIN(CURS(1,1), 1, EMPNO, 4, 3, -1, 0, 0,
+ -1, -1, 0, 0)
IF (CURS(1,1).NE.0) THEN
CALL ERRRPT(LDA(1), CURS(1,1))
GO TO 700
END IF
* Execute the SQL statement.
CALL OEXEC(CURS(1,1))
IF (CURS(1,1).NE.0) THEN
CALL ERRRPT(LDA(1), CURS(1,1))
GO TO 700
END IF
* Fetch the data from ORACLE into the defined buffer.
CALL OFETCH(CURS(1,1))
IF (CURS(1,1).EQ.0) GO TO 50
IF (CURS(7,1).NE.1403) THEN
CALL ERRRPT(LDA(1), CURS(1,1))
GO TO 700
END IF
* A cursor return code of 1403 means that no row
* satisfied the query, so generate the first empno.
EMPNO=10
50 CONTINUE
*---------------------------------------------------------------
* Determine the max length of the employee name and job title.
* Parse the SQL statement - it will not be executed.
* Describe the two fields specified in the SQL statement.
*----------------------------------------------------------------
CALL OPARSE(CURS(1,1), SEMP, SEMPL, NODEFP, V7FLAG)
IF (CURS(1,1).NE.0) THEN
CALL ERRRPT(LDA(1), CURS(1,1))
GO TO 700
END IF
CNAMEL = 80
CALL ODESCR(CURS(1,1), 1, ENAMES, DTYPE, CNAME,
+ CNAMEL, DSIZE, PREC, SCALE, NULLOK)
IF (CURS(1,1).NE.0) THEN
CALL ERRRPT(LDA(1), CURS(1,1))
GO TO 700
END IF
IF (ENAMES .GT. ENAMEL) THEN
WRITE (*, '(1X, A, I2, A, I2)') 'ENAME too large (',
+ ENAMES, ' for buffer (', ENAMEL, ').'
GO TO 700
END IF
CNAMEL = 80
CALL ODESCR(CURS(1,1), 2, JOBS, DTYPE, CNAME,
+ CNAMEL, DSIZE, PREC, SCALE, NULLOK)
IF (CURS(1,1).NE.0) THEN
CALL ERRRPT(LDA(1), CURS(1,1))
GO TO 700
END IF
IF (JOBS .GT. JOBL) THEN
WRITE (*, '(1X, A, I2, A, I2)') 'JOB too large (',
+ JOBS, ' for buffer (', JOBL, ').'
GO TO 700
END IF
*--------------------------------------------------------------
* Parse the insert and select statements.
*--------------------------------------------------------------
CALL OPARSE(CURS(1,1), INS, INSL, NODEFP, V7FLAG)
IF (CURS(1,1).NE.0) THEN
CALL ERRRPT(LDA(1), CURS(1,1))
GO TO 700
END IF
CALL OPARSE(CURS(1,2), SEL, SELL, NODEFP, V7FLAG)
IF (CURS(1,2).NE.0) THEN
CALL ERRRPT(LDA(1), CURS(1,2))
GO TO 700
END IF
*--------------------------------------------------------------
* Bind all placeholders.
*--------------------------------------------------------------
CALL OBNDRV(CURS(1,1),ENON,LEN(ENON),EMPNO,EMPNOL,3,-1,
+ 0,0,-1,-1)
IF (CURS(1,1).NE.0) THEN
CALL ERRRPT(LDA(1), CURS(1,1))
GO TO 700
END IF
CALL OBNDRV(CURS(1,1),ENAN,ENANL,ENAME,ENAMEL,1,-1,
+ 0,0,-1,-1)
IF (CURS(1,1).NE.0) THEN
CALL ERRRPT(LDA(1), CURS(1,1))
GO TO 700
END IF
CALL OBNDRV(CURS(1,1),JOBN,JOBNL,JOB,JOBL,1,-1,0,0,-1,-1)
IF (CURS(1,1).NE.0) THEN
CALL ERRRPT(LDA(1), CURS(1,1))
GO TO 700
END IF
CALL OBNDRV(CURS(1,1),SALN,SALNL,SAL,SALL,3,-1,0,0,-1,-1)
IF (CURS(1,1).NE.0) THEN
CALL ERRRPT(LDA(1), CURS(1,1))
GO TO 700
END IF
CALL OBNDRV(CURS(1,1),DEPTN,DEPTNL,DEPTNO,DEPTL,3,-1,
+ 0,0,-1,-1)
IF (CURS(1,1).NE.0) THEN
CALL ERRRPT(LDA(1), CURS(1,1))
GO TO 700
END IF
*--------------------------------------------------------------
* Bind the DEPTNO variable.
*--------------------------------------------------------------
CALL OBNDRN(CURS(1,2), 1, DEPTNO, DEPTL, 3,-1,0,0,-1,-1)
IF (CURS(1,2).NE.0) THEN
CALL ERRRPT(LDA(1), CURS(1,2))
GO TO 700
END IF
*--------------------------------------------------------------
* Describe the DNAME column - get the name and length.
*--------------------------------------------------------------
DNAMEL = 14
CALL ODESCR(CURS(1,1), 1, DNAMES, DTYPE, DNAME,
+ DNAMEL, DSIZE, PREC, SCALE, NULLOK)
IF (CURS(1,2).NE.0) THEN
CALL ERRRPT(LDA(1), CURS(1,2))
GO TO 700
END IF
IF (DNAMES .GT. DNAMEL) THEN
WRITE (*, '(1X, A)') 'DNAME too large for buffer.'
GO TO 700
END IF
*--------------------------------------------------------------
* Define the buffer to receive DNAME.
*--------------------------------------------------------------
CALL ODEFIN(CURS(1,2),1,DNAME,DNAMEL,1,-1,0,0,-1,-1,0,0)
IF (CURS(1,2).NE.0) THEN
CALL ERRRPT(LDA(1), CURS(1,2))
GO TO 700
END IF
*--------------------------------------------------------------
* Read the user's input. Statement 100
* starts the main program loop.
*--------------------------------------------------------------
100 WRITE (*, '( A)')
+ 'Enter employee name (CR to QUIT) : '
READ (*, '(A)'), ENAME
IF (LEN_TRIM(ENAME) .EQ. 0) GO TO 700
WRITE (*, '( A)'), 'Enter employee job : '
READ (*, '(A)'), JOB
WRITE (*, '( A)') 'Enter employee salary: '
READ (*, '(I6)'), SAL
300 WRITE (*, '( A)') 'Enter employee dept : '
READ (*, '(I6)'), DEPTNO
*--------------------------------------------------------------
* Check for a valid department number by
* executing the SELECT statement.
*--------------------------------------------------------------
CALL OEXEC(CURS(1,2))
IF (CURS(1,2).NE.0) THEN
CALL ERRRPT(LDA(1), CURS(1,2))
GO TO 700
END IF
*--------------------------------------------------------------
* Fetch the rows - DEPTNO is a primary key, so a max of
* one row will be fetched.
* If the return code is 1403 no such department exists.
*--------------------------------------------------------------
CALL OFETCH(CURS(1,2))
IF (CURS(1,2).EQ.0) GO TO 500
IF (CURS(7,2).NE.1403) THEN
CALL ERRRPT(LDA(1), CURS(1,2))
GO TO 700
END IF
WRITE (*, '(1X, A)') 'No such department number'
GO TO 300
*--------------------------------------------------------------
* Increment EMPNO by 10.
* Execute the insert statement.
*--------------------------------------------------------------
500 EMPNO = EMPNO + 10
CALL OEXEC(CURS(1,1))
IF (CURS(1,1).EQ.0) GO TO 600
*--------------------------------------------------------------
* If the call returns code 1 (duplicate value in index),
* generate the next possible employee number.
*--------------------------------------------------------------
IF (CURS(7,1).NE.1) THEN
CALL ERRRPT(LDA(1), CURS(1,1))
GO TO 700
END IF
EMPNO=EMPNO+10
GO TO 500
600 WRITE (*, 610) ENAME, DNAME, EMPNO
610 FORMAT(/, 1X, A10, ' added to the ', A14,
+ ' department as employee# ', I4, /)
*--------------------------------------------------------------
* The row has been added - commit this transaction.
*--------------------------------------------------------------
CALL OCOM(LDA(1))
IF (LDA(1).NE.0) THEN
CALL ERRRPT(LDA(1), LDA(1))
GO TO 700
END IF
GO TO 100
*--------------------------------------------------------------
* Either a fatal error has occurred or the user typed
* <CR> for the employee name.
* Close the cursors, disconnect, and end the program.
*--------------------------------------------------------------
700 CONTINUE
CALL OCLOSE(CURS(1,1))
IF (CURS(1,1).NE.0) CALL ERRRPT(LDA(1), CURS(1,1))
CALL OCLOSE(CURS(1,2))
IF (CURS(1,2).NE.0) CALL ERRRPT(LDA(1), CURS(1,2))
CALL OLOGOF(LDA(1))
IF (LDA(1).NE.0) CALL ERRRPT(LDA(1), LDA(1))
900 STOP
END
*--------------------------------------------------------------
* ERRRPT prints the cursor number, the error code, and the
* OCI function code.
*
* CURS is a cursor. N is the cursor number.
*--------------------------------------------------------------
SUBROUTINE ERRRPT(LDA, CURS)
INTEGER*2 CURS(32), LDA(32)
CHARACTER*160 ERRMSG
IF (CURS(6) .GT. 0) THEN
WRITE (*, '(1X, A, I3)') 'ORACLE error processing OCI
+ function ', CURS(6)
END IF
CALL OERHMS(LDA(1), CURS(7), ERRMSG, 160)
WRITE (*, '(1X, A)') ERRMSG
RETURN
END
INTEGER FUNCTION LEN_TRIM(STRING)
CHARACTER*(*) STRING
INTEGER NEXT
DO 10 NEXT = LEN(STRING), 1, -1
IF (STRING(NEXT : NEXT) .NE. ' ') THEN
LEN_TRIM = NEXT
RETURN
ENDIF
10 CONTINUE
LEN_TRIM = 0
RETURN
END
* FDEMO2.FOR
*
* A dynamic SQL OCI example program. Processes
* SQL statements entered interactively by the user.
*
* There is a 132-character limit on the length of
* the SQL statements. It is not necessary to
* terminate the SQL statement with a semicolon.
*
* To end the demo, type 'exit' or 'EXIT' at the
* prompt.
PROGRAM FDEMO2
IMPLICIT INTEGER*4 (A-Z)
* Data structures
* Logon and cursor areas
INTEGER*2 CDA(32), LDA(32), HDA(256)
* Bind values
CHARACTER*20 BVARV(8)
INTEGER NBV
* Output values
CHARACTER*10 DVARC(8)
INTEGER DVARI(8)
REAL*4 DVARF(8)
INTEGER*2 DBTYPE(8), RLEN(8), RCODE(8)
INTEGER*2 INDP(8)
INTEGER NOV
* Column names for SELECT
CHARACTER*10 COLNAM(8)
* SQL statement buffer and logon info
CHARACTER*80 SQLSTM, UID, PWD, PROMPT
INTEGER UIDL, PWDL, SQLL, NOBLOK
UID = 'SCOTT'
PWD = 'TIGER'
UIDL = LEN_TRIM(UID)
PWDL = LEN_TRIM(PWD)
NOBLOK = 0
* Connect to ORACLE in non-blocking mode.
* HDA must be initialized to all zeros before call to OLOG.
DATA HDA/256*0/
CALL OLOG(LDA, HDA, UID, UIDL, PWD, PWDL, 0, -1, NOBLOK)
IF (LDA(7) .NE. 0) THEN
CALL ERRRPT(LDA, CDA)
GO TO 999
ENDIF
WRITE (*, '(1X, A, A)') 'Connected to ORACLE as user ', UID
* Open a cursor.
CALL OOPEN(CDA, LDA, UID, 0, -1, PWD, 0)
IF (LDA(7) .NE. 0) THEN
CALL ERRRPT(LDA, CDA)
GO TO 900
ENDIF
* Beginning of the main program loop.
* Get and process SQL statements.
PROMPT = 'Enter SQL statement (132 char max)
+ or EXIT to quit >'
100 WRITE (*, '(/, A)') PROMPT
READ '(A)', SQLSTM
SQLL = LEN_TRIM(SQLSTM)
IF (SQLL .EQ. 0) GO TO 100
I = INDEX(SQLSTM, ';')
IF (I .GT. 0) THEN
SQLL = I - 1
ENDIF
IF ((SQLSTM(1:4) .EQ. 'exit') .OR.
+ (SQLSTM(1:4) .EQ. 'EXIT')) GO TO 900
* Parse the statement.
CALL OPARSE(CDA, SQLSTM, SQLL, 0, 2)
IF (CDA(7) .NE. 0) THEN
CALL ERRRPT(LDA, CDA)
GO TO 100
ENDIF
* If there are bind values, obtain them from user.
CALL GETBNV(LDA, CDA, SQLSTM, BVARV, NBV)
IF (NBV .LT. 0) GO TO 100
* Define the output variables. If the statement is not a
* query, NOV returns as 0. If there were errors defining
* the output variables, NOV returns as -1.
CALL DEFINE(LDA, CDA, COLNAM, DBTYPE, DVARC, DVARI,
+ DVARF, INDP, RLEN, RCODE, NOV)
IF (NOV .LT. 0) GO TO 100
* Execute the statement.
CALL OEXN(CDA, 1, 0)
IF (CDA(7) .NE. 0) THEN
CALL ERRRPT(LDA, CDA)
GO TO 100
ENDIF
* Fetch rows and display output if the statement was a query.
CALL FETCHN(LDA, CDA, COLNAM, NOV, DBTYPE, DVARC,
+ DVARI, DVARF, INDP, RV)
IF (RV .LT. 0) GO TO 100
* Loop back to statement 100 to process
* another SQL statement.
GO TO 100
* End of main program loop. Here on exit or fatal error.
900 CALL OCLOSE(CDA)
CALL OLOGOF(LDA)
* End of program. Come here if connect fails.
999 END
* Begin subprograms.
SUBROUTINE GETBNV(LDA, CDA, STMT, BVARV, N)
IMPLICIT INTEGER*4 (A-Z)
INTEGER*2 LDA(32), CDA(32)
CHARACTER*(*) STMT
CHARACTER*(*) BVARV(8)
* Arrays for bind variable info.
INTEGER BVARI(8), BVARL(8)
* Scan the SQL statement for placeholders (:ph).
* Note that a placeholder must be terminated with
* a space, a comma, or a close parentheses.
* Two arrays are maintained: an array of starting
* indices in the string (BVARI), and an array of
* corresponding lengths (BVARL).
POS = 1
DO 300 K = 1, 8 ! maximum of 8 per statement
I = INDEX(STMT(POS:), ':')
IF (I .EQ. 0) GO TO 400
POS = I + POS - 1
BVARI(K) = POS
DO 100 J = POS, LEN(STMT)
IF (STMT(J:J) .EQ. ' '
+ .OR. STMT(J:J) .EQ. ','
+ .OR. STMT(J:J) .EQ. ')') THEN
BVARL(K) = J - POS
GO TO 200
ENDIF
100 CONTINUE
200 POS = POS + 1 ! index past the ':'
300 CONTINUE
400 N = K - 1 ! N is the number of BVs
DO 500 K = 1, N
CALL OBNDRV(CDA, STMT(BVARI(K) :), BVARL(K),
+ BVARV(K), 20, 1,-1,0,0,-1,-1)
IF (CDA(7) .NE. 0) THEN
CALL ERRRPT(LDA, CDA)
N = -1
RETURN
ENDIF
WRITE (*, '( A, A, A)') 'Enter value for ',
+ STMT(BVARI(K)+1:BVARI(K)+BVARL(K)-1), ' --> '
READ '(A)', BVARV(K)
500 CONTINUE
RETURN
END
* Define output variables for queries.
* Returns the number of select-list items (N)
* and the names of the select-list items (COLNAM).
* A maximum of 8 select-list items is permitted.
* (Note that this program does not check if there
* are more, but a production-quality program
* must do this.)
SUBROUTINE DEFINE(LDA, CDA, COLNAM, DBTYPE, DVARC,
+ DVARI, DVARF, INDP, RLEN, RCODE, RV)
IMPLICIT INTEGER*4 (A-Z)
INTEGER*2 LDA(32), CDA(32), DBTYPE(8)
INTEGER*2 RLEN(8), RCODE(8), INDP(8)
CHARACTER*(*) DVARC(8), COLNAM(8)
INTEGER DVARI(8), RV
REAL*4 DVARF(8)
INTEGER DBSIZE(8), COLNML(8), DSIZE(8)
INTEGER*2 PREC(8), SCALE(8), NOK(8)
* If not a query (SQL function code .ne. 4), return.
IF (CDA(2) .NE. 4) THEN
RV = 0
RETURN
ENDIF
* Describe the select-list (up to 8 items max),
* and define an output variable for each item, with the
* external (hence, FORTRAN) type depending on the
* internal ORACLE type, and its attributes.
DO 100 N = 1, 8
COLNML(N) = 10 ! COL length must be set on the call
CALL ODESCR(CDA, N, DBSIZE(N), DBTYPE(N),
+ COLNAM(N), COLNML(N), DSIZE(N),
+ PREC(N), SCALE(N), NOK(N))
* If the return code from ODESCR is 1007, then you have
* reached the end of the select list.
IF (CDA(7) .EQ. 1007) THEN
GO TO 200
* Otherwise, if the return code is non-zero, an
* error occurred. Exit the subroutine, signalling
* an error.
ELSE IF (CDA(7) .NE. 0) THEN
CALL ERRRPT(LDA, CDA)
RV = -1 ! Error on return
RETURN
ENDIF
* Check the datatype of the described item. If it's a
* NUMBER, check if the SCALE is 0. If so, define the
* output variable as INTEGER (3). If it's NUMBER with SCALE != 0,
* define the output variable as REAL (4). Otherwise,
* it's assumed to be a DATE, LONG, CHAR, or VARCHAR2,
* so define the output as 1 (VARCHAR2).
IF (DBTYPE(N) .EQ. 2) THEN
IF (SCALE(N) .EQ. 0) THEN
DBTYPE(N) = 3
ELSE
DBTYPE(N) = 4
ENDIF
ELSE
DBTYPE(N) = 1
ENDIF
* Define the output variable. Do not define RLEN if
* the external datatype is 1.
IF (DBTYPE(N) .EQ. 3) THEN
CALL ODEFIN(CDA, N, DVARI(N), 4, 3, 0, INDP(N),
+ FMT, 0, 0, RLEN(N), RCODE(N))
ELSE IF (DBTYPE(N) .EQ. 4) THEN
CALL ODEFIN(CDA, N, DVARF(N), 4, 4, 0, INDP(N),
+ FMT, 0, 0, RLEN(N), RCODE(N))
ELSE
CALL ODEFIN(CDA, N, DVARC(N), 10, 1, 0, INDP(N),
+ FMT, 0, 0, %VAL(-1), RCODE(N))
ENDIF
IF (CDA(7) .NE. 0) THEN
CALL ERRRPT(LDA, CDA)
RV = -1
RETURN
ENDIF
100 CONTINUE
200 RV = N - 1 ! Decrement to get correct count
RETURN
END
* FETCHN uses OFETCH to fetch the rows that satisfy
* the query, and displays the output. The data is
* fetched 1 row at a time.
SUBROUTINE FETCHN(LDA, CDA, NAMES, NOV, DBTYPE, DVARC,
+ DVARI, DVARF, INDP, RV)
IMPLICIT INTEGER*4 (A-Z)
INTEGER*2 LDA(32), CDA(32), DBTYPE(8), INDP(8)
CHARACTER*(*) NAMES(8), DVARC(8)
INTEGER DVARI(8), NOV, RV
REAL*4 DVARF(8)
IF (CDA(2) .NE. 4) THEN ! not a query
RV = 0
RETURN
ENDIF
DO 50 COL = 1, NOV
IF (DBTYPE(COL) .EQ. 1) THEN
WRITE (*, 900) NAMES(COL), ' '
900 FORMAT ('+', A10, A1, $)
ELSE
WRITE (*, 902) NAMES(COL), ' '
902 FORMAT ('+', A8, A1, $)
ENDIF
50 CONTINUE
WRITE (*, '(1X, A, /)') '------------------------------
+-----------------------------------------------'
DO 200 NROWS = 1, 10000
CALL OFETCH(CDA)
IF (CDA(7) .EQ. 1403) GO TO 300
IF (CDA(7) .NE. 0 .AND. CDA(7) .NE. 1406) THEN
CALL ERRRPT(LDA, CDA)
RV = -1
RETURN
ENDIF
DO 100 COL = 1, NOV
IF (INDP(COL) .LT. 0 .AND. DBTYPE(COL) .NE. 1) THEN
WRITE (*, 903), ' '
903 FORMAT ('+', A9, $)
ELSE IF (INDP(COL) .LT. 0 .AND. DBTYPE(COL) .EQ. 1) THEN
WRITE (*, 905), ' '
905 FORMAT ('+', A11, $)
ELSE
IF (DBTYPE(COL) .EQ. 3) THEN
WRITE (*, 904) DVARI(COL), ' '
904 FORMAT ('+', I6, A3, $)
ELSE IF (DBTYPE(COL) .EQ. 4) THEN
WRITE (*, 906) DVARF(COL), ' '
906 FORMAT ('+', F8.2, A1, $)
ELSE
WRITE (*, 908) DVARC(COL), ' '
908 FORMAT ('+', A10, A1, $)
ENDIF
ENDIF
100 CONTINUE
WRITE (*, '(1X)')
200 CONTINUE
300 NROWS = NROWS - 1
WRITE (*, '(/, 1X, I3, A)') NROWS, ' rows returned'
RETURN
END
SUBROUTINE ERRRPT(LDA, CDA)
INTEGER*2 LDA(32), CDA(32)
CHARACTER*132 MSG
MSG = ' '
IF (LDA(7) .NE. 0) THEN
CDA(7) = LDA(7)
CDA(6) = 0
ENDIF
IF (CDA(6) .NE. 0) THEN
WRITE (*, '(1X, A, I3)') 'Error processing OCI function',
+ CDA(6)
ENDIF
CALL OERHMS (LDA, CDA(7), MSG, 132)
WRITE (*, '(1X, A)') MSG
RETURN
END
INTEGER FUNCTION LEN_TRIM(STRING)
CHARACTER*(*) STRING
INTEGER NEXT
DO 10 NEXT = LEN(STRING), 1, -1
IF (STRING(NEXT : NEXT) .NE. ' ') THEN
LEN_TRIM = NEXT
RETURN
ENDIF
10 CONTINUE
LEN_TRIM = 0
RETURN
END
* FDEMO3.FOR
* OCI FORTRAN Sample Program 3
*
* Demonstrates using the OFLNG routine to retrieve
* part of a LONG RAW column
*
* This example "plays" a digitized voice message
* by repeatedly extracting 64 kB chunks of the message
* from the row in the table, and sending them to a
* converter buffer (for example, a Digital-to-Analog
* Converter (DAC) FIFO buffer).
*
* The hardware-specific DAC routine is merely simulated
* in this example.
PROGRAM FDEMO3
IMPLICIT INTEGER(A-Z)
* Connect and Cursor Data Structures
INTEGER*2 CDA(32)
INTEGER*2 LDA(32)
INTEGER*2 HDA(256)
* Program Variables
CHARACTER*132 SQLSTM
CHARACTER*20 UID, PWD
INTEGER MSGID, MSGLEN
INTEGER*2 INDP, RLEN, RCODE
INTEGER RETL
BYTE DBIN(200000)
CHARACTER*6 FMT
INTEGER*4 NOBLOK
* Connect to ORACLE in non-blocking mode.
* The HDA must be initialized to all zeros before calling OLOG.
UID = 'SCOTT'
PWD = 'TIGER'
DATA HDA/256*0/
CALL OLOG(LDA, HDA, UID, LEN_TRIM(UID),
+ PWD, LEN_TRIM(PWD), 0, -1, NOBLOK)
IF (LDA(1) .NE. 0) THEN
WRITE (*, '(1X, A)') 'Cannot connect as scott/tiger...'
WRITE (*, '(1X, A)') 'Application terminating...'
GOTO 999
END IF
* Open the cursor. (Use UID as a dummy parameter--it
* won't be looked at.)
CALL OOPEN(CDA, LDA, UID, 0, 0, UID, 0)
IF (CDA(7) .NE. 0) THEN
CALL ERRPT(CDA)
GOTO 900
END IF
* Drop the old table.
WRITE (*, '( A)') 'OK to drop table VOICE_MAIL (Y or N)? : '
READ '(A)', FMT
IF (FMT(1:1) .EQ. 'y' .OR. FMT(1:1) .EQ. 'Y') THEN
GO TO 10
ELSE
GO TO 900
ENDIF
* Parse the DROP TABLE statement.
10 SQLSTM = 'DROP TABLE VOICE_MAIL'
CALL OPARSE(CDA, SQLSTM, LEN_TRIM(SQLSTM), 0, 2)
IF (CDA(7) .EQ. 0) THEN
WRITE (*, '(1X, A)') 'Table VOICE_MAIL dropped.'
ELSEIF (CDA(7) .EQ. 942) THEN
WRITE (*, '(1X, A)') 'Table did not exist.'
ELSE
CALL ERRPT(LDA, CDA)
GO TO 900
ENDIF
* Create new table. Parse with DEFFLG set to zero,
* to immediately execute the DDL statement. The LNGFLG
* is set to 2 (Version 7).
SQLSTM = 'CREATE TABLE VOICE_MAIL
+ (MSG_ID NUMBER(6), MSG_LEN NUMBER(12), MSG LONG RAW)'
* Parse the statement. Do not defer the parse, so that the
* DDL statement is executed immediately.
CALL OPARSE(CDA, SQLSTM, LEN_TRIM(SQLSTM), 0, 2)
IF (CDA(7) .EQ. 0) THEN
WRITE (*, '(1X, A)') 'Created table VOICE_MAIL.'
ELSE
CALL ERRPT(LDA, CDA)
GOTO 900
END IF
* Insert some dummy data into the table.
SQLSTM = 'INSERT INTO VOICE_MAIL VALUES (:1, :2, :3)'
CALL OPARSE(CDA, SQLSTM, LEN_TRIM(SQLSTM), 1, 2)
IF (CDA(7) .NE. 0) THEN
CALL ERRPT(LDA, CDA)
GOTO 900
END IF
* Do the binds for the input data to set values
* in the new table.
INDP = 0
CALL OBNDRN(CDA, 1, MSGID, 4, 3, 0, INDP, FMT, 0, 0)
IF (CDA(7) .NE. 0) THEN
CALL ERRPT(LDA, CDA)
GOTO 900
END IF
CALL OBNDRN(CDA, 2, MSGLEN, 4, 3, 0, INDP, FMT, 0, 0)
IF (CDA(7) .NE. 0) THEN
CALL ERRPT(LDA, CDA)
GOTO 900
END IF
CALL OBNDRN(CDA, 3, DBIN, 200000, 24, 0, INDP, FMT, 0, 0)
IF (CDA(7) .NE. 0) THEN
CALL ERRPT(LDA, CDA)
GOTO 900
END IF
* Fill the input buffer with some dummy data.
MSGID = 100
MSGLEN = 200000
DO 100 I = 1, 200000
100 DBIN(I) = 42
* Execute the statement to INSERT the data
WRITE (*, '(1X, A)') 'Inserting data into the table.'
CALL OEXN(CDA, 1, 0)
IF (CDA(7) .NE. 0) THEN
CALL ERRPT(LDA, CDA)
GOTO 900
END IF
* Do the selects. First position the cursor at the
* proper row, using the MSG_ID. Then fetch the data
* in 64K chunks, using OFLNG.
SQLSTM = 'SELECT MSG_ID, MSG_LEN, MSG
+ FROM VOICE_MAIL WHERE MSG_ID = 100'
CALL OPARSE(CDA, SQLSTM, LEN_TRIM(SQLSTM), 1, 2)
IF (CDA(7) .NE. 0) THEN
CALL ERRPT(LDA, CDA)
GOTO 900
END IF
* Define the output variables for the SELECT.
CALL ODEFIN(CDA, 1, MSGID, 4, 3, 0, %VAL(-1), %VAL(-1),
+ 0, 0, %VAL(-1), %VAL(-1))
IF (CDA(7) .NE. 0) THEN
CALL ERRPT(LDA, CDA)
GOTO 900
END IF
CALL ODEFIN(CDA, 2, MSGLEN, 4, 3, 0, %VAL(-1), %VAL(-1),
+ 0, 0, %VAL(-1), %VAL(-1))
IF (CDA(7) .NE. 0) THEN
CALL ERRPT(LDA, CDA)
GOTO 900
END IF
CALL ODEFIN(CDA, 3, DBIN, 200000, 24, 0, INDP, %VAL(-1),
+ 0, 0, RLEN, RCODE)
IF (CDA(7) .NE. 0) THEN
CALL ERRPT(LDA, CDA)
GOTO 900
END IF
* Do the query, getting the MSG_ID to position the cursor, and
* the first 100 bytes of the message.
* CANCEL and EXACT are FALSE.
CALL OEXFET(CDA, 1, 0, 0)
IF (CDA(7) .NE. 0) THEN
CALL ERRPT(LDA, CDA)
GOTO 900
END IF
WRITE (*, '(1X, A, I4, A)') 'Message', MSGID,
+' is available.'
WRITE (*, '(1X, A, I7, A)') 'The length is', MSGLEN,
+' bytes.'
* Play out the message, calling the DAC routine for each
* 64K chunk fetched by OFLNG.
OFFSET = 0
N = MSGLEN/65536 + 1
DO 200 J = 1, N
IF (MSGLEN .LT. 65536) THEN
LEN = MSGLEN
ELSE
LEN = 65536
ENDIF
CALL OFLNG(CDA, 3, DBIN, LEN, 24, RETL, OFFSET)
IF (CDA(7) .NE. 0) THEN
CALL ERRPT(LDA, CDA)
GOTO 900
ENDIF
CALL PLAYMSG(DBIN, LEN)
MSGLEN = MSGLEN - LEN
IF (MSGLEN .LT. 0) GO TO 900
200 CONTINUE
900 CALL OCLOSE(CDA)
IF (CDA(7) .NE. 0) THEN
CALL ERRPT(LDA, CDA)
GOTO 900
END IF
CALL OLOGOF(LDA)
IF (LDA(7) .NE. 0) THEN
CALL ERRPT(LDA, CDA)
GOTO 900
END IF
999 STOP 'End of OCIDEMO3.'
END
SUBROUTINE PLAYMSG(OUT, LEN)
BYTE OUT(65536)
INTEGER LEN
WRITE (*, '(1X, A, I7, A)') 'Playing', LEN, ' bytes.'
RETURN
END
SUBROUTINE ERRPT(LDA, CDA)
INTEGER*2 LDA(32), CDA(32)
CHARACTER*132 MSG
MSG = ' '
IF (LDA(7) .NE. 0) THEN
CDA(7) = LDA(7)
CDA(6) = 0
ENDIF
IF (CDA(6) .NE. 0) THEN
WRITE (*, '(1X, A, I3)') 'Error processing OCI function',
+ CDA(6)
ENDIF
CALL OERHMS (LDA, CDA(7), MSG, 132)
WRITE (*, '(1X, A)') MSG
RETURN
END
INTEGER FUNCTION LEN_TRIM(STRING)
CHARACTER*(*) STRING
INTEGER NEXT
DO 10 NEXT = LEN(STRING), 1, -1
IF (STRING(NEXT : NEXT) .NE. ' ') THEN
LEN_TRIM = NEXT
RETURN
ENDIF
10 CONTINUE
LEN_TRIM = 0
RETURN
END
|
Prev Next |
 Copyright © 1996 Oracle Corporation. All Rights Reserved. |
Library |
Product |
Contents |
Index |