/************************************************************************/ /* File: APILIST.QRPGLESRC generic Serviceprogramm for List APIs */ /* */ /* This program is free software; you can redistribute it and/or modify */ /* it under the terms of the GNU General Public License as published by */ /* the Free Software Foundation. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU General Public License for more details. */ /* */ /* You should have received a copy of the GNU General Public License */ /* along with this program; if not, write to the Free Software */ /* Foundation, Inc., 59 Temple Place, */ /* Suite 330, Boston, MA 02111-1307 USA */ /* You might find a version at http://www.gnu.org */ /************************************************************************/ h nomain h copyright('Dieter Bender 2008-03-13') D*B CRTRPGMOD APILIST D*B+ DBGVIEW(*SOURCE) D*B CRTSRVPGM APILIST D*B+ EXPORT(*ALL) D*B+ ACTGRP(*CALLER) D*B+ BNDDIR(QC2LE) /*--- Prototypes Export ----------------------------------*/ /COPY QRPGLEH,APILIST /*--- Prototypes Import ----------------------------------*/ /COPY QRPGLEH,CEE4RAGE /COPY QRPGLEH,QMHSNDPM /COPY QRPGLEH,USERSPACE /*--- local Prototypes ----------------------------------*/ d exit pr d actMark 10u 0 options(*nopass) d reason 10u 0 options(*nopass) d result 10u 0 options(*nopass) d user 10u 0 options(*nopass) d init pr d error pr d message 80 value d getHeader pr /*--- Constants ----------------------------------*/ d TRUE c *ON d FALSE c *OFF d MAXINST c 32 /*--- Types ----------------------------------*/ d headerType ds qualified based(dummy) d userArea 64 d headerSize 10i 0 d level 4 d format 8 d api 10 d dattim 13 d status 1 d sizeUsed 10i 0 d parmOffset 10i 0 d parmSize 10i 0 d headOffset 10i 0 d headSize 10i 0 d listOffset 10i 0 d listSize 10i 0 d entryCount 10i 0 d entrySize 10i 0 d ccsid 10i 0 d country 2 d language 3 d indicator 1 d fill1 42 d ds align d headP * dim(MAXINST) d curEntryP * dim(MAXINST) d instanceType ds qualified based(dummy) d spaceName 20 d loaded n d curEntrySize 10i 0 d curEntryCount 10i 0 d curEntryNr 10i 0 d eos n d handle 10i 0 /*--- statefull Variables ----------------------------------*/ d thisP s * d this ds likeds(instanceType) d based(thisP) d thisHeadP s * d thisHead ds likeds(headerType) d based(thisHeadP) d inst s like(instanceType) d dim(MAXINST) d inz d instanceCount s 5i 0 inz(0) d initFlag s n inz(FALSE) /*-------------------------------------------------------------*/ /*--- static Section ----------------------------------*/ d Psds SDS d ExceptionType 40 42 d ExceptionNr 43 46 d MessageWork 51 80 d ExceptionData 91 170 d JobNumber 264 269 D CPFMessageId S 7 IMPORT('_EXCP_MSGID') /*--- SQL Work Variables ----------------------------------*/ /*-------------------------------------------------------------*/ p getHandle b export d getHandle pi 10i 0 d UserSpaceName 20 value d result s 10i 0 /free if not initFlag; init(); endif; instanceCount = instanceCount + 1; if instanceCount > MAXINST; error('more than ' + %char(MAXINST) + ' handles'); endif; thisp = %addr(inst(instanceCount)); this.spaceName = userSpaceName; this.handle = instanceCount; return instanceCount; /end-free p getHandle e /*-------------------------------------------------------------*/ p newSpace b export d newSpace pi d handle 10i 0 value d UserSpaceName 20 value /free if not initFlag; init(); endif; thisp = %addr(inst(instanceCount)); clear this; this.spaceName = userSpaceName; this.handle = handle; return; /end-free p newSpace e /*-------------------------------------------------------------*/ p getEntryCount b export d getEntryCount pi 10i 0 d handle 10i 0 value d result s 10i 0 /free if not initFlag; init(); endif; thisp = %addr(inst(handle)); if not this.loaded; getHeader(); endif; result = this.CurEntryCount; return result; /end-free p getEntryCount e /*-------------------------------------------------------------*/ p getEntryLength b export d getEntryLength pi 10i 0 d handle 10i 0 value d result s 10i 0 /free if not initFlag; init(); endif; thisp = %addr(inst(handle)); if not this.loaded; getHeader(); endif; result = this.curEntrySize; return result; /end-free p getEntryLength e /*-------------------------------------------------------------*/ p getNextEntry b export d getNextEntry pi 65535 d handle 10i 0 value d result s 65535 d buf s 65535 based(bufP) d bufP s * /free if not initFlag; init(); endif; thisp = %addr(inst(handle)); if not this.loaded; getHeader(); endif; if not this.eos; bufP = curEntryP(this.handle); result = %subst(buf : 1 : this.curEntrySize); if this.curEntryNr < this.curEntryCount; this.curEntryNr = this.curEntryNr + 1; curEntryP(this.handle) = curEntryP(this.handle) + this.curEntrySize; else; this.eos = TRUE; endif; endif; return result; /end-free p getNextEntry e /*-------------------------------------------------------------*/ p getHeader b d getHeader pi d i s 10i 0 /free i = this.handle; monitor; GetUserSpaceP(this.spaceName : headP(i)); on-error; error('Error ' + exceptionType + exceptionNr + ' ocurred retrievin userspace ' + this.spaceName); endmon; this.loaded = true; thisHeadP = headP(i); this.curEntryCount = thisHead.entryCount; this.curEntrySize = thisHead.entrySize; if this.curEntryCount > 0; this.curEntryNr = 1; curEntryP(i) = headP(i) + thisHead.listOffset; else; this.eos = TRUE; endif; return; /end-free p getHeader e /*-------------------------------------------------------------*/ P error b d error pi d message 80 value /*-------------------------------------------------------------*/ /free sendSysMsg( 'CPF9898' : 'QCPFMSG ' + '*LIBL ' : message : 80 : '*ESCAPE ' : '*PGMBDY ' : 1 : QMHSNDPM_MSGKEY : QMHSNDPM_MSGERR ); return; /end-free P error e /*-------------------------------------------------------------*/ P init b d init pi * called once at begin /*-------------------------------------------------------------*/ /free CEE4RAGE(%paddr(exit) : *OMIT); // TODO your init code initFlag = TRUE; /end-free P init e /*-------------------------------------------------------------*/ P exit b d exit pi * called at very end by runtime d actMark 10u 0 options(*nopass) d reason 10u 0 options(*nopass) d result 10u 0 options(*nopass) d user 10u 0 options(*nopass) /*-------------------------------------------------------------*/ /free // TODO your exit code return; /end-free P exit e