H NoMain H OPTION(*SRCSTMT) * ---------------------------------------------------- * Procédure SQL * Description : Obtenir une liste d'objets AS400 * Par : David Malle * ---------------------------------------------------- * 1) CRTRPGMOD MODULE(BIB/UDTFOBJLST) * SRCFILE(BIB/QRPGLESRC) * 2) CRTSRVPGM SRVPGM(BIB/UDTFOBJLST) * EXPORT(*ALL) * ---------------------------------------------------- D UDTFOBJLST PR // Input Parameters D inObj 10A Varying D inType 10A Varying D inLib 10A Varying // Output Parameters D outLib 10A D outObj 10A D outType 10A D outExtA 10A D outText 50A D outCrtStamp 19A D outChgStamp 19A D outUser 10A // Null Indicator Input Parameters D inObj_NI 5I 0 D inType_NI 5I 0 D inLib_NI 5I 0 // Null Indicator Output Parameters D outLib_NI 5I 0 D outObj_NI 5I 0 D outType_NI 5I 0 D outExtA_NI 5I 0 D outText_NI 5I 0 D outCrtStampNI 5I 0 D outChgStampNI 5I 0 D outUser_NI 5I 0 // Null Indicator Input Parameters // DB2SQL Style Parameters D pSQLState 5 D pFunctionName 517 D pSpecificName 128 D pSQLMsgText 70 Varying // UDTF Call Type Output Parameters (columns) D pTFCallType 10I 0 * -------------------------------- * API Conversion Date / Heure QWCCVTDT * -------------------------------- DQUSEC DS D* Qus EC D QUSBPRV 1 4B 0 D* Bytes Provided D QUSBAVL 5 8B 0 D* Bytes Available D QUSEI 9 15 D* Exception Id D QUSERVED 16 16 D* Reserved D*QUSED01 17 17 D* D* Varying length DQUSC0200 DS D* Qus ERRC0200 D QUSK01 1 4B 0 D* Key D QUSBPRV00 5 8B 0 D* Bytes Provided D QUSBAVL14 9 12B 0 D* Bytes Available D QUSEI00 13 19 D* Exception Id D QUSERVED39 20 20 D* Reserved D QUSCCSID11 21 24B 0 D* CCSID D QUSOED01 25 28B 0 D* Offset Exc Data D QUSLED01 29 32B 0 D* Length Exc Data D*QUSRSV214 33 33 D* Reserved2 D* D*QUSED02 34 34 D* D* Varying Length àB1A D QWCCVTDT PR ExtPgm('QWCCVTDT') D inFmt 10A Const D inDate 64A Const D outFmt 10A Const D outDate 64A OPTIONS(*VARSIZE) D APIerrorDS LikeDS(QUSEC) OPTIONS(*VARSIZE) D ApiError DS LikeDS(QUSEC) Inz D myDate DS qualified INZ D date 8S 0 D time 6S 0 D milliSeconds 3S 0 * -------------------------------- * API Liste objets * -------------------------------- D QUSLOBJ PR ExtPgm('QUSLOBJ') D UsrSpc 20A const D Format 8A const D ObjectList 20A const D ObjectType 10A const D ErrorCode 272A options(*nopass: *varsize) D QUSCRTUS PR ExtPgm('QUSCRTUS') D UsrSpc 20A CONST D ExtAttr 10A CONST D InitialSize 10I 0 CONST D InitialVal 1A CONST D PublicAuth 10A CONST D Text 50A CONST D Replace 10A CONST D ErrorCode 272A options(*nopass: *varsize) D QUSPTRUS PR ExtPgm('QUSPTRUS') D UsrSpc 20A CONST D Pointer * D QUSDLTUS PR ExtPgm('QUSDLTUS') D UsrSpc 20A CONST D ErrorCode 272A options(*varsize) D p_UsrSpc s * D dsLH DS BASED(p_UsrSpc) D Filler1 103A D Status 1A D Filler2 12A D HdrOffset 10I 0 D HdrSize 10I 0 D ListOffset 10I 0 D ListSize 10I 0 D NumEntries 10I 0 D EntrySize 10I 0 D***************************************************************** D*Type Definition for the OBJL0400 format. D***************************************************************** D p_Entry s * D dsSF DS BASED(p_Entry) D* Qus OBJL0400 D QUSOBJNU02 1 10 D* Object Name Used D QUSOLNU02 11 20 D* Object Lib Name Used D QUSOBJTU02 21 30 D* Object Type Used D QUSIS03 31 31 D* Information Status D QUSEOA01 32 41 D* Extended Obj Attr D QUSTD08 42 91 D* Text Description D QUSUDA01 92 101 D* User Defined Attr D QUSERVED24 102 108 D* Reserved D QUSASP00 109 112B 0 D* Aux Storage Pool D QUSOBJO00 113 122 D* Object Owner D QUSOBJD00 123 124 D* Object Domain D QUSCDT02 125 132 D* Create Date Time D QUSCDT03 133 140 D* Change Date Time D QUSORAGE00 141 150 D* Storage D QUSOBJCS00 151 151 D* Object Compress Status D QUSAC00 152 152 D* Allow Change D QUSCBPGM00 153 153 D* Changed By Program D QUSOBJAV00 154 163 D* Object Audit Value D QUSDS01 164 164 D* Digitally Signed D* àA3A D QUSDSST00 165 165 D* Digitally Signed Sys Trust D* àA4A D QUSDSM00 166 166 D* Digitally Signed Multiple D* àA5C D QUSRSV208 167 168 D* Reserved2 D* àA4C D QUSLASPN10 169 172B 0 D* Lib ASP Number D* àA3A D QUSSFILN 173 182 D* Source File Name D QUSSFLN 183 192 D* Source File Lib Name D QUSSFMN 193 202 D* Source File Mbr Name D QUSSFUDT 203 215 D* Source File Update Date Time D QUSCUP 216 225 D* Creator User Profile D QUSSOBJC 226 233 D* System Object Creation D QUSSL 234 242 D* System Level D QUSPILER 243 258 D* Compiler D QUSOBJL00 259 266 D* Object Level D QUSUC 267 267 D* User Changed D QUSLPGM 268 283 D* Licensed Program D QUSPTF 284 293 D* PTF D QUSAPAR 294 303 D* APAR D QUSPG 304 313 D* Primary Group D QUSRSV7 314 315 D* Reserved7 D* àB1A D QUSOSA 316 316 D* Optimum Space Alignment D* àB1M D QUSASS 317 320B 0 D* Associated Space Size D* àB0A D QUSRSV300 321 324 D* Reserved3 D* àB1C 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 D MYSPACE C CONST('TPUDTFOBJLQTEMP ') D size s 10I 0 D sf s 10I 0 D sl s 10I 0 D ul s 10I 0 D nbr s 10I 0 D msg s 52A D Err_Status s 5I 0 D Pos S 10I 0 DMYPSDS SDS noopt qualified D PROC_NAME *PROC D PGM_STATUS *STATUS D PRV_STATUS 16 20S 0 D LINE_NUM 21 28 D ROUTINE *ROUTINE D PARMS *PARMS D EXCP_TYPE 40 42 D EXCP_NUM 43 46 D PGM_LIB 81 90 D EXCP_DATA 91 170 D EXCP_ID 171 174 D DATE 191 198 D YEAR 199 200S 0 D LAST_FILE 201 208 D FILE_INFO 209 243 D JOB_NAME 244 253 D USER 254 263 D JOB_NUM 264 269S 0 D JOB_DATE 270 275S 0 D RUN_DATE 276 281S 0 D RUN_TIME 282 287S 0 D CRT_DATE 288 293 D CRT_TIME 294 299 D CPL_LEVEL 300 303 D SRC_FILE 304 313 D SRC_LIB 314 323 D SRC_MBR 324 333 D PROC_PGM 334 343 D PROC_MOD 344 353 // ----------------------------- // UDTF call parameter constants // ----------------------------- D UDTF_FirstCall S 10I 0 Inz(-2) D UDTF_Open S 10I 0 Inz(-1) D UDTF_Fetch S 10I 0 Inz(0) D UDTF_Close S 10I 0 Inz(1) D UDTF_LastCall S 10I 0 Inz(2) // ----------------------------- // SQL States // ----------------------------- D SQLSTATEOK C '00000' D ENDOFTABLE C '02000' D UDTF_ERROR C 'US001' // ----------------------------- // NULL Constants // ----------------------------- D ISNULL C -1 D NOTNULL C 0 // ----------------------------- // Booleen // ----------------------------- D FirstFetch s n D NullData s n // ----------------------------- // Paramètres E/S // ----------------------------- D AllText s 10A Inz('*ALL') D CurlibText s 10A Inz('*CURLIB') D ObjectLib s 20A D ObjectType s 10A D ObjectName s 10A D LibName s 10A * ---------------------------------------------------- * Description de procédure * ---------------------------------------------------- P UDTFOBJLST B Export D UDTFOBJLST PI // Input Parameters D inObj 10A Varying D inType 10A Varying D inLib 10A Varying // Output Parameters D outLib 10A D outObj 10A D outType 10A D outExtA 10A D outText 50A D outCrtStamp 19A D outChgStamp 19A D outUser 10A // Null Indicator Input Parameters D inObj_NI 5I 0 D inType_NI 5I 0 D inLib_NI 5I 0 // Null Indicator Output Parameters D outLib_NI 5I 0 D outObj_NI 5I 0 D outType_NI 5I 0 D outExtA_NI 5I 0 D outText_NI 5I 0 D outCrtStampNI 5I 0 D outChgStampNI 5I 0 D outUser_NI 5I 0 // DB2SQL Style Parameters D pSQLState 5 D pFunctionName 517 D pSpecificName 128 D pSQLMsgText 70 Varying // UDTF Call Type Output Parameters (columns) D pTFCallType 10I 0 /free pSQLState=SQLStateOK; Monitor; Select; // ------------- // Function Open // ------------- When pTFCallType=UDTF_Open; FirstFetch = *on; // --------------------------------- // Bib + Objet + Type Objet à lister // --------------------------------- if (inLib = ''); inLib = CurlibText; endif; if (inObj = ''); inObj = AllText; endif; if (inType = ''); inType = AllText; endif; ObjectName = inObj; LibName = inLib; ObjectLib = ObjectName + LibName; ObjectType = InType; // ------------------------------------------ // Supression userspace // Céation userspace // Liste des objets dans le USERSPACE // Pointeur sur le USERSPACE // ------------------------------------------ QUSDLTUS(MYSPACE: dsEC); size = %size(dsLH) + 512 + (%size(dsSF) * 10000); QUSCRTUS(MYSPACE:'USRSPC': size: x'00': '*ALL': 'Temp User Space for QUSLOBJ API': '*YES': dsEC); QUSLOBJ(MYSPACE: 'OBJL0400':ObjectLib:ObjectType:dsEC); QUSPTRUS(MYSPACE: p_UsrSpc); p_Entry = p_UsrSpc + ListOffset; sf = 0; // ----------------------------- // Function Fetch -> Return data // ----------------------------- When pTFCallType=UDTF_Fetch; if FirstFetch; FirstFetch = *off; if ( NumEntries=0 ); outText_NI = ISNULL; outLib_NI = ISNULL; outObj_NI = ISNULL; outType_NI = ISNULL; outExtA_NI = ISNULL; outCrtStampNI = ISNULL; outChgStampNI = ISNULL; outUser_NI = ISNULL; else; outText_NI = NOTNULL; outLib_NI = NOTNULL; outObj_NI = NOTNULL; outType_NI = NOTNULL; outExtA_NI = NOTNULL; outCrtStampNI = NOTNULL; outChgStampNI = NOTNULL; outUser_NI = NOTNULL; endif; endif; sf = sf + 1; // ------------------- // Lecture de l'entrée // ------------------- if (sf <= NumEntries); outObj = QUSOBJNU02; outLib = QUSOLNU02; outType = QUSOBJTU02; outText = QUSTD08; qwccvtdt('*DTS' : QUSCDT02 : '*YYMD' : myDate: ApiError); outCrtStamp = %char(%date(myDate.date:*ISO)) + '-' + %char(%time(myDate.time:*HMS)); qwccvtdt('*DTS' : QUSCDT03 : '*YYMD' : myDate: ApiError); outChgStamp = %char(%date(myDate.date:*ISO)) + '-' + %char(%time(myDate.time:*HMS)); outUser = QUSCUP; outExtA = QUSEOA01; p_Entry = p_Entry + EntrySize; else; // -------------------- // Fin de table // -------------------- pSQLState=ENDOFTABLE; endif; // ------------------------- // Function Close -> CleanUp // ------------------------- When pTFCallType=UDTF_Close; *InLR=*On; EndSl; On-Error; pSQLState=UDTF_ERROR; *InLR=*On; Endmon; Return; /end-free P UDTFOBJLST E