*/?------------------------------------------------------------------------------------------? */?® MALLE David programme de service Lecture d'une DATAAREA ? */? CRTRPGMOD MODULE(LIB/PGMXDTAA) ?* */ ? CRTSRVPGM SRVPGM(LIG/PGMXDTAA) ?* */?------------------------------------------------------------------------------------------? H NoMain decedit(',') H COPYRIGHT('David MALLE') ******************************************************** * Prototype Lecture d'une Data Area * ******************************************************** D RtvDtaAra PR 7A D p_RetVal * value D p_DtaAra 10a Const D p_DtaAraLib 10a Const Options(*omit:*nopass) D p_StrPos 5p 0 Const Options(*omit:*nopass) D p_DtaLen 5p 0 Const Options(*omit:*nopass) ******************************************************** * Prototype pour API QWCRDTAA API - Retrieve DTAARA * ******************************************************** D QWCRDTAA PR ExtPgm('QWCRDTAA') D p_Rcvr 1A dim(2000) D p_RcvVarLen 10i 0 Const D p_DtaAra 20a Const D p_StrPos 10i 0 Const D p_DtaLen 10i 0 Const D p_Error 272A options(*varsize) ******************************************************** * DS pour erreur API * ******************************************************** D dsEC DS D BytesProvided 10I 0 inz(%size(dsEC)) D BytesAvail 10I 0 inz(0) D MessageID 7A D Reserved1A 1A D MessageData 240A ******************************************************** * Variables autonomes * ******************************************************** D Error_Exec s 10I 0 * ---------------------------------------------------------------------------------------- * Procédure lecture d'une dtaara * ---------------------------------------------------------------------------------------- P RtvDtaAra B EXPORT D RtvDtaAra PI 7A D p_RtnVal * value D p_DtaAra 10a Const D p_DtaAraLib 10a Const Options(*omit:*nopass) D p_StrPos 5p 0 Const Options(*omit:*nopass) D p_DtaLen 5p 0 Const Options(*omit:*nopass) * Pointeur + DS sur la zone 'receiver' de l'API * Zone 'receiver' de l'API et longueur * Zone 'Return' de l'API, basée sur le pointeur déclarée en paramètres * Zones 'single' D p_SV S * D d_SV DS BASED(p_SV) D d_SVDBytes 10i 0 D d_SVDBytesOut 10i 0 D d_SVDDtaType 10a D d_SVDLibrary 10a D d_SVDLength 10i 0 D d_SVDDecimals 10i 0 D d_SVDValue 2000a * D peRcvVar S 1A DIM(2000) D peRVarLen S 10I 0 inz(2000) * D peRtnVal S 2000A BASED(p_RtnVal) * D wDtaAra s 10a D wDtaAraLib s 10a D wStrPos s 5p 0 D wDtaLen s 5p 0 D qDtaAra s 20a /free // Alimentation des paramètres en entrée wDtaAra = p_DtaAra; if (%addr(p_DtaAraLib) = *null); wDtaAraLib = '*LIBL'; else; wDtaAraLib = p_DtaAraLib; endif; if (%addr(p_StrPos) = *null); wStrPos = 1; else; wStrPos = p_StrPos; endif; // Alimentation des paramètres de l'API if (wDtaAra = '*LDA' or wDtaAra = '*GDA' or wDtaAra = '*PDA'); wDtaAraLib = *Blanks; endif; qDtaAra = wDtaAra + wDtaAraLib; // Appel de l'API pour retreive des infos QWCRDTAA(peRcvVar:peRVarLen:qDtaAra:-1:2000:dsEC); if (BytesAvail > 0); return MessageID; else; p_SV = %addr(peRcvVar); if (%addr(p_DtaLen) = *null); wDtaLen = d_SVDLength - wStrPos + 1; else; wDtaLen = p_DtaLen; endif; %subst(peRtnVal:1:wDtaLen) = %subst(d_SVDValue:wStrPos:wDtaLen); return *blanks; endif; /end-free P RtvDtaAra E