* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Physical File Source * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * A R CP1170 A FILE 10A A FIELD 10A A TYPE 10A A LENGTH 5S 0 A DECIMALS 3S 0 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * CL Program Source * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * File CP1170 must exist for compile purposes. * * DSPFD FILE(CPANDO/CP1170F) TYPE(*ATR) OUTPUT(*OUTFILE) + * * FILEATR(*PF) OUTFILE(CPANDO/CP1170) * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * PGM PARM(&LIBRARY ) DCL VAR(&EOF ) TYPE(*LGL ) LEN( 1) VALUE('0') DCL VAR(&LIBRARY ) TYPE(*CHAR) LEN( 10) DCLF FILE(CP1170) MONMSG MSGID(CPF0000) DSPFD FILE(&LIBRARY/*ALL) TYPE(*ATR) OUTPUT(*OUTFILE) + FILEATR(*PF) OUTFILE(QTEMP/CP1170) TAG: RCVF MONMSG MSGID(CPF0864) EXEC(CHGVAR VAR(&EOF) VALUE('1')) IF COND(¬ &EOF) THEN(DO) CALL PGM(CP1170R) PARM(&PHFILE) GOTO CMDLBL(TAG) ENDDO RETURN ENDPGM * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ILE/RPG Program Source * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * "If it's squinky, then you know it's BrilligWare!" * * * * * * * * Source available at www.brilligware.com * * * * Brillig Enterprises (aka Chris Pando) (c)2007 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * This work is licensed under a * * * * Creative Commons Attribution-NonCommercial-ShareAlike * * * * license: * * * * * * * * http://creativecommons.org/licenses/by-nc-sa/3.0/legalcode * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * The author disclaims all warranties with regard to this * * * * software, including all implied warranties of merchantability * * * * and fitness. In no event shall the author be liable for any * * * * special, indirect or consequential damages or any damages * * * * whatsoever resulting from loss of use, data or profits, * * * * whether in an action of contract, negligence or other * * * * tortious action, arising out of or in connection with the use * * * * or performance of this software. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * This software remains the property of Brillig Enterprises * * * * (aka Chris Pando) and can be used or copied only in * * * * accordance with the terms of the agreement. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Find all occurences of a variable type * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * hactgrp(*caller) dftactgrp(*no) bnddir('QC2LE') * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ... files ... * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Fcp1170f o e disk * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ... procedure interfaces ... * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * entry procedures * d EntryParms pr ExtPgm('CP1170R') d fileName 10a d EntryParms pi d fileName 10a * * * ... internal procedures ... * * * d init pr d process pr * * external procedures (from the C run-time library) * d memcpy pr ExtProc('memcpy') d * Value d * Value d 10i 0 Value * * external programs (from the Object APIs) * dcrtUsrSpc pr ExtPgm('QUSCRTUS') d 20a d 10a d 8b 0 d 1a d 10a d 50a d 10a d 256a drtvPtr pr ExtPgm('QUSPTRUS') d 20a d * * * external programs (from the DataBase APIs) * d rtvFld pr ExtPgm('QUSLFLD') d 20a d 8a d 20a d 10a d 1a d 256a d rtvRcdFmt pr ExtPgm('QUSLRCD') d 20a d 8a d 20a d 1a d 256a * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ... data structures ... * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * d errDS ds d errPrv 10u 0 Inz(%Size(errDS)) d errAvl 10u 0 d errMSGID 7a d 1a Inz(x'00') d errDta 240a d rcdFmtGenDS ds Based(usrSpc@) d rcdFmtDetOSet 125 128b 0 d ds Based(detail@) d rcdFmtRcdFmt 1 10a d rtvFldGenDS ds Based(usrSpc@) d rtvFldDetOSet 125 128b 0 d rtvFldDetCnt 133 136b 0 d rtvFldDetLen 137 140b 0 d ds Based(detail@) d rtvFldFldNam 1 10a d rtvFldFldTyp 11 11a d rtvFldFldLen 21 24b 0 d rtvFldFldDec 29 32b 0 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ... standalone variables ... * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * d qFileName s 20a d rtvRcdFmt_Fmt s 8a Inz('RCDL0100') d rtvFldFmt_Fmt s 8a Inz('FLDL0100') d $I s 3i 0 Inz(1) d usrSpc s 20a inz('CP1170R QTEMP ') d first s n inz(*Off) d ovrPrcss s 1a inz('0') d rcdFmt s Like(rcdFmtRcdFmt) d debug s 1024a Based(debug@) * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ... constants ... * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * d EOJ c '*EOJ ' d splatLIBL c '*LIBL ' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Mainline * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * /free If ( fileName <> EOJ ); init(); process(); Else; *InLR = *On; EndIf; Return; /end-free * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Procedures * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * process * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * p process b d pi /free file = fileName; qFileName = fileName + splatLIBL; // // retrieve record format name // rtvRcdFmt( usrSpc : rtvRcdFmt_Fmt : qFileName : ovrPrcss : errDS ); detail@ = usrSpc@ + rcdFmtDetOSet; rcdFmt = rcdFmtRcdFmt; // // retrieve field descriptions // rtvFld( usrSpc : rtvFldFmt_Fmt : qFileName : rcdFmt : ovrPrcss : errDS ); // // process fields // detail@ = usrSpc@ + rtvFldDetOSet; For $I = 1 to rtvFldDetCnt; field = rtvFldFldNam; type = rtvFldFldTyp; length = rtvFldFldLen; decimals = rtvFldFldDec; write cp1170; detail@ = detail@ + rtvFldDetLen; EndFor; Return; /end-free p process e * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Initialisation logic * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * p init b d pi d size s 8b 0 inz(16776704) d aut s 10a inz('*ALL') d delete s 10a inz('*YES') d blanks256 s 256a Inz(*Blanks) d hex00 s 1a Inz(x'00') d szObj s 10i 0 /free If ( Not first ); first = *On; crtusrspc( usrSpc : blanks256 : size : hex00 : aut : blanks256 : delete : errDS ); rtvPtr( usrSpc : usrSpc@ ); EndIf; Return; /end-free p init e