This appendix includes sample Access Manager programs that are written in C, COBOL, and RPG. The following sample programs are included:
#include <string.h> #include <stdlib.h> #include <stdio.h> /*---------------------------------------------------------------*/ /* */ /* Program Name: SAMP1C */ /* */ /* Function: Insert a sample row into the DEPT table */ /* */ /* Author: Oracle Corporation */ /* Date: 8/25/95 */ /* */ /*---------------------------------------------------------------*/ #ifdef TRUE # undef TRUE #endif #define TRUE 1 EXEC SQL INCLUDE sqlca; struct sqlca *sca; main() { EXEC SQL BEGIN DECLARE SECTION; char server??(10??); char username??(10??); char password??(10??); long int deptno; char dname??(14??); char loc??(13??); char sql_stmt??(80??); EXEC SQL END DECLARE SECTION; long int rc; EXEC SQL WHENEVER SQLERROR GOTO big_error; EXEC SQL WHENEVER SQLWARNING GOTO big_warn; printf("Entering test SAMP1C...\n"); /* strcpy(server, "GENERIC"); strcpy(username, "SCOTT"); strcpy(password, "TIGER"); EXEC SQL CONNECT TO :server USER :username USING :password; */ printf("After implicit connect.\n"); strcpy(sql_stmt, "INSERT INTO DEPT VALUES (?,?,?)"); EXEC SQL PREPARE S FROM :sql_stmt; printf("After prepare.\n"); deptno = 88; strcpy(dname, "SAMP1 C"); strcpy(loc, "Success"); EXEC SQL EXECUTE S USING :deptno, :dname, :loc; printf("After execute.\n"); EXEC SQL RELEASE CURRENT; printf("After release current.\n"); EXEC SQL COMMIT; printf("After commit.\n"); printf("Exiting test SAMP1C...\n"); exit(0); big_warn: EXEC SQL WHENEVER SQLWARNING CONTINUE; printf("Big warn\n"); big_error: EXEC SQL WHENEVER SQLERROR CONTINUE; printf("Big error!: SQLCA...\n"); printf(" sqlcaid =%0.8s.\n",sqlca.sqlcaid); printf(" sqlcabc =%d.\n",sqlca.sqlcabc); printf(" sqlcode =%d.\n",sqlca.sqlcode); printf(" sqlerrml =%d.\n",sqlca.sqlerrml); printf(" sqlerrmc =%0.70s.\n",sqlca.sqlerrmc); printf(" sqlerrp =%0.8s.\n",sqlca.sqlerrp); printf(" sqlerrd =%d %d %d %d %d %d\n",sqlca.sqlerrd??(0??), sqlca.sqlerrd??(1??),sqlca.sqlerrd??(2??), sqlca.sqlerrd??(3??),sqlca.sqlerrd??(4??), sqlca.sqlerrd??(5??)); printf(" sqlwarn =%0.11s.\n",sqlca.sqlwarn); printf(" sqlstate =%0.5s.\n",sqlca.sqlstate); exit(1); not_found: exit(0); }
IDENTIFICATION DIVISION. PROGRAM-ID. SAMP1CBL. AUTHOR. Oracle. INSTALLATION. Oracle Corporation. DATE-WRITTEN. August 25, 1995. DATE-COMPILED. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. IBM-AS400. OBJECT-COMPUTER. IBM-AS400. DATA DIVISION. WORKING-STORAGE SECTION. EXEC SQL BEGIN DECLARE SECTION END-EXEC. 77 SERVER-NAME PIC X(10). 77 USER-NAME PIC X(10). 77 USER-PASSWORD PIC X(10). * Anything going into a NUMERIC, DECIMAL, SMALLINT, INTEGER * column MUST have a sign. * DEPTNO in the following is a four-byte zoned decimal number * with the sign in the "zone" portion of the right hand character 77 DEPNO PIC S9(4). 77 DEPTNAME PIC X(14). 77 MISC PIC X(13). 77 SQQL-STATEMENT PIC X(100). EXEC SQL END DECLARE SECTION END-EXEC. EXEC SQL INCLUDE SQLCA END-EXEC. 77 CONV1 PIC S999999999 SIGN IS LEADING SEPARATE. 77 CONV2 PIC S999999999 SIGN IS LEADING SEPARATE. 77 CONV3 PIC S999999999 SIGN IS LEADING SEPARATE. PROCEDURE DIVISION. P1NTVLE-INIT. MOVE "GENERIC" TO SERVER-NAME. MOVE "SCOTT" TO USER-NAME. MOVE "TIGER" TO USER-PASSWORD. MOVE SPACES TO SQLERRMC. EXEC SQL WHENEVER SQLERROR GO TO BIG-ERROR END-EXEC. EXEC SQL WHENEVER SQLWARNING GO TO BIG-WARNING END-EXEC. P1NTVLE-CONNECT. DISPLAY "Connected implicitly...". P1NTVLE-PREPARE. MOVE "Insert into DEPT VALUES(?,?,?)" to SQQL-STATEMENT. DISPLAY " " SQQL-STATEMENT. EXEC SQL PREPARE S FROM :SQQL-STATEMENT END-EXEC. DISPLAY "Prepared ...". P1NTVLE-EXECUTE. MOVE 88 TO DEPNO. MOVE "SAMP1 CBL" TO DEPTNAME. MOVE "Success" to MISC. EXEC SQL EXECUTE S USING :DEPNO, :DEPTNAME, :MISC END-EXEC. DISPLAY "Executed...". P1LE-RELEASE. EXEC SQL RELEASE CURRENT END-EXEC. DISPLAY "Released current...". P1LE-COMMIT. EXEC SQL COMMIT END-EXEC. DISPLAY "Committing ...". P1LE-END. DISPLAY "Exiting ...". STOP RUN. BIG-ERROR. Display "SQL Error ...". PERFORM DUMP-SQLCA. GO TO P1LE-END. BIG-WARNING. Display "SQL Warning ...". PERFORM DUMP-SQLCA. GO TO P1LE-END. DUMP-SQLCA. *Move binary fields to displayable fields for DISPLAY stmt. MOVE SQLCODE TO CONV1. MOVE SQLSTATE TO CONV2. DISPLAY " SQLCODE=" CONV1 ", SQLSTATE=" CONV2. DISPLAY " SQLERRMC on following line ...". DISPLAY " " SQLERRMC. DISPLAY " SQLERRP=" SQLERRP. MOVE SQLERRD(1) TO CONV1. MOVE SQLERRD(2) TO CONV2. MOVE SQLERRD(3) TO CONV3" DISPLAY "SQLERRD(1)..SQLERRD(3)=" CONV1 " " CONV2 " " CONV3. MOVE SQLERRD(4) TO CONV1. MOVE SQLERRD(5) TO CONV2. MOVE SQLERRD(6) TO CONV3. DISPLAY "SQLERRD(4)..SQLERRD(6)=" CONV1 " " CONV2 " " CONV3. DISPLAY "SQLWARN=" SQLWARN.
H F* FILE DECLARATION FOR QPRINT FQPRINT O F 132 PRINTER DVARS DS DDEPTNO 1 4b 0 DHOSTDN 5 8b 0 DSERVER 9 18 DUSERNM 19 28 DPASSWD 29 38 DSTMSQL 39 118 DSTR 119 198 DIM(80) DSTMT1 C 'Insert into DEPT - D VALUES(88,''SAMP1 RPG'',''Success'')' C MOVE *BLANKS STR C CLEAR SQLCA C*PUT OUT "ENTERING TEST P1..." MESSAGE C MOVEL(P) 'GENERIC' SERVER C MOVEL(P) 'SCOTT' USERNM C MOVEL(P) 'TIGER' PASSWD C MOVEL(P) STMT1 STMSQL C EXCEPT NTRP1 C EXCEPT NTRP2 C/EXEC SQL C+ WHENEVER SQLERROR GOTO BIGERR C/END-EXEC C/EXEC SQL C+ WHENEVER SQLWARNING GOTO BIGWRN C/END-EXEC C*EXEC SQL C* CONNECT TO :SERVER USER :USERNM USING :PASSWD C* CONNECT C*END-EXEC C* PUT OUT "CONNECTED IMPLICITLY" MESSAGE... C EXCEPT CNCTD C/EXEC SQL PREPARE S FROM :STMSQL C/END-EXEC C* PUT OUT "AFTER PREPARE" MESSAGE C EXCEPT PRPAF C* NOW DO THE EXECUTE OF THE SQL STATEMENT AND PUT OUT MESSAGE C/EXEC SQL EXECUTE S C/END-EXEC C EXCEPT XEQAF C* NOW DO THE RELEASE OF THE SERVER AND PUT OUT MESSAGE C/EXEC SQL RELEASE CURRENT C/END-EXEC C EXCEPT RLSAF C* NOW DO THE COMMIT AND PUT OUT MESSAGE ... C/EXEC SQL COMMIT C/END-EXEC C EXCEPT CMTAF C* AND NOW WE ARE GOING TO EXIT ... C EXCEPT XITNW C GOTO FINISH C* C BIGWRN TAG C/EXEC SQL WHENEVER SQLWARNING CONTINUE C/END-EXEC C EXCEPT WRNMSG C EXSR PSQLCA C GOTO FINISH C* C BIGERR TAG C/EXEC SQL WHENEVER SQLERROR CONTINUE C/END-EXEC C EXCEPT ERRMSG C EXSR PSQLCA C GOTO FINISH C* C FINISH TAG C SETON LR C* CSR PSQLCA BEGSR C EXCEPT SQLCA1 C EXCEPT SQLCA2 C EXCEPT SQLCA3 C EXCEPT SQLCA4 C EXCEPT SQLCA5 C EXCEPT SQLCA6 CSR ENDSR C* OQPRINT E NTRP1 1 O 'Entering SAMP1RPG...' O E NTRP2 1 O 7 'STMSQL=' O STMSQL O E CNCTD 1 O 'CONNECTED IMPLICITLY' O E PRPAF 1 O 'AFTER PREPARE' O E XEQAF 1 O 'AFTER EXECUTE' O E RLSAF 1 O 'AFTER RELEASE CURRENT' O E CMTAF 1 O 'AFTER COMMIT' O E XITNW 1 O 'EXITING SAMP1 RPG' O E WRNMSG 1 O 'BIG WARN:SQLCA...' O E ERRMSG 1 O 'BIG ERROR:SQLCA...' O E SQLCA1 1 O 8 ' SQLAID=' O SQLAID +0 O +0 ', SQLABC=' O SQLABC +0 O +0 ', SQLCOD=' O SQLCOD +0L O +0 ', SQLERL=' O SQLERL +0 O E SQLCA2 1 O 8 ' SQLERM=' O SQLERM +0 O E SQLCA3 1 O 8 ' SQLERP=' O SQLERP +0 O E SQLCA4 1 O 16 ' SQLER1..SQLER3=' O SQLER1 +0L O SQLER2 +1L O SQLER3 +1L O E SQLCA5 1 O 16 ' SQLER4..SQLER6=' O SQLER4 +0L O SQLER5 +1L O SQLER6 +1L O E SQLCA6 1 O 8 ' SQLWRN=' O SQLWRN +0 O +0 ', SQLSTT=' O SQLSTT +0