× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.



Hello all,

I recently finished a program that allows read only access to our database
files

You probably want to use the skeleton of this program and scan for the
qualified
library name and make sure that the library name matches the library that
you want to
give users access to.

Here is an example of an exit program for the IBM registered exit point
QIBM_QZDA_SQL1        ZDAQ0100     *YES     Database Server - SQL access

For longer SQL statements you can use the QIBM_QZDA_SQL2 and the associated
formats

        *************** Beginning of data
*************************************
0000.01
/*********************************************************************/
0000.02 /*
*/
0000.05 /* Database Server SQL Requester Monitor Program
*/
0000.06 /*
*/
0000.10 /* The purpose of this program is enforce Read Only Database
*/
0000.11 /* Functions
*/
0000.12 /*
*/
0000.13
/*********************************************************************/
0000.14
0001.00              PGM        PARM(&P1 &P2)
0002.00
0002.01              /* Accetted "1"=Yes, "0"=No
0003.00              DCL        VAR(&P1) TYPE(*CHAR) LEN(1)
0003.01              /* DataBase Request String
0004.00              DCL        VAR(&P2) TYPE(*CHAR) LEN(607)
0004.01
0004.02              /* DataQ Entry Length
0004.03              DCL        VAR(&DQLNTH)   TYPE(*DEC) LEN(5 0)
VALUE(667)
0004.04              /* DataQ Data Portion
0004.05              DCL        VAR(&DQDATA) TYPE(*CHAR) LEN(667)
0004.10
0004.11              /* Matching DataBase Function Indicator
0004.12              DCL        VAR(&MATCHES) TYPE(*CHAR) LEN(1)
0004.13
0004.14              /* SQL String
0004.15              DCL        VAR(&EZDSQLST) TYPE(*CHAR) LEN(512)
0004.16
0005.16              /* SQL String User
0006.16              DCL        VAR(&EZUSER  ) TYPE(*CHAR) LEN( 10)
0007.16
0008.16              /* QCLSCAN Length String
0009.16              DCL        VAR(&LENCHAR) TYPE(*DEC)  LEN(3  0)
0010.16              /* QCLSCAN Start Position
0011.16              DCL        VAR(&STRPOS ) TYPE(*DEC)  LEN(3  0)
0012.16              /* QCLSCAN Pattern "SELECT"
0013.16              DCL        VAR(&SELECT) TYPE(*CHAR) LEN(6) VALUE
('SELECT')
0014.16              /* QCLSCAN Pattern "INSERT"
0015.16              DCL        VAR(&INSERT) TYPE(*CHAR) LEN(6) VALUE
('INSERT')
0016.16              /* QCLSCAN Pattern "UPDATE"
0017.16              DCL        VAR(&UPDATE) TYPE(*CHAR) LEN(6) VALUE
('UPDATE')
0018.16              /* QCLSCAN Pattern "DELETE"
0019.16              DCL        VAR(&DELETE) TYPE(*CHAR) LEN(6) VALUE
('DELETE')
0020.16              /* QCLSCAN Pattern
0021.16              DCL        VAR(&PATTRN ) TYPE(*CHAR) LEN(6)
0022.16              /* QCLSCAN Pattern Length
0023.16              DCL        VAR(&LENPAT ) TYPE(*DEC)  LEN(3  0)
0024.16              /* QCLSCAN Translate Flag
0025.16              DCL        VAR(&XLATE  ) TYPE(*CHAR) LEN(1)
0026.16              /* QCLSCAN Trim Flag
0027.16              DCL        VAR(&TRIM   ) TYPE(*CHAR) LEN(1)
0028.16              /* QCLSCAN Wildcard Flag
0029.16              DCL        VAR(&WILD   ) TYPE(*CHAR) LEN(1)
0030.16              /* QCLSCAN Result from Scanning
0031.16              DCL        VAR(&RESULT ) TYPE(*DEC)  LEN(3  0)
0055.16
0062.16              CHGVAR     VAR(&EZDSQLST) VALUE(%SST(&P2 96 512))
0063.16              CHGVAR     VAR(&MATCHES) VALUE('0')
0064.16
0065.16              /* Check for User
0066.16              CHGVAR     VAR(&EZUSER) VALUE(%SST(&P2  1  10))
0067.16
0068.16 UPDATE_CHK:
0069.16              CHGVAR     VAR(&LENCHAR) VALUE(512)
0070.16              CHGVAR     VAR(&STRPOS ) VALUE(001)
0071.16              CHGVAR     VAR(&LENPAT ) VALUE(006)
0072.16              CHGVAR     VAR(&XLATE  ) VALUE('1')
0073.16              CHGVAR     VAR(&TRIM   ) VALUE('1')
0074.16              CHGVAR     VAR(&WILD   ) VALUE('*')
0075.16              CHGVAR     VAR(&RESULT ) VALUE(000)
0076.16
0077.16              CALL       PGM(QCLSCAN) PARM(&EZDSQLST &LENCHAR
&STRPOS +
0078.16                           &UPDATE &LENPAT &XLATE &TRIM &WILD
&RESULT)
0079.16
0080.16              IF (&RESULT *GT 0) DO
0082.16              CHGVAR     VAR(&MATCHES) VALUE('1')
0083.16              GOTO       CMDLBL(MATCHES)
0085.16              ENDDO
0086.16
0087.16 DELETE_CHK:
0088.16              CHGVAR     VAR(&LENCHAR) VALUE(512)
0089.16              CHGVAR     VAR(&STRPOS ) VALUE(001)
0090.16              CHGVAR     VAR(&LENPAT ) VALUE(006)
0091.16              CHGVAR     VAR(&XLATE  ) VALUE('1')
0092.16              CHGVAR     VAR(&TRIM   ) VALUE('1')
0093.16              CHGVAR     VAR(&WILD   ) VALUE('*')
0094.16              CHGVAR     VAR(&RESULT ) VALUE(000)
0095.16
0096.16              CALL       PGM(QCLSCAN) PARM(&EZDSQLST &LENCHAR
&STRPOS +
0097.16                           &DELETE &LENPAT &XLATE &TRIM &WILD
&RESULT)
0098.16
0099.16              IF (&RESULT *GT 0) DO
0101.16              CHGVAR     VAR(&MATCHES) VALUE('1')
0102.16              GOTO       CMDLBL(MATCHES)
0104.16              ENDDO
0105.16
0106.16 INSERT_CHK:
0107.16              CHGVAR     VAR(&LENCHAR) VALUE(512)
0108.16              CHGVAR     VAR(&STRPOS ) VALUE(001)
0109.16              CHGVAR     VAR(&LENPAT ) VALUE(006)
0110.16              CHGVAR     VAR(&XLATE  ) VALUE('1')
0111.16              CHGVAR     VAR(&TRIM   ) VALUE('1')
0112.16              CHGVAR     VAR(&WILD   ) VALUE('*')
0113.16              CHGVAR     VAR(&RESULT ) VALUE(000)
0115.16              CALL       PGM(QCLSCAN) PARM(&EZDSQLST &LENCHAR
&STRPOS +
0116.16                           &INSERT &LENPAT &XLATE &TRIM &WILD
&RESULT)
0117.16
0118.16              IF (&RESULT *GT 0) DO
0120.16              CHGVAR     VAR(&MATCHES) VALUE('1')
0121.16              GOTO       CMDLBL(MATCHES)
0123.16              ENDDO
0124.16
0125.16 MATCHES:
0126.16              IF         COND(&MATCHES *EQ '0') THEN(DO)
0127.16              CHGVAR     VAR(&P1) VALUE('1') /* Allow Yes */
0128.16              GOTO       SENDDTA
0129.16              ENDDO
0130.16
0131.16              IF         COND(&MATCHES *EQ '1') THEN(DO)
0132.16              CHGVAR     VAR(&P1) VALUE('0') /* Allow No  */
0133.16              SNDPGMMSG  MSGID(MSG0001) MSGF(MCSGPL/MZDA_SQL1) +
0134.16                           TOMSGQ(*SYSOPR)
0135.16              MONMSG CPF0000
0136.16              GOTO       SENDDTA
0137.16              ENDDO
0138.16
0139.16 SENDDTA:
0140.16
0174.16 ENDPGM:      ENDPGM
        ****************** End of data
****************************************
Just remember to use the WRKREGINF command and remember to start/end  the
Host Server *DATABASE and the PreStart Jobs QZDAINIT and QZDASOINIT they
are
suppossed to run in subsytems QSYSWRK

Another thing is ... If you are dealing with vendors, there are no
guarantees that
every vendor that performs ODBC access to your database is going thru a
registered
IBM exit point.

I hope this hels

Jorge Moreno
Systems Analyst
Woodbury, New York




As an Amazon Associate we earn from qualifying purchases.

This thread ...

Follow-Ups:

Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].

Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.