You can create i5/OS™ exit programs using CL commands.
The following example illustrates how to set up a user exit program with control language (CL) commands.
Read the Code example disclaimer for important legal information.
/******************************************************************/ /* */ /* iSeries - SAMPLE USER EXIT PROGRAM */ /* */ /* THE FOLLOWING CL PROGRAM UNCONDITIONALLY */ /* ACCEPTS ALL REQUESTS. IT CAN BE USED AS A SHELL FOR DEVELOPING */ /* EXIT PROGRAMS TAILORED FOR YOUR OPERATING ENVIRONMENT. */ /* */ /* */ /******************************************************************/ PGM PARM(&STATUS &REQUEST) /* * * * * * * * * * * * * * * * * * * */ /* */ /* PROGRAM CALL PARAMETER DECLARATIONS */ /* */ /* * * * * * * * * * * * * * * * * * * */ DCL VAR(&STATUS) TYPE(*CHAR) LEN(1) /* Accept/Reject indicator */ DCL VAR(&REQUEST) TYPE(*CHAR) LEN(9999) /* Parameter structure. LEN(9999) is a CL limit.*/
/***********************************/ /* */ /* PARAMETER DECLARES */ /* */ /***********************************/ /* COMMON DECLARES */ DCL VAR(&USER) TYPE(*CHAR) LEN(10) /* User ID */ DCL VAR(&APPLIC) TYPE(*CHAR) LEN(10) /* Server ID */ DCL VAR(&FUNCTN) TYPE(*CHAR) LEN(10) /* Function being performed */
/* VIRTUAL PRINT DECLARES */ DCL VAR(&VPOBJ) TYPE(*CHAR) LEN(10) /* Object name */ DCL VAR(&VPLIB) TYPE(*CHAR) LEN(10) /* Object library name */ DCL VAR(&VPLEN) TYPE(*DEC) LEN(5 0) /* Length of following fields*/ DCL VAR(&VPOUTQ) TYPE(*CHAR) LEN(10) /* Output queue name */ DCL VAR(&VPQLIB) TYPE(*CHAR) LEN(10) /* Output queue library name */ /* TRANSFER FUNCTION DECLARES */ DCL VAR(&TFOBJ) TYPE(*CHAR) LEN(10) /* Object name */ DCL VAR(&TFLIB) TYPE(*CHAR) LEN(10) /* Object library name */ DCL VAR(&TFMBR) TYPE(*CHAR) LEN(10) /* Member name */ DCL VAR(&TFFMT) TYPE(*CHAR) LEN(10) /* Record format name */ DCL VAR(&TFLEN) TYPE(*DEC) LEN(5 0) /* Length of request */ DCL VAR(&TFREQ) TYPE(*CHAR) LEN(1925) /*Transfer request statement*/ /* FILE SERVER DECLARES */ DCL VAR(&FSFID) TYPE(*CHAR) LEN(4) /* Function identifier */ DCL VAR(&FSFMT) TYPE(*CHAR) LEN(8) /* Parameter format */ DCL VAR(&FSREAD) TYPE(*CHAR) LEN(1) /* Open for read */ DCL VAR(&FSWRITE) TYPE(*CHAR) LEN(1) /* Open for write */ DCL VAR(&FSRDWRT) TYPE(*CHAR) LEN(1) /* Open for read/write */ DCL VAR(&FSDLT) TYPE(*CHAR) LEN(1) /* Open for delete */ DCL VAR(&FSLEN) TYPE(*CHAR) LEN(4) /* fname length */ DCL VAR(&FSNAME) TYPE(*CHAR) LEN(2000) /* Qualified file name */ /* DATA QUEUE DECLARES */ DCL VAR(&DQQ) TYPE(*CHAR) LEN(10) /* Data queue name */ DCL VAR(&DQLIB) TYPE(*CHAR) LEN(10) /* Data queue library name */ DCL VAR(&DQLEN) TYPE(*DEC) LEN(5 0) /* Total request length */ DCL VAR(&DQROP) TYPE(*CHAR) LEN(2) /* Relational operator */ DCL VAR(&DQKLEN) TYPE(*DEC) LEN(5 0) /* Key length */ DCL VAR(&DQKEY) TYPE(*CHAR) LEN(256) /* Key value */ /* REMOTE SQL DECLARES */ DCL VAR(&RSOBJ) TYPE(*CHAR) LEN(10) /* Object name */ DCL VAR(&RSLIB) TYPE(*CHAR) LEN(10) /* Object library name */ DCL VAR(&RSCMT) TYPE(*CHAR) LEN(1) /* Commitment control level*/ DCL VAR(&RSMODE) TYPE(*CHAR) LEN(1) /* Block/Update mode indicator*/ DCL VAR(&RSCID) TYPE(*CHAR) LEN(1) /* Cursor ID */ DCL VAR(&RSSTN) TYPE(*CHAR) LEN(18) /* Statement name */ DCL VAR(&RSRSU) TYPE(*CHAR) LEN(4) /* Reserved */ DCL VAR(&RSREQ) TYPE(*CHAR) LEN(1925)/* SQL statement */
/* NETWORK PRINT SERVER DECLARES */ DCL VAR(&NPFMT) TYPE(*CHAR) LEN(8) /* Format name */ DCL VAR(&NPFID) TYPE(*CHAR) LEN(4) /* Function identifier*/ /* THE FOLLOWING PARAMETERS ADDITIONAL FOR FORMAT SPLF0l00 */ DCL VAR(&NPJOBN) TYPE(*CHAR) LEN(10)/* Job name */ DCL VAR(&NPUSRN) TYPE(*CHAR) LEN(10)/* User name */ DCL VAR(&NPJOB#) TYPE(*CHAR) LEN(6) /* Job number */ DCL VAR(&NPFILE) TYPE(*CHAR) LEN(10)/* File name */ DCL VAR(&NPFIL#) TYPE(*CHAR) LEN(4) /* File number */ DCL VAR(&NPLEN) TYPE(*CHAR) LEN(4) /* Data Length */ DCL VAR(&NPDATA) TYPE(*CHAR) LEN(2000) /* Data */ DCL VAR(&DBNUM) TYPE(*CHAR) LEN(4) /* Number of libraries */ DCL VAR(&DBLIB2) TYPE(*CHAR) LEN(10) /* Library name */
/* DATA QUEUE SERVER DECLARES */ DCL VAR(&DQFMT) TYPE(*CHAR) LEN(8) /* Format name */ DCL VAR(&DQFID) TYPE(*CHAR) LEN(4) /* Function IDENTIFIER */ DCL VAR(&DQOOBJ) TYPE(*CHAR) LEN(10) /* Object name */ DCL VAR(&DQOLIB) TYPE(*CHAR) LEN(10) /* Library name */ DCL VAR(&DQOROP) TYPE(*CHAR) LEN(2) /* Relational operator */ DCL VAR(&DQOLEN) TYPE(*CHAR) LEN(4) /* Key length */ DCL VAR(&DQOKEY) TYPE(*CHAR) LEN(256) /* Key */ /* CENTRAL SERVER DECLARES */ DCL VAR(&CSFMT) TYPE(*CHAR) LEN(8) /* Format name */ DCL VAR(&CSFID) TYPE(*CHAR) LEN(4) /* Function identifier */ /* THE FOLLOWING PARAMETERS ADDITIONAL FOR FORMAT ZSCL0100 */ DCL VAR(&CSCNAM) TYPE(*CHAR) LEN(255) /* Unique client name */ DCL VAR(&CSLUSR) TYPE(*CHAR) LEN(8) /* License users handle */ DCL VAR(&CSPID) TYPE(*CHAR) LEN(7) /* Product identification */ DCL VAR(&CSFID) TYPE(*CHAR) LEN(4) /* Feature identification */ DCL VAR(&CSRID) TYPE(*CHAR) LEN(6) /* Release identification */ DCL VAR(&CSTYPE) TYPE(*CHAR) LEN(2) /* Type of information req */ /* THE FOLLOWING PARAMETERS ADDITIONAL FOR FORMAT ZSCS0100 */ DCL VAR(&CSCNAM) TYPE(*CHAR) LEN(255) /* Unique client name */ DCL VAR(&CSCMTY) TYPE(*CHAR) LEN(255) /* Community name */ DCL VAR(&CSNODE) TYPE(*CHAR) LEN(1) /* Node type */ DCL VAR(&CSNNAM) TYPE(*CHAR) LEN(255) /* Node name */ /* THE FOLLOWING PARAMETERS ADDITIONAL FOR FORMAT ZSCN0100 */ DCL VAR(&CSFROM) TYPE(*CHAR) LEN(4) /* From CCSID */ DCL VAR(&CSTO) TYPE(*CHAR) LEN(4) /* To CCSID */ DCL VAR(&CSCTYP) TYPE(*CHAR) LEN(2) /* Type of conversion */ /* DATABASE SERVER DECLARES */ DCL VAR(&DBFMT) TYPE(*CHAR) LEN(8) /* Format name */ DCL VAR(&DBFID) TYPE(*CHAR) LEN(4) /* Function identifier */
/* THE FOLLOWING PARAMETERS ADDITIONAL FOR FORMAT ZDAD0100 */ DCL VAR(&DBFILE) TYPE(*CHAR) LEN(128) /* File name */ DCL VAR(&DBLIB) TYPE(*CHAR) LEN(10) /* Library name */ DCL VAR(&DBMBR) TYPE(*CHAR) LEN(10) /* Member name */ DCL VAR(&DBAUT) TYPE(*CHAR) LEN(10) /* Authority to file */ DCL VAR(&DBBFIL) TYPE(*CHAR) LEN(128) /* Based on file name */ DCL VAR(&DBBLIB) TYPE(*CHAR) LEN(10) /* Based on library name */ DCL VAR(&DBOFIL) TYPE(*CHAR) LEN(10) /* Override file name */ DCL VAR(&DBOLIB) TYPE(*CHAR) LEN(10) /* Override libraryname */ DCL VAR(&DBOMBR) TYPE(*CHAR) LEN(10) /* Override membername */
/* THE FOLLOWING PARAMETERS ADDITIONAL FOR FORMAT ZDAD0200 */ DCL VAR(&DBNUM) TYPE(*CHAR) LEN(4) /* Number of libraries */ DCL VAR(&DBLIB2) TYPE(*CHAR) LEN(10) /* Library name */ /* THE FOLLOWING PARAMETERS ADDITIONAL FOR FORMAT ZDAQ0100 */ DCL VAR(&DBSTMT) TYPE(*CHAR) LEN(18) /* Statement name */ DCL VAR(&DBCRSR) TYPE(*CHAR) LEN(18) /* Cursor name */ DCL VAR(&DBOPT) TYPE(*CHAR) LEN(2) /* Prepare option */ DCL VAR(&DBATTR) TYPE(*CHAR) LEN(2) /* Open attributes */ DCL VAR(&DBPKG) TYPE(*CHAR) LEN(10) /* Package name */ DCL VAR(&DBPLIB) TYPE(*CHAR) LEN(10) /* Package library name */ DCL VAR(&DBDRDA) TYPE(*CHAR) LEN(2) /* DRDA(R) indicator */ DCL VAR(&DBCMT) TYPE(*CHAR) LEN(1) /* Commit control level*/ DCL VAR(&DBTEXT) TYPE(*CHAR) LEN(512) /* First 512 bytes of stmt */
/* THE FOLLOWING PARAMETERS ADDITIONAL FOR FORMAT ZDAR0100 */ DCL VAR(&DBLIBR) TYPE(*CHAR) LEN(20) /* Library name */ DCL VAR(&DBRDBN) TYPE(*CHAR) LEN(36) /* Relational Database name */ DCL VAR(&DBPKGR) TYPE(*CHAR) LEN(20) /* Package name */ DCL VAR(&DBFILR) TYPE(*CHAR) LEN(256) /* File name (SQL alias) */ DCL VAR(&DBMBRR) TYPE(*CHAR) LEN(20) /* Member name */ DCL VAR(&DBFFMT) TYPE(*CHAR) LEN(20) /* Format name */ /* THE FOLLOWING PARAMETERS ADDITIONAL FOR FORMAT ZDAR0200 */ DCL VAR(&DBPLIB) TYPE(*CHAR) LEN(10) /* Primary key table lib */ DCL VAR(&DBPTBL) TYPE(*CHAR) LEN(128) /* Primary key table */ DCL VAR(&DBFLIB) TYPE(*CHAR) LEN(10) /* Foreign key table lib */ DCL VAR(&DBFTBL) TYPE(*CHAR) LEN(128) /* Foreign key table */ /* REMOTE COMMAND SERVER DECLARES */ DCL VAR(&RCFMT) TYPE(*CHAR) LEN(8) /* Format name */ DCL VAR(&RCFID) TYPE(*CHAR) LEN(4) /* Function identifier */ DCL VAR(&RCPGM) TYPE(*CHAR) LEN(10) /* Program name */ DCL VAR(&RCLIB) TYPE(*CHAR) LEN(10) /* Program library name */ DCL VAR(&RCNUM) TYPE(*CHAR) LEN(4) /* Number of parms or cmdlen*/ DCL VAR(&RCDATA) TYPE(*CHAR) LEN(9999)/* Command string nor parms */ /* SIGNON SERVER DECLARES */ DCL VAR(&SOFMT) TYPE(*CHAR) LEN(8) /* Format name */ DCL VAR(&SOFID) TYPE(*CHAR) LEN(4) /* Function identifier */
/***********************************/ /* */ /* OTHER DECLARES */ /* */ /**********************************/ DCL VAR(&WRKLEN) TYPE(*CHAR) LEN(5) DCL VAR(&DECLEN) TYPE(*DEC) LEN(8 0)
/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ */ /* */ /* EXTRACT THE VARIOUS PARAMETERS FROM THE STRUCTURE */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * */ /* HEADER */ CHGVAR VAR(&USER) VALUE(%SST(&REQUEST 1 10)) CHGVAR VAR(&APPLIC) VALUE(%SST(&REQUEST 11 10)) CHGVAR VAR(&FUNCTN) VALUE(%SST(&REQUEST 21 10)) /* VIRTUAL PRINTER */ CHGVAR VAR(&VPOBJ) VALUE(%SST(&REQUEST 31 10)) CHGVAR VAR(&VPLIB) VALUE(%SST(&REQUEST 41 10)) CHGVAR VAR(&WRKLEN) VALUE(%SST(&REQUEST 71 5)) CHGVAR VAR(&VPLEN) VALUE(%BINARY(&WRKLEN 1 4)) CHGVAR VAR(&VPOUTQ) VALUE(%SST(&REQUEST 76 10)) CHGVAR VAR(&VPQLIB) VALUE(%SST(&REQUEST 86 10))
/* TRANSFER FUNCTION */ CHGVAR VAR(&TFOBJ) VALUE(%SST(&REQUEST 31 10)) CHGVAR VAR(&TFLIB) VALUE(%SST(&REQUEST 41 10)) CHGVAR VAR(&TFMBR) VALUE(%SST(&REQUEST 51 10)) CHGVAR VAR(&TFFMT) VALUE(%SST(&REQUEST 61 10)) CHGVAR VAR(&WRKLEN) VALUE(%SST(&REQUEST 71 5)) CHGVAR VAR(&TFLEN) VALUE(%BINARY(&WRKLEN 1 4)) CHGVAR VAR(&TFREQ) VALUE(%SST(&REQUEST 76 1925)) /* FILE SERVER */ CHGVAR VAR(&FSFID) VALUE(%SST(&REQUEST 21 4)) CHGVAR VAR(&FSFMT) VALUE(%SST(&REQUEST 25 8)) CHGVAR VAR(&FSREAD) VALUE(%SST(&REQUEST 33 1)) CHGVAR VAR(&FSWRITE) VALUE(%SST(&REQUEST 34 1)) CHGVAR VAR(&FSRDWRT) VALUE(%SST(&REQUEST 35 1)) CHGVAR VAR(&FSDLT) VALUE(%SST(&REQUEST 36 1)) CHGVAR VAR(&FSLEN) VALUE(%SST(&REQUEST 37 4)) CHGVAR VAR(&DECLEN) VALUE(%BINARY(&FSLEN 1 4)) CHGVAR VAR(&FSNAME) VALUE(%SST(&REQUEST 41 &DECLEN))
/* DATA QUEUES */ CHGVAR VAR(&DQQ) VALUE(%SST(&REQUEST 31 10)) CHGVAR VAR(&DQLIB) VALUE(%SST(&REQUEST 41 10)) CHGVAR VAR(&WRKLEN) VALUE(%SST(&REQUEST 71 5)) CHGVAR VAR(&DQLEN) VALUE(%BINARY(&WRKLEN 1 4)) CHGVAR VAR(&DQROP) VALUE(%SST(&REQUEST 76 2)) CHGVAR VAR(&WRKLEN) VALUE(%SST(&REQUEST 78 5)) CHGVAR VAR(&DQKLEN) VALUE(&WRKLEN) CHGVAR VAR(&DQKEY) VALUE(%SST(&REQUEST 83 &DQKLEN))
/* REMOTE SQL */ CHGVAR VAR(&RSOBJ) VALUE(%SST(&REQUEST 31 10)) CHGVAR VAR(&RSLIB) VALUE(%SST(&REQUEST 41 10)) CHGVAR VAR(&RSCMT) VALUE(%SST(&REQUEST 51 1)) CHGVAR VAR(&RSMODE) VALUE(%SST(&REQUEST 52 1)) CHGVAR VAR(&RSCID) VALUE(%SST(&REQUEST 53 1)) CHGVAR VAR(&RSSTN) VALUE(%SST(&REQUEST 54 18)) CHGVAR VAR(&RSRSU) VALUE(%SST(&REQUEST 72 4)) CHGVAR VAR(&RSREQ) VALUE(%SST(&REQUEST 76 1925))
/* NETWORK PRINT SERVER */ CHGVAR VAR(&NPFMT) VALUE(%SST(&REQUEST 21 8)) CHGVAR VAR(&NPFID) VALUE(%SST(&REQUEST 29 4)) /* IF FORMAT IS SPLF0100 */ IF COND(&NPFMT *EQ 'SPLF0100') THEN(DO) CHGVAR VAR(&NPJOBN) VALUE(%SST(&REQUEST 33 10)) CHGVAR VAR(&NPUSRN) VALUE(%SST(&REQUEST 43 10)) CHGVAR VAR(&NPJOB#) VALUE(%SST(&REQUEST 53 6)) CHGVAR VAR(&NPFILE) VALUE(%SST(&REQUEST 59 10)) CHGVAR VAR(&NPFIL#) VALUE(%SST(&REQUEST 69 4)) CHGVAR VAR(&NPLEN) VALUE(%SST(&REQUEST 73 4)) CHGVAR VAR(&DECLEN) VALUE(%BINARY(&NPLEN 1 4)) CHGVAR VAR(&NPDATA) VALUE(%SST(&REQUEST 77 &DECLEN)) ENDDO
/* DATA QUEUE SERVER */ CHGVAR VAR(&DQFMT) VALUE(%SST(&REQUEST 21 8)) CHGVAR VAR(&DQFID) VALUE(%SST(&REQUEST 29 4)) CHGVAR VAR(&DQOOBJ) VALUE(%SST(&REQUEST 33 10)) CHGVAR VAR(&DQOLIB) VALUE(%SST(&REQUEST 43 10)) CHGVAR VAR(&DQOROP) VALUE(%SST(&REQUEST 53 2)) CHGVAR VAR(&DQOLEN) VALUE(%SST(&REQUEST 55 4)) CHGVAR VAR(&DQOKEY) VALUE(%SST(&REQUEST 59 256)) /* CENTRAL SERVER */ CHGVAR VAR(&CSFMT) VALUE(%SST(&REQUEST 21 8)) CHGVAR VAR(&CSFID) VALUE(%SST(&REQUEST 29 4)) /* IF FORMAT IS ZSCL0100 */ IF COND(&CSFMT *EQ 'ZSCL0100') THEN(DO) CHGVAR VAR(&CSCNAM) VALUE(%SST(&REQUEST 33 255)) CHGVAR VAR(&CSLUSR) VALUE(%SST(&REQUEST 288 8)) CHGVAR VAR(&CSPID) VALUE(%SST(&REQUEST 296 7)) CHGVAR VAR(&CSFID) VALUE(%SST(&REQUEST 303 4)) CHGVAR VAR(&CSRID) VALUE(%SST(&REQUEST 307 6)) CHGVAR VAR(&CSTYPE) VALUE(%SST(&REQUEST 313 2)) ENDDO
/* IF FORMAT IS ZSCS0100 */ IF COND(&CSFMT *EQ 'ZSCS0100') THEN(DO) CHGVAR VAR(&CSCNAM) VALUE(%SST(&REQUEST 33 255)) CHGVAR VAR(&CSCMTY) VALUE(%SST(&REQUEST 288 255)) CHGVAR VAR(&CSNODE) VALUE(%SST(&REQUEST 543 1)) CHGVAR VAR(&CSNNAM) VALUE(%SST(&REQUEST 544 255)) ENDDO /* IF FORMAT IS ZSCN0100 */ IF COND(&CSFMT *EQ 'ZSCN0100') THEN(DO) CHGVAR VAR(&CSFROM) VALUE(%SST(&REQUEST 33 4)) CHGVAR VAR(&CSTO) VALUE(%SST(&REQUEST 37 4)) CHGVAR VAR(&CSCTYP) VALUE(%SST(&REQUEST 41 2)) ENDDO
/* DATABASE SERVER */ CHGVAR VAR(&DBFMT) VALUE(%SST(&REQUEST 21 8)) CHGVAR VAR(&DBFID) VALUE(%SST(&REQUEST 29 4)) /* IF FORMAT IS ZDAD0100 */ IF COND(&CSFMT *EQ 'ZDAD0100') THEN(DO) CHGVAR VAR(&DBFILE) VALUE(%SST(&REQUEST 33 128)) CHGVAR VAR(&DBLIB) VALUE(%SST(&REQUEST 161 10)) CHGVAR VAR(&DBMBR) VALUE(%SST(&REQUEST 171 10)) CHGVAR VAR(&DBAUT) VALUE(%SST(&REQUEST 181 10)) CHGVAR VAR(&DBBFIL) VALUE(%SST(&REQUEST 191 128)) CHGVAR VAR(&DBBLIB) VALUE(%SST(&REQUEST 319 10)) CHGVAR VAR(&DBOFIL) VALUE(%SST(&REQUEST 329 10)) CHGVAR VAR(&DBOLIB) VALUE(%SST(&REQUEST 339 10)) CHGVAR VAR(&DBOMBR) VALUE(%SST(&REQUEST 349 10)) ENDDO
/* IF FORMAT IS ZDAD0200 */ IF COND(&CSFMT *EQ 'ZDAD0200') THEN(DO) CHGVAR VAR(&DBNUM) VALUE(%SST(&REQUEST 33 4)) CHGVAR VAR(&DBLIB2) VALUE(%SST(&REQUEST 37 10)) ENDDO /* IF FORMAT IS ZDAQ0100 */ IF COND(&CSFMT *EQ 'ZDAQ0100') THEN DO CHGVAR VAR(&DBSTMT) VALUE(%SST(&REQUEST 33 18)) CHGVAR VAR(&DBCRSR) VALUE(%SST(&REQUEST 51 18)) CHGVAR VAR(&DBSOPT) VALUE(%SST(&REQUEST 69 2)) CHGVAR VAR(&DBATTR) VALUE(%SST(&REQUEST 71 2)) CHGVAR VAR(&DBPKG) VALUE(%SST(&REQUEST 73 10)) CHGVAR VAR(&DBPLIB) VALUE(%SST(&REQUEST 83 10)) CHGVAR VAR(&DBDRDA) VALUE(%SST(&REQUEST 93 2)) CHGVAR VAR(&DBCMT) VALUE(%SST(&REQUEST 95 1)) CHGVAR VAR(&DBTEXT) VALUE(%SST(&REQUEST 96 512)) ENDDO
/* IF FORMAT IS ZDAR0100 */ IF COND(&CSFMT *EQ 'ZDAR0100') THEN DO CHGVAR VAR(&DBLIBR) VALUE(%SST(&REQUEST 33 20)) CHGVAR VAR(&DBRDBN) VALUE(%SST(&REQUEST 53 36)) CHGVAR VAR(&DBPKGR) VALUE(%SST(&REQUEST 69 20)) CHGVAR VAR(&DBATTR) VALUE(%SST(&REQUEST 89 20)) CHGVAR VAR(&DBFULR) VALUE(%SST(&REQUEST 109 256)) CHGVAR VAR(&DBMBRR) VALUE(%SST(&REQUEST 365 20)) CHGVAR VAR(&DBFFMT) VALUE(%SST(&REQUEST 385 20)) ENDDO
/* THE FOLLOWING PARAMETERS ADDITIONAL FOR FORMAT ZDAR0200 */ /* IF FORMAT IS ZDAR0200 */ IF COND(&CSFMT *EQ 'ZDAR0200') THEN DO CHGVAR VAR(&DBPLIB) VALUE(%SST(&REQUEST 33 10)) CHGVAR VAR(&DBPTBL) VALUE(%SST(&REQUEST 43 128)) CHGVAR VAR(&DBFLIB) VALUE(%SST(&REQUEST 171 10)) CHGVAR VAR(&DBFTBL) VALUE(%SST(&REQUEST 181 128)) ENDDO
/* REMOTE COMMAND SERVER */ CHGVAR VAR(&RCFMT) VALUE(%SST(&REQUEST 21 8)) CHGVAR VAR(&RCFID) VALUE(%SST(&REQUEST 29 4)) CHGVAR VAR(&RCPGM) VALUE(%SST(&REQUEST 33 10)) CHGVAR VAR(&RCLIB) VALUE(%SST(&REQUEST 43 10)) CHGVAR VAR(&RCNUM) VALUE(%SST(&REQUEST 53 4)) CHGVAR VAR(&RCDATA) VALUE(%SST(&REQUEST 57 6000)) /* SIGNON SERVER DECLARES */ CHGVAR VAR(&SOFNT) VALUE(%SST(&REQUEST 21 8)) CHGVAR VAR(&SOFID) VALUE(%SST(&REQUEST 29 4))
/***********************************/
/* */
/* BEGIN MAIN PROGRAM */
/* */
CHGVAR VAR(&STATUS) VALUE('1') /* INITIALIZE RETURN +
VALUE TO ACCEPT THE REQUEST */
/* ADD LOGIC COMMON TO ALL SERVERS */
/* PROCESS BASED ON SERVER ID */
IF COND(&APPLIC *EQ '*VPRT') THEN(GOTO CMDLBL(VPRT)) /* IF VIRTUAL PRINTER */
IF COND(&APPLIC *EQ '*TFRFCL') THEN(GOTO CMDLBL(TFR)) /* IF TRANSFER FUNCTIO*/
IF COND(&APPLIC *EQ '*FILESRV') THEN(GOTO CMDLBL(FLR)) /* IF FILE SERVERS */
IF COND(&APPLIC *EQ '*MSGFCL') THEN(GOTO CMDLBL(MSG)) /* IF MESSAGING FUNCT */
IF COND(&APPLIC *EQ '*DQSRV') THEN(GOTO CMDLBL(DATAQ)) /* IF DATA QUEUES */
IF COND(&APPLIC *EQ '*RQSRV') THEN(GOTO CMDLBL(RSQL)) /* IF REMOTE SQL */
IF COND(&APPLIC *EQ '*SQL') THEN(GOTO CMDLBL(SQLINIT)) /* IF SQL */
IF COND(&APPLIC *EQ '*NDB') THEN(GOTO CMDLBL(NDB)) /* IF NATIVE DATABASE */
IF COND(&APPLIC *EQ '*SQLSRV') THEN(GOTO CMDLBL(SQLSRV)) /* IF SQL */
IF COND(&APPLIC *EQ '*RTVOBJINF') THEN(GOTO CMDLBL(RTVOBJ)) /* IF RETRIEVE OB*/
IF COND(&APPLIC *EQ '*DATAQSRV') THEN(GOTO CMDLBL(ODATAQ)) /* IF D*/
IF COND(&APPLIC *EQ 'QNPSERVR') THEN(GOTO CMDLBL(NETPRT)) /* IF NETWORK PRI*/
IF COND(&APPLIC *EQ '*CNTRLSRV') THEN(GOTO CMDLBL(CENTRAL)) /* IF CENTRAL SER*/
IF COND(&APPLIC *EQ '*RMTSRV') THEN(GOTO CMDLBL(RMTCMD)) /* IF RMTCMD/DPC */
IF COND(&APPLIC *EQ '*SIGNON') THEN(GOTO CMDLBL(SIGNON)) /* IF SIGNON */
GOTO EXIT
/* * * * * * * * * * * * * * * * * * * * * * */ /* SUBROUTINES */ /* */ /* * * * * * * * * * * * * * * * * * * * * * */ /* VIRTUAL PRlNTER */ VPRT: /* SPECIFIC LOGIC GOES HERE */ GOTO EXIT /* TRANSFER FUNCTION */ TFR: /* SPECIFIC LOGIC GOES HERE */ GOTO EXIT
/* FILE SERVERS */ FLR: /* SPECIFIC LOGIC GOES HERE */ GOTO EXIT /* MESSAGING FUNCTION */ MSG: /* SPECIFIC LOGIC GOES HERE */ GOTO EXIT /* DATA QUEUES */ DATAQ: /* SPECIFIC LOGIC GOES HERE */ GOTO EXIT
/* REMOTE SQL */
RSQL:
/* SPECIFIC LOGIC GOES HERE */
GOTO EXIT /* DATABASE INIT */
SQLINIT:
/* SPECIFIC LOGIC GOES HERE */
GOTO EXIT
/* NATIVE DATABASE */
NDB:
/* SPECIFIC LOGIC GOES HERE */
GOTO EXIT /* DATABASE SQL */
SQLSRV:
/* SPECIFIC LOGIC GOES HERE */
GOTO EXIT
/* RETRIEVE OBJECT INFORMATION */
RTVOBJ:
/* SPECIFIC LOGIC GOES HERE */
GOTO EXIT
/* DATA QUEUE SERVER */
ODATAQ:
/* SPECIFIC LOGIC GOES HERE */
GOTO EXIT /* NETWORK PRINT SERVER */
NETPRT:
/* SPECIFIC LOGIC GOES HERE */
GOTO EXIT /* CENTRAL SERVER */
CENTRAL:
/* SPECIFIC LOGIC GOES HERE */
GOTO EXIT /* REMOTE COMMAND AND DISTRIBUTED PROGRAM CALL */
RMTCMD:
/* IN THIS CASE IF A USER ATTEMPTS TO DO A REMOTE COMMAND AND DISTRIBUTED */
/* PROGRAM CALL AND HAS A USERID OF userid THEY WILL NOT BE ALLOWED TO */
/* CONTINUE.
*/
IF COND(&USER *EQ 'userid') THEN(CHGVAR VAR(&STATUS) VALUE('0'))
GOTO EXIT /* SIGNON SERVER */
SIGNON:
/* SPECIFIC LOGIC GOES HERE */
GOTO EXIT
EXIT: ENDPGM