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