Utilisation api QUSLOBJ en free syntaxe et full free syntaxe
Posté : mar. 24 mars 2015, 21:51:03
Bonjour,
J'ai un soucis quant à l'utilisation de l'API QUSLOBJ :
Je m'explique, je l'utilise dans un programme RPG LE en free syntaxetil fonctionne, je suis passé depuis peu à l'écriture en full free syntaxe, j'ai donc repris mon programme afin de le moderniser en full free, j'utilise l'API QUSLOBJ et le je m'aperçoit qu'il ne produit rien dans le User Space alors que dans l'autre programme il y à bien production d'une liste d'objets dans le User Space.
Le but étant de pouvoir faire une suppression de bibliothèques en utilisant un nom généric en entrée.
Voici les 2 versions des programmes :
Celui qui fonctionne
H COPYRIGHT('(c) INFOZEN 2015')
H DFTACTGRP(*NO) ActGrp( *CALLER )
H BndDir( 'QC2LE' )
š**********************************************************************************************
š*
š* DS Programme Status
š*
š**********************************************************************************************
D PgmDsStatus SDS
D PROC_NAME *PROC * Procedure name
D PGM_STATUS *STATUS * Status code
D PRV_STATUS 16 20S 0 * Previous status
D LINE_NUM 21 28 * Src list line num
D ROUTINE *ROUTINE * Routine name
D PARMS *PARMS * Num passed parms
D EXCP_TYPE 40 42 * Exception type
D EXCP_NUM 43 46 * Exception number
D Msg_Id 40 46 * Msg Err Complet
D PGM_LIB 81 90 * Program library
D EXCP_DATA 91 170 * Exception data
D EXCP_ID 171 174 * Exception Id
D DATE 191 198 * Date (*DATE fmt)
D YEAR 199 200S 0 * Year (*YEAR fmt)
D LAST_FILE 201 208 * Last file used
D FILE_INFO 209 243 * File error info
D JOB_NAME 244 253 * Job name
D USER 254 263 * User name
D JOB_NUM 264 269S 0 * Job number
D JOB_DATE 270 275S 0 * Date (UDATE fmt)
D RUN_DATE 276 281S 0 * Run date (UDATE)
D RUN_TIME 282 287S 0 * Run time (UDATE)
D CRT_DATE 288 293 * Create date
D CRT_TIME 294 299 * Create time
D CPL_LEVEL 300 303 * Compiler level
D SRC_FILE 304 313 * Source file
D SRC_LIB 314 323 * Source file lib
D SRC_MBR 324 333 * Source file mbr
D PROC_PGM 334 343 * Pgm Proc is in
D PROC_MOD 344 353 * Mod Proc is in
š* Standard error code DS for API error handling
D Error_Code DS 272
D ErrBytesProvd 9B 0 INZ(0)
D ErrBytesAvail 9B 0 INZ(0)
D ErrExcept_ID 7
D ErrReserved 1
D ErrException 256
D P_UsrSpc S *
š* Receiver value DS for user space header info (used in first call to QUSRTVUS)
D GenRcvrDS DS BASED(P_UsrSpc)
D UserArea 1 64
D GenHdrSize 65 68B 0
D StrucLevel 69 72
D FormatName 73 80
D APIused 81 90
D CreateStamp 91 103
D InfoStatus 104 104
D SizeUSused 105 108B 0
D InpParmOff 109 112B 0
D InpParmSiz 113 116B 0
D HeadOffset 117 120B 0
D HeaderSize 121 124B 0
D ListOffset 125 128B 0
D ListSize 129 132B 0
D ListNumber 133 136B 0
D EntrySize 137 140B 0
š* QUSLOBJ format OBJL0700 structure
D P_Obj S *
D ObjL0700DS DS Based(p_Obj) Qus OBJL0700
D*
D L_Object 1 10 Object Name Used
D L_ObjectLib 11 20 Object Lib Name Used
D L_ObjectTyp 21 30 Object Type Used
D QUSIS06 31 31 Information Status
D L_ObjectAtr 32 41 Extended Obj Attr
D QUSTD11 42 91 Text Description
D QUSUDA04 92 101 User Defined Attr
D QUSERVED27 102 108 Reserved
D QUSASP03 109 112B 0 Aux Storage Pool
D L_ObjectOwn 113 122 Object Owner
D QUSOBJD03 123 124 Object Domain
D QUSCDT08 125 132 Create Date Time
D QUSCDT09 133 140 Change Date Time
D QUSORAGE03 141 150 Storage
D QUSOBJCS03 151 151 Object Compress
D QUSAC03 152 152 Allow Change
D QUSCBPGM03 153 153 Changed By Program
D QUSOBJAV03 154 163 Object Audit Value
D QUSDS04 164 164 Digitally Signed
D QUSDSST03 165 165 Digitally Signed Sys
D QUSDSM03 166 166 Digitally Signed Mul
D QUSRSV211 167 168 Reserved2
D QUSLASPN13 169 172B 0 Lib ASP Number
D QUSSFILN04 173 182 Source File Name
D QUSSFLN04 183 192 Source File Lib Name
D QUSSFMN02 193 202 Source File Mbr Name
D QUSSFUDT02 203 215 Source File Update T
D QUSCUP02 216 225 Creator User Profile
D QUSSOBJC02 226 233 System Object Creat
D QUSSL04 234 242 System Level
D QUSPILER02 243 258 Compiler
D QUSOBJL03 259 266 Object Level
D QUSUC02 267 267 User Changed
D QUSLPGM02 268 283 Licensed Program
D QUSPTF02 284 293 PTF
D QUSAPAR02 294 303 APAR
D QUSPG02 304 313 Primary Group
D QUSRSV702 314 315 Reserved7 @B1A
D QUSOSA02 316 316 Optimum Space Align
D QUSASS02 317 320B 0 Associated Space Siz
D QUSRSV303 321 324 Reserved3 @B1C
D QUSOSDT01 325 332 Obj Saved Date Time
D QUSORDT01 333 340 Obj Restored Date Ti
D QUSSS02 341 344B 0 Save Size
D QUSSSM01 345 348B 0 Save Size Multiplier
D QUSSSNBR01 349 352B 0 Save Sequence Number
D QUSSCMD01 353 362 Save Command
D QUSSVID01 363 433 Save Volume ID
D QUSSD03 434 443 Save Device
D QUSSFILN05 444 453 Save File Name
D QUSSFLN05 454 463 Save File Lib Name
D QUSSL05 464 480 Save Label
D QUSSADT01 481 488 Save Active Date Tim
D QUSJS29 489 489 Journal Status @A3A
D QUSJN19 490 499 Journal Name @A3A
D QUSJLIB01 500 509 Journal Library @A3A
D QUSJI01 510 510 Journal Images @A3A
D QUSJEO01 511 511 Journal Entries Omit
D QUSJSDT01 512 519 Journal Start Date
D QUSRSV402 520 532 Reserved4 @A3C
D QUSLUDT00 533 540 Last Used Date Time
D QUSRDT00 541 548 Reset Date Time
D QUSDUC00 549 552B 0 Days Used Count
D QUSUIU00 553 553 Usage Info Update
D QUSASPDN03 554 563 Obj ASP Device Name
D QUSASPDN04 564 573 Lib ASP Device Name
D QUSRSV501 574 576 Reserved5 @A3C
D QUSOBJS 577 580B 0 Object Size
D QUSOBJSM 581 584B 0 Object Size Multip
D QUSOASPI 585 585 Ovflw ASP Indic
D QUSRSV6 586 588 Reserved6
*===============================================================
* Error Information Data Structure +
*===============================================================
*Error Code
DQUSBN DS
* Qus EC
DQUSBNB 1 4B 0 inz(%size(QUSBN))
* Bytes Provided
DQUSBNC 5 8B 0
* Bytes Available
DQUSBND 9 15
* Exception Id
DQUSBNF 16 256
**-- Get system value:
D GetSysVal Pr 4096a Varying
D PxSysVal 10a Const
*
*-- Retrieve system value:
*
D RtvSysVal Pr ExtPgm( 'QWCRSVAL' )
D RcvVar 32767a Options( *VarSize )
D RcvVarLen 10i 0 Const
D NbrSysVal 10i 0 Const
D SysVal 10a Const Dim( 256 )
D Options( *VarSize )
D Error 32767a Options( *VarSize )
D DateSys DS based(ptr2)
D DatSys 26
D DateJour 10 Overlay( DatSys: 1 )
D An 4 Overlay( DateJour: 1 )
D Mo 2 Overlay( DateJour: 6 )
D Jr 2 Overlay( DateJour: 9 )
D Sep1 1 Overlay( DatSys: 11 )
D HeureSys 8 Overlay( DatSys: 12 )
D Hh 2 Overlay( HeureSys: 1 )
D Mn 2 Overlay( HeureSys: 4 )
D Ss 2 Overlay( HeureSys: 7 )
D Sep2 1 Overlay( DatSys: 20 )
D MSs 6 Overlay( DatSys: 21 )
š**********************************************************************************************
š* WORK FIELDS:
š**********************************************************************************************
D Counter S 5 0
D P£LibName S 10
D P£LibType S 5
D P£ASP S 2 0
D P£CrtAut S 10
D P£CrtObjAud S 10
D P£LibText S 50
D P£LibSize S 15 0
D P£LibNbrObj S 9 0
D DataLength S 9B 0 INZ(140)
D CurrentEnt S 5P 0
D ExtendAttr S 10 INZ('USRSPC ')
D InitialSiz S 9B 0 INZ(1024)
D InitialVal S 1 INZ(X'00')
D ObjectType S 10 INZ(*Blanks)
D PublicAut S 10 INZ('*ALL ')
D QualifyObj S 20 INZ(*BLANKS)
D ReplaceSpc S 10 INZ('*YES ')
D StartPos S 9B 0 INZ(1)
D CcsId S 4B 0 INZ(0)
D P_RtnSts S 4B 0 INZ(0)
D TextDescrp S 50 INZ('User space for List Object API')
D UserSpace S 20 INZ('QUSLOBJ QTEMP ')
D Pobj s 10
D msg s 50A
D Ent s 10I 0
D Idx s 10I 0
D Idx2 s 10I 0
D Job_Qual s 20A
D Job_Sts s 12A
D W_ObjAtr s 10a
D waitxx s 5 0 inz(60)
D data s 256a
D qcmExec s 2050a varying
D Job_Qualwrk s 26A
D Job_Etat s 4A
D Quote s 1A inz('''')
D Good s 1N
D rtnLvlId s 13a
D wdatej s 26z
D Grp_Sys s 8a
D Grp_SysSrl s 8a
D Grp_TimStp s 14a
D ExtracValSys s 2050a
D ListFormat S 8
D ListFormat2 S 8 INZ('RHRI0500')
D ListFormat3 S 8 INZ('DEVD1700')
D ListFormat4 S 8 INZ('DEVD1500')
D Resource S 10 INZ(' ')
D ResourceCat S 10i 0 INZ(10)
D ResourceCat1 S 10i 0 INZ(9)
D StrPos S 10i 0 INZ(1)
D StrPos3 S 10i 0 INZ(1)
D wxlog S 256a
D Status S 4A
D W_ObjRnm S 10a
D W_TxtRnm S 50a
D W_TimeStamp S 14a
D P_LibObjD S 10a
D P_LibObjO S 10a INZ('*LIBL')
D Excp_Eror DS Import('_EXCP_MSGID')
D ReturnMsgId 7 Overlay(Excp_Eror : 1)
D ReturnMsgTxt 80 Overlay(Excp_Eror :
**-- API error data structure:
D ERRC0100 Ds Qualified
D BytPrv 10i 0 Inz( %Size( ERRC0100 ))
D BytAvl 10i 0
D MsgId 7a
D 1a
D MsgDta 256a
š**********************************************************************************************
š* CONSTANTS:
š**********************************************************************************************
D C_UnKnow C 'Unknow '
D C_NoApplic C 'Not Applicable '
D C_SuppOnly C 'Supported Only '
D C_NoInstall C 'Not Installed '
D C_Installed C 'Installed '
D C_Error C 'Error '
D NULL c ''
*
* Procedure QUSLOBJ
*
D QusLobj pr ExtPgm('QUSLOBJ ')
D 20a const
D 10a const
D 20a const
D 10a const
D 272a const
*
* retrieve pointer to user space API
*
D QusPtrUs PR ExtPgm('QUSPTRUS')
D UserSpc 20A CONST
D Pointer *
D QcmdExc pr 10i 0 Extproc('system')
D Command * Value Options(*String)
*
* Create user space API
*
D QusCrtUs pr extpgm('QUSCRTUS')
D 20a const
D 10a const
D 9b 0 const
D 1a const
D 10a const
D 50a const
D 10a const
D 272a const
D Main PR ExtPgm('INF_DELBIB')
D 10A
D 10A
D Main PI
D P_NamObjO 10A Nom Origine
D P_TypObjO 10A Typ Origine
/Free
QualifyObj = P_NamObjO + P_LibObjO;
ListFormat = 'OBJL0700';
ObjectType = P_TypObjO;
Callp(e) QUSLOBJ(
UserSpace:
ListFormat:
QualifyObj:
ObjectType:
Error_Code );
// Lecture user space
Callp QUSPTRUS(UserSpace : P_UsrSpc);
// Traitement Des Valeurs retournées dans le USRSPC
// Boucle Lecture
For Ent = 0 to (ListNumber - 1);
// Init Début Liste
p_Obj = P_UsrSpc + ListOffset + (EntrySize * Ent);
ExSr Dlt_Objet;
EndFor;
*InLr = *On;
//*****************************************************************
//* *
//* Suppression Biliothèque *
//* *
//* *
//*****************************************************************
BegSr Dlt_Objet;
QcmdExc( 'DLTLIB LIB(' + %Trim( L_Object ) + ')' );
If ReturnMsgId = *Blanks; // Opération Duplication Réussie !!
EndIf;
EndSr;
//*****************************************************************
//* *
//* init programme *
//* *
//* *
//*****************************************************************
BegSr *InzSr;
//
// Création du USER SPACE
//
Callp(e) QusCrtUs(
UserSpace:
ExtendAttr:
InitialSiz:
InitialVal:
PublicAut:
TextDescrp:
ReplaceSpc:
Error_Code);
EndSr;
/End-Free
Celui qui ne fonctionne pas
//--------------------------------------------------------*
// *
// Séléction et suppression Bibliothèques *
// Full Free Syntax *
// *
// *
//--------------------------------------------------------*
Ctl-Opt DftActGrp( *NO ) ActGrp( *CALLER );
Ctl-Opt BndDir( 'QC2LE' );
Ctl-Opt COPYRIGHT('(c) INFO''ZEN 2015');
// Variables Autonomes
Dcl-s P_UsrSpc Pointer;
Dcl-s P_Obj Pointer;
Dcl-s W_MsgDtaPtr Pointer;
Dcl-s MsgTxt Char(80);
Dcl-s Cmd Char(80);
Dcl-s £Pstk BinDec( 4 : 0 );
Dcl-s £Dlen BinDec( 4 : 0 );
Dcl-s MsgDtaO Char(75);
Dcl-s MsgDtaC Char(75);
Dcl-s MsgDtaCe Char(44);
Dcl-s MsgDtaRe Char(44);
Dcl-s E_UserMail Char(30);
Dcl-s E_AnoUsr1 Char(36);
Dcl-s E_AnoUsr2 Char(50);
Dcl-s £Mflib Char(20);
Dcl-s £MsgTyp Char(10) Inz('*INFO');
Dcl-s £Pgmq Char(20) Dim(1) Inz('QSYSOPR QSYS ');
Dcl-s Q Char(1) inz('''');
Dcl-s ReturnMsgId Char(7) Import('_EXCP_MSGID');
Dcl-s Rep Char(30);
Dcl-s CmdExc VarChar(32767);
Dcl-s PxMsgQue Char(20);
Dcl-s SnMsgQue Char(20);
Dcl-s MsgQName1 Char(20);
Dcl-s MsgType Char(10) inz('*ANY');
Dcl-s MsgTypCpy Char(10) inz('*COPY');
Dcl-s MsgLength Int(10:0) inz(0);
Dcl-s MsgText Char(512) inz(' ');
Dcl-s MsgKey1 Char(4) inz('*TOP');
Dcl-s MsgKey2 Char(4) inz(' ');
Dcl-s CpyMsgKey Char(4) inz(' ');
Dcl-s WaitTime Int(10:0) inz(0);
Dcl-s MsgAction Char(10) inz('*SAME');
Dcl-s MsgRmv Char(10) inz('*NO');
Dcl-s QualifyObj Char(20) INZ(*BLANKS);
Dcl-s ListFormat Char(8);
Dcl-s ObjectType Char(10) INZ(*Blanks);
Dcl-s UserSpace Char(20) INZ('QUSLOBJ QTEMP ');
Dcl-s ExtendAttr Char(10) INZ('USRSPC ');
Dcl-S InitialSiz BinDec(9:0) INZ(1024);
Dcl-s InitialVal Char(1) INZ(X'00');
Dcl-s PublicAut Char(10) INZ('*ALL ');
Dcl-s TextDescrp Char(50) INZ('User space for List Object API');
Dcl-s ReplaceSpc Char(10) INZ('*YES ');
Dcl-s Ent Int(10:0);
// Définition de constantes
Dcl-c Text '*TEXT';
// Définition Data Structure
Dcl-Ds W_Data;
MsgId Char(7) Pos(5);
MsgQName Char(10) Pos(13);
MsgQLib Char(10) Pos(23);
MsgKey Char(4) Pos(387);
MsgF Char(10) Pos(391);
MsgL Char(10) Pos(401);
OffRplDta BinDec(4:0) Pos(441);
End-Ds;
Dcl-Ds Error_Code;
ErrBytesProvd BinDec(4:0) INZ(0) Pos(1);
ErrBytesAvail BinDec(4:0) INZ(0) Pos(5);
ErrExcept_ID Char(7) Pos(9);
ErrReserved Char(1) Pos(16);
ErrException Char(256) Pos(17);
End-Ds;
Dcl-Ds ErrorW;
£Bytp BinDec( 4 : 0 );
£Byta BinDec( 4 : 0 );
£Errid Char(7);
£Error Char(1);
£Exdta Char(240);
End-Ds;
Dcl-Ds ApiError;
AeBytPrv Int(10) Inz( %Size( ApiError ));
AeBytAvl Int(10);
AeExcpId Char(7);
£Error1 Char(1);
AeExcpDta Char(1000);
End-Ds;
Dcl-Ds MsgDta Based(MsgDtaPtr);
UsrPrf Char(10) Pos(11);
Device Char(10) Pos(21);
End-Ds;
Dcl-Ds *N;
RplMsgKey Char(4);
RplKeyBin Int(10:0) overlay(RplMsgKey);
End-Ds;
Dcl-Ds GenRcvrDS BASED(P_UsrSpc);
UserArea Char(64) Pos(1);
GenHdrSize BinDec(4:0) Pos(65);
StrucLevel Char(4) Pos(69);
FormatName Char(8) Pos(73);
APIused Char(10) Pos(81);
CreateStamp Char(13) Pos(91);
InfoStatus Char(1) Pos(104);
SizeUSused BinDec(4:0) Pos(105);
InpParmOff BinDec(4:0) Pos(109);
InpParmSiz BinDec(4:0) Pos(113);
HeadOffset BinDec(4:0) Pos(117);
HeaderSize BinDec(4:0) Pos(121);
ListOffset BinDec(4:0) Pos(125);
ListSize BinDec(4:0) Pos(129);
ListNumber BinDec(4:0) Pos(133);
EntrySize BinDec(4:0) Pos(137);
End-Ds;
Dcl-Ds ObjL0700DS Based(P_Obj);
L_Object Char(10) Pos(1);
L_ObjectLib Char(10) Pos(11);
L_ObjectTyp Char(10) Pos(21);
QUSIS06 Char(1) Pos(31);
L_ObjectAtr Char(10) Pos(32);
QUSTD11 Char(50) Pos(42);
QUSUDA04 Char(10) Pos(92);
QUSERVED27 Char(7) Pos(102);
QUSASP03 BinDec(4:0) Pos(109);
L_ObjectOwn Char(10) Pos(113);
QUSOBJD03 Char(10) Pos(123);
QUSCDT08 Char(8) Pos(125);
QUSCDT09 Char(8) Pos(133);
QUSORAGE03 Char(10) Pos(141);
QUSOBJCS03 Char(1) Pos(151);
QUSAC03 Char(1) Pos(152);
QUSCBPGM03 Char(1) Pos(153);
QUSOBJAV03 Char(10) Pos(154);
QUSDS04 Char(1) Pos(164);
QUSDSST03 Char(1) Pos(165);
QUSDSM03 Char(1) Pos(166);
QUSRSV211 Char(2) Pos(167);
QUSLASPN13 BinDec(4:0) Pos(169);
QUSSFILN04 Char(10) Pos(173);
QUSSFLN04 Char(10) Pos(183);
QUSSFMN02 Char(10) Pos(193);
QUSSFUDT02 Char(13) Pos(203);
QUSCUP02 Char(10) Pos(216);
QUSSOBJC02 Char(8) Pos(226);
QUSSL04 Char(9) Pos(234);
QUSPILER02 Char(16) Pos(243);
QUSOBJL03 Char(8) Pos(259);
QUSUC02 Char(1) Pos(267);
QUSLPGM02 Char(16) Pos(268);
QUSPTF02 Char(10) Pos(284);
QUSAPAR02 Char(10) Pos(294);
QUSPG02 Char(10) Pos(304);
QUSRSV702 Char(2) Pos(314);
QUSOSA02 Char(1) Pos(316);
QUSASS02 BinDec(4:0) Pos(317);
QUSRSV303 Char(4) Pos(321);
QUSOSDT01 Char(8) Pos(325);
QUSORDT01 Char(8) Pos(333);
QUSSS02 BinDec(4:0) Pos(341);
QUSSSM01 BinDec(4:0) Pos(345);
QUSSSNBR01 BinDec(4:0) Pos(349);
QUSSCMD01 Char(10) Pos(353);
QUSSVID01 Char(71) Pos(363);
QUSSD03 Char(10) Pos(434);
QUSSFILN05 Char(10) Pos(444);
QUSSFLN05 Char(10) Pos(454);
QUSSL05 Char(17) Pos(464);
QUSSADT01 Char(8) Pos(481);
QUSJS29 Char(1) Pos(489);
QUSJN19 Char(10) Pos(490);
QUSJLIB01 Char(10) Pos(500);
QUSJI01 Char(1) Pos(510);
QUSJEO01 Char(1) Pos(511);
QUSJSDT01 Char(8) Pos(512);
QUSRSV402 Char(13) Pos(520);
QUSLUDT00 Char(8) Pos(533);
QUSRDT00 Char(8) Pos(541);
QUSDUC00 BinDec(4:0) Pos(549);
QUSUIU00 Char(1) Pos(553);
QUSASPDN03 Char(10) Pos(554);
QUSASPDN04 Char(10) Pos(564);
QUSRSV501 Char(3) Pos(574);
QUSOBJS BinDec(4:0) Pos(577);
QUSOBJSM Bindec(4:0) Pos(581);
QUSOASPI Char(1) Pos(585);
QUSRSV6 Char(3) Pos(586);
End-Ds;
// Définition Procédure
Dcl-Pr QcmdExc ExtProc('system');
Command Pointer value options(*string);
End-Pr;
Dcl-Pr SndMsg ExtPgm('QMHSNDM');
Pr1 Char(7) Const;
Pr2 Char(20) Const;
Pr3 Char(32767) Const Options(*Varsize);
Pr4 Int(10) Const;
Pr5 Char(10) Const;
Pr6 Char(20) Const Dim(50) Options(*Varsize);
Pr7 Int(10) Const;
Pr8 Char(20) Const;
Pr9 Char(4);
Pr10 Char(8000) Options(*Varsize);
End-Pr;
Dcl-Pr SendRply ExtPgm('QMHSNDRM');
RnMsgKey Char(4) Const;
RnMsgQName Char(20) Const;
RnRplTxt Char(32767) Const Options(*Varsize);
RnRplLen Int(10) Const;
RnRmvMsg Char(10) Const;
RnError Char(32767) Const Options(*Varsize);
End-Pr;
// Procedure QUSLOBJ
Dcl-Pr QusLobj ExtPgm('QUSLOBJ');
Lobj1 Char(20) Const;
Lobj2 Char(10) Const;
Lobj3 Char(20) Const;
Lobj4 Char(10) Const;
Lobj5 Char(272) Const;
End-Pr;
// Procedure Créate User Space
Dcl-Pr QusCrtUs ExtPgm('QUSCRTUS');
usrp1 Char(20) Const;
usrp2 Char(10) Const;
usrp3 BinDec(9:0) Const;
usrp4 Char(1) Const;
usrp5 Char(10) Const;
usrp6 Char(50) Const;
usrp7 Char(10) Const;
usrp8 Char(272) Const;
End-Pr;
// Retrieve Pointer User Space
Dcl-Pr QusPtrUs ExtPgm('QUSPTRUS');
UserSpc Char(20) Const;
Pointer Pointer;
End-Pr;
Dcl-Pi Main ExtPgm('INF_DLTLIB');
W_Obj Char(10); // *Généric Admis
W_Type Char(10);
End-Pi;
If W_Type = '*LIB';
QualifyObj = W_Obj + '*LIBL';
ListFormat = 'OBJL0700';
ObjectType = W_Type;
QUSLOBJ(
UserSpace:
ListFormat:
QualifyObj:
ObjectType:
Error_Code );
// Lecture user space
QUSPTRUS(UserSpace : P_UsrSpc);
// Boucle Lecture
For Ent = 0 to (ListNumber - 1);
// Init Début Liste
P_Obj = P_UsrSpc + ListOffset + (EntrySize * Ent);
ExSr Delete_Lib;
EndFor;
EndIf;
*InLr = *On;
//*****************************************************************
//* *
//* Suppression Biliothèque *
//* *
//* *
//*****************************************************************
BegSr Delete_Lib;
QcmdExc( 'DLTLIB LIB(' + %Trim( L_Object ) + ')' );
If ReturnMsgId <> *Blanks; // ça c'est mal passé !!
MsgDtaO = ReturnMsgId + ' Erreur lors suppression ' + L_Object;
SndMsg(
*Blanks
: *Blanks
: MsgDtaO
: %Len(MsgDtaO)
: £Msgtyp
: £pgmq
: %Elem(£pgmq)
: '*PGMQ'
: Msgkey
: Errorw);
EndIf;
EndSr;
//*****************************************************************
//* *
//* init programme *
//* *
//* *
//*****************************************************************
// BegSr Create_UsrSpc;
BegSr *InzSr;
//
// Création du USER SPACE
//
QusCrtUs(
UserSpace:
ExtendAttr:
InitialSiz:
InitialVal:
PublicAut:
TextDescrp:
ReplaceSpc:
Error_Code);
EndSr;
Dans les deux cas le User Space est bien cQUSLOBJ dans le premier cas cela fonctionne, mais pas dans le deuxième cas, pourtant l'appel est le même.
Merci de vos lumières, là je ne vois pas.
Cordialement
J'ai un soucis quant à l'utilisation de l'API QUSLOBJ :
Je m'explique, je l'utilise dans un programme RPG LE en free syntaxetil fonctionne, je suis passé depuis peu à l'écriture en full free syntaxe, j'ai donc repris mon programme afin de le moderniser en full free, j'utilise l'API QUSLOBJ et le je m'aperçoit qu'il ne produit rien dans le User Space alors que dans l'autre programme il y à bien production d'une liste d'objets dans le User Space.
Le but étant de pouvoir faire une suppression de bibliothèques en utilisant un nom généric en entrée.
Voici les 2 versions des programmes :
Celui qui fonctionne
H COPYRIGHT('(c) INFOZEN 2015')
H DFTACTGRP(*NO) ActGrp( *CALLER )
H BndDir( 'QC2LE' )
š**********************************************************************************************
š*
š* DS Programme Status
š*
š**********************************************************************************************
D PgmDsStatus SDS
D PROC_NAME *PROC * Procedure name
D PGM_STATUS *STATUS * Status code
D PRV_STATUS 16 20S 0 * Previous status
D LINE_NUM 21 28 * Src list line num
D ROUTINE *ROUTINE * Routine name
D PARMS *PARMS * Num passed parms
D EXCP_TYPE 40 42 * Exception type
D EXCP_NUM 43 46 * Exception number
D Msg_Id 40 46 * Msg Err Complet
D PGM_LIB 81 90 * Program library
D EXCP_DATA 91 170 * Exception data
D EXCP_ID 171 174 * Exception Id
D DATE 191 198 * Date (*DATE fmt)
D YEAR 199 200S 0 * Year (*YEAR fmt)
D LAST_FILE 201 208 * Last file used
D FILE_INFO 209 243 * File error info
D JOB_NAME 244 253 * Job name
D USER 254 263 * User name
D JOB_NUM 264 269S 0 * Job number
D JOB_DATE 270 275S 0 * Date (UDATE fmt)
D RUN_DATE 276 281S 0 * Run date (UDATE)
D RUN_TIME 282 287S 0 * Run time (UDATE)
D CRT_DATE 288 293 * Create date
D CRT_TIME 294 299 * Create time
D CPL_LEVEL 300 303 * Compiler level
D SRC_FILE 304 313 * Source file
D SRC_LIB 314 323 * Source file lib
D SRC_MBR 324 333 * Source file mbr
D PROC_PGM 334 343 * Pgm Proc is in
D PROC_MOD 344 353 * Mod Proc is in
š* Standard error code DS for API error handling
D Error_Code DS 272
D ErrBytesProvd 9B 0 INZ(0)
D ErrBytesAvail 9B 0 INZ(0)
D ErrExcept_ID 7
D ErrReserved 1
D ErrException 256
D P_UsrSpc S *
š* Receiver value DS for user space header info (used in first call to QUSRTVUS)
D GenRcvrDS DS BASED(P_UsrSpc)
D UserArea 1 64
D GenHdrSize 65 68B 0
D StrucLevel 69 72
D FormatName 73 80
D APIused 81 90
D CreateStamp 91 103
D InfoStatus 104 104
D SizeUSused 105 108B 0
D InpParmOff 109 112B 0
D InpParmSiz 113 116B 0
D HeadOffset 117 120B 0
D HeaderSize 121 124B 0
D ListOffset 125 128B 0
D ListSize 129 132B 0
D ListNumber 133 136B 0
D EntrySize 137 140B 0
š* QUSLOBJ format OBJL0700 structure
D P_Obj S *
D ObjL0700DS DS Based(p_Obj) Qus OBJL0700
D*
D L_Object 1 10 Object Name Used
D L_ObjectLib 11 20 Object Lib Name Used
D L_ObjectTyp 21 30 Object Type Used
D QUSIS06 31 31 Information Status
D L_ObjectAtr 32 41 Extended Obj Attr
D QUSTD11 42 91 Text Description
D QUSUDA04 92 101 User Defined Attr
D QUSERVED27 102 108 Reserved
D QUSASP03 109 112B 0 Aux Storage Pool
D L_ObjectOwn 113 122 Object Owner
D QUSOBJD03 123 124 Object Domain
D QUSCDT08 125 132 Create Date Time
D QUSCDT09 133 140 Change Date Time
D QUSORAGE03 141 150 Storage
D QUSOBJCS03 151 151 Object Compress
D QUSAC03 152 152 Allow Change
D QUSCBPGM03 153 153 Changed By Program
D QUSOBJAV03 154 163 Object Audit Value
D QUSDS04 164 164 Digitally Signed
D QUSDSST03 165 165 Digitally Signed Sys
D QUSDSM03 166 166 Digitally Signed Mul
D QUSRSV211 167 168 Reserved2
D QUSLASPN13 169 172B 0 Lib ASP Number
D QUSSFILN04 173 182 Source File Name
D QUSSFLN04 183 192 Source File Lib Name
D QUSSFMN02 193 202 Source File Mbr Name
D QUSSFUDT02 203 215 Source File Update T
D QUSCUP02 216 225 Creator User Profile
D QUSSOBJC02 226 233 System Object Creat
D QUSSL04 234 242 System Level
D QUSPILER02 243 258 Compiler
D QUSOBJL03 259 266 Object Level
D QUSUC02 267 267 User Changed
D QUSLPGM02 268 283 Licensed Program
D QUSPTF02 284 293 PTF
D QUSAPAR02 294 303 APAR
D QUSPG02 304 313 Primary Group
D QUSRSV702 314 315 Reserved7 @B1A
D QUSOSA02 316 316 Optimum Space Align
D QUSASS02 317 320B 0 Associated Space Siz
D QUSRSV303 321 324 Reserved3 @B1C
D QUSOSDT01 325 332 Obj Saved Date Time
D QUSORDT01 333 340 Obj Restored Date Ti
D QUSSS02 341 344B 0 Save Size
D QUSSSM01 345 348B 0 Save Size Multiplier
D QUSSSNBR01 349 352B 0 Save Sequence Number
D QUSSCMD01 353 362 Save Command
D QUSSVID01 363 433 Save Volume ID
D QUSSD03 434 443 Save Device
D QUSSFILN05 444 453 Save File Name
D QUSSFLN05 454 463 Save File Lib Name
D QUSSL05 464 480 Save Label
D QUSSADT01 481 488 Save Active Date Tim
D QUSJS29 489 489 Journal Status @A3A
D QUSJN19 490 499 Journal Name @A3A
D QUSJLIB01 500 509 Journal Library @A3A
D QUSJI01 510 510 Journal Images @A3A
D QUSJEO01 511 511 Journal Entries Omit
D QUSJSDT01 512 519 Journal Start Date
D QUSRSV402 520 532 Reserved4 @A3C
D QUSLUDT00 533 540 Last Used Date Time
D QUSRDT00 541 548 Reset Date Time
D QUSDUC00 549 552B 0 Days Used Count
D QUSUIU00 553 553 Usage Info Update
D QUSASPDN03 554 563 Obj ASP Device Name
D QUSASPDN04 564 573 Lib ASP Device Name
D QUSRSV501 574 576 Reserved5 @A3C
D QUSOBJS 577 580B 0 Object Size
D QUSOBJSM 581 584B 0 Object Size Multip
D QUSOASPI 585 585 Ovflw ASP Indic
D QUSRSV6 586 588 Reserved6
*===============================================================
* Error Information Data Structure +
*===============================================================
*Error Code
DQUSBN DS
* Qus EC
DQUSBNB 1 4B 0 inz(%size(QUSBN))
* Bytes Provided
DQUSBNC 5 8B 0
* Bytes Available
DQUSBND 9 15
* Exception Id
DQUSBNF 16 256
**-- Get system value:
D GetSysVal Pr 4096a Varying
D PxSysVal 10a Const
*
*-- Retrieve system value:
*
D RtvSysVal Pr ExtPgm( 'QWCRSVAL' )
D RcvVar 32767a Options( *VarSize )
D RcvVarLen 10i 0 Const
D NbrSysVal 10i 0 Const
D SysVal 10a Const Dim( 256 )
D Options( *VarSize )
D Error 32767a Options( *VarSize )
D DateSys DS based(ptr2)
D DatSys 26
D DateJour 10 Overlay( DatSys: 1 )
D An 4 Overlay( DateJour: 1 )
D Mo 2 Overlay( DateJour: 6 )
D Jr 2 Overlay( DateJour: 9 )
D Sep1 1 Overlay( DatSys: 11 )
D HeureSys 8 Overlay( DatSys: 12 )
D Hh 2 Overlay( HeureSys: 1 )
D Mn 2 Overlay( HeureSys: 4 )
D Ss 2 Overlay( HeureSys: 7 )
D Sep2 1 Overlay( DatSys: 20 )
D MSs 6 Overlay( DatSys: 21 )
š**********************************************************************************************
š* WORK FIELDS:
š**********************************************************************************************
D Counter S 5 0
D P£LibName S 10
D P£LibType S 5
D P£ASP S 2 0
D P£CrtAut S 10
D P£CrtObjAud S 10
D P£LibText S 50
D P£LibSize S 15 0
D P£LibNbrObj S 9 0
D DataLength S 9B 0 INZ(140)
D CurrentEnt S 5P 0
D ExtendAttr S 10 INZ('USRSPC ')
D InitialSiz S 9B 0 INZ(1024)
D InitialVal S 1 INZ(X'00')
D ObjectType S 10 INZ(*Blanks)
D PublicAut S 10 INZ('*ALL ')
D QualifyObj S 20 INZ(*BLANKS)
D ReplaceSpc S 10 INZ('*YES ')
D StartPos S 9B 0 INZ(1)
D CcsId S 4B 0 INZ(0)
D P_RtnSts S 4B 0 INZ(0)
D TextDescrp S 50 INZ('User space for List Object API')
D UserSpace S 20 INZ('QUSLOBJ QTEMP ')
D Pobj s 10
D msg s 50A
D Ent s 10I 0
D Idx s 10I 0
D Idx2 s 10I 0
D Job_Qual s 20A
D Job_Sts s 12A
D W_ObjAtr s 10a
D waitxx s 5 0 inz(60)
D data s 256a
D qcmExec s 2050a varying
D Job_Qualwrk s 26A
D Job_Etat s 4A
D Quote s 1A inz('''')
D Good s 1N
D rtnLvlId s 13a
D wdatej s 26z
D Grp_Sys s 8a
D Grp_SysSrl s 8a
D Grp_TimStp s 14a
D ExtracValSys s 2050a
D ListFormat S 8
D ListFormat2 S 8 INZ('RHRI0500')
D ListFormat3 S 8 INZ('DEVD1700')
D ListFormat4 S 8 INZ('DEVD1500')
D Resource S 10 INZ(' ')
D ResourceCat S 10i 0 INZ(10)
D ResourceCat1 S 10i 0 INZ(9)
D StrPos S 10i 0 INZ(1)
D StrPos3 S 10i 0 INZ(1)
D wxlog S 256a
D Status S 4A
D W_ObjRnm S 10a
D W_TxtRnm S 50a
D W_TimeStamp S 14a
D P_LibObjD S 10a
D P_LibObjO S 10a INZ('*LIBL')
D Excp_Eror DS Import('_EXCP_MSGID')
D ReturnMsgId 7 Overlay(Excp_Eror : 1)
D ReturnMsgTxt 80 Overlay(Excp_Eror :
**-- API error data structure:
D ERRC0100 Ds Qualified
D BytPrv 10i 0 Inz( %Size( ERRC0100 ))
D BytAvl 10i 0
D MsgId 7a
D 1a
D MsgDta 256a
š**********************************************************************************************
š* CONSTANTS:
š**********************************************************************************************
D C_UnKnow C 'Unknow '
D C_NoApplic C 'Not Applicable '
D C_SuppOnly C 'Supported Only '
D C_NoInstall C 'Not Installed '
D C_Installed C 'Installed '
D C_Error C 'Error '
D NULL c ''
*
* Procedure QUSLOBJ
*
D QusLobj pr ExtPgm('QUSLOBJ ')
D 20a const
D 10a const
D 20a const
D 10a const
D 272a const
*
* retrieve pointer to user space API
*
D QusPtrUs PR ExtPgm('QUSPTRUS')
D UserSpc 20A CONST
D Pointer *
D QcmdExc pr 10i 0 Extproc('system')
D Command * Value Options(*String)
*
* Create user space API
*
D QusCrtUs pr extpgm('QUSCRTUS')
D 20a const
D 10a const
D 9b 0 const
D 1a const
D 10a const
D 50a const
D 10a const
D 272a const
D Main PR ExtPgm('INF_DELBIB')
D 10A
D 10A
D Main PI
D P_NamObjO 10A Nom Origine
D P_TypObjO 10A Typ Origine
/Free
QualifyObj = P_NamObjO + P_LibObjO;
ListFormat = 'OBJL0700';
ObjectType = P_TypObjO;
Callp(e) QUSLOBJ(
UserSpace:
ListFormat:
QualifyObj:
ObjectType:
Error_Code );
// Lecture user space
Callp QUSPTRUS(UserSpace : P_UsrSpc);
// Traitement Des Valeurs retournées dans le USRSPC
// Boucle Lecture
For Ent = 0 to (ListNumber - 1);
// Init Début Liste
p_Obj = P_UsrSpc + ListOffset + (EntrySize * Ent);
ExSr Dlt_Objet;
EndFor;
*InLr = *On;
//*****************************************************************
//* *
//* Suppression Biliothèque *
//* *
//* *
//*****************************************************************
BegSr Dlt_Objet;
QcmdExc( 'DLTLIB LIB(' + %Trim( L_Object ) + ')' );
If ReturnMsgId = *Blanks; // Opération Duplication Réussie !!
EndIf;
EndSr;
//*****************************************************************
//* *
//* init programme *
//* *
//* *
//*****************************************************************
BegSr *InzSr;
//
// Création du USER SPACE
//
Callp(e) QusCrtUs(
UserSpace:
ExtendAttr:
InitialSiz:
InitialVal:
PublicAut:
TextDescrp:
ReplaceSpc:
Error_Code);
EndSr;
/End-Free
Celui qui ne fonctionne pas
//--------------------------------------------------------*
// *
// Séléction et suppression Bibliothèques *
// Full Free Syntax *
// *
// *
//--------------------------------------------------------*
Ctl-Opt DftActGrp( *NO ) ActGrp( *CALLER );
Ctl-Opt BndDir( 'QC2LE' );
Ctl-Opt COPYRIGHT('(c) INFO''ZEN 2015');
// Variables Autonomes
Dcl-s P_UsrSpc Pointer;
Dcl-s P_Obj Pointer;
Dcl-s W_MsgDtaPtr Pointer;
Dcl-s MsgTxt Char(80);
Dcl-s Cmd Char(80);
Dcl-s £Pstk BinDec( 4 : 0 );
Dcl-s £Dlen BinDec( 4 : 0 );
Dcl-s MsgDtaO Char(75);
Dcl-s MsgDtaC Char(75);
Dcl-s MsgDtaCe Char(44);
Dcl-s MsgDtaRe Char(44);
Dcl-s E_UserMail Char(30);
Dcl-s E_AnoUsr1 Char(36);
Dcl-s E_AnoUsr2 Char(50);
Dcl-s £Mflib Char(20);
Dcl-s £MsgTyp Char(10) Inz('*INFO');
Dcl-s £Pgmq Char(20) Dim(1) Inz('QSYSOPR QSYS ');
Dcl-s Q Char(1) inz('''');
Dcl-s ReturnMsgId Char(7) Import('_EXCP_MSGID');
Dcl-s Rep Char(30);
Dcl-s CmdExc VarChar(32767);
Dcl-s PxMsgQue Char(20);
Dcl-s SnMsgQue Char(20);
Dcl-s MsgQName1 Char(20);
Dcl-s MsgType Char(10) inz('*ANY');
Dcl-s MsgTypCpy Char(10) inz('*COPY');
Dcl-s MsgLength Int(10:0) inz(0);
Dcl-s MsgText Char(512) inz(' ');
Dcl-s MsgKey1 Char(4) inz('*TOP');
Dcl-s MsgKey2 Char(4) inz(' ');
Dcl-s CpyMsgKey Char(4) inz(' ');
Dcl-s WaitTime Int(10:0) inz(0);
Dcl-s MsgAction Char(10) inz('*SAME');
Dcl-s MsgRmv Char(10) inz('*NO');
Dcl-s QualifyObj Char(20) INZ(*BLANKS);
Dcl-s ListFormat Char(8);
Dcl-s ObjectType Char(10) INZ(*Blanks);
Dcl-s UserSpace Char(20) INZ('QUSLOBJ QTEMP ');
Dcl-s ExtendAttr Char(10) INZ('USRSPC ');
Dcl-S InitialSiz BinDec(9:0) INZ(1024);
Dcl-s InitialVal Char(1) INZ(X'00');
Dcl-s PublicAut Char(10) INZ('*ALL ');
Dcl-s TextDescrp Char(50) INZ('User space for List Object API');
Dcl-s ReplaceSpc Char(10) INZ('*YES ');
Dcl-s Ent Int(10:0);
// Définition de constantes
Dcl-c Text '*TEXT';
// Définition Data Structure
Dcl-Ds W_Data;
MsgId Char(7) Pos(5);
MsgQName Char(10) Pos(13);
MsgQLib Char(10) Pos(23);
MsgKey Char(4) Pos(387);
MsgF Char(10) Pos(391);
MsgL Char(10) Pos(401);
OffRplDta BinDec(4:0) Pos(441);
End-Ds;
Dcl-Ds Error_Code;
ErrBytesProvd BinDec(4:0) INZ(0) Pos(1);
ErrBytesAvail BinDec(4:0) INZ(0) Pos(5);
ErrExcept_ID Char(7) Pos(9);
ErrReserved Char(1) Pos(16);
ErrException Char(256) Pos(17);
End-Ds;
Dcl-Ds ErrorW;
£Bytp BinDec( 4 : 0 );
£Byta BinDec( 4 : 0 );
£Errid Char(7);
£Error Char(1);
£Exdta Char(240);
End-Ds;
Dcl-Ds ApiError;
AeBytPrv Int(10) Inz( %Size( ApiError ));
AeBytAvl Int(10);
AeExcpId Char(7);
£Error1 Char(1);
AeExcpDta Char(1000);
End-Ds;
Dcl-Ds MsgDta Based(MsgDtaPtr);
UsrPrf Char(10) Pos(11);
Device Char(10) Pos(21);
End-Ds;
Dcl-Ds *N;
RplMsgKey Char(4);
RplKeyBin Int(10:0) overlay(RplMsgKey);
End-Ds;
Dcl-Ds GenRcvrDS BASED(P_UsrSpc);
UserArea Char(64) Pos(1);
GenHdrSize BinDec(4:0) Pos(65);
StrucLevel Char(4) Pos(69);
FormatName Char(8) Pos(73);
APIused Char(10) Pos(81);
CreateStamp Char(13) Pos(91);
InfoStatus Char(1) Pos(104);
SizeUSused BinDec(4:0) Pos(105);
InpParmOff BinDec(4:0) Pos(109);
InpParmSiz BinDec(4:0) Pos(113);
HeadOffset BinDec(4:0) Pos(117);
HeaderSize BinDec(4:0) Pos(121);
ListOffset BinDec(4:0) Pos(125);
ListSize BinDec(4:0) Pos(129);
ListNumber BinDec(4:0) Pos(133);
EntrySize BinDec(4:0) Pos(137);
End-Ds;
Dcl-Ds ObjL0700DS Based(P_Obj);
L_Object Char(10) Pos(1);
L_ObjectLib Char(10) Pos(11);
L_ObjectTyp Char(10) Pos(21);
QUSIS06 Char(1) Pos(31);
L_ObjectAtr Char(10) Pos(32);
QUSTD11 Char(50) Pos(42);
QUSUDA04 Char(10) Pos(92);
QUSERVED27 Char(7) Pos(102);
QUSASP03 BinDec(4:0) Pos(109);
L_ObjectOwn Char(10) Pos(113);
QUSOBJD03 Char(10) Pos(123);
QUSCDT08 Char(8) Pos(125);
QUSCDT09 Char(8) Pos(133);
QUSORAGE03 Char(10) Pos(141);
QUSOBJCS03 Char(1) Pos(151);
QUSAC03 Char(1) Pos(152);
QUSCBPGM03 Char(1) Pos(153);
QUSOBJAV03 Char(10) Pos(154);
QUSDS04 Char(1) Pos(164);
QUSDSST03 Char(1) Pos(165);
QUSDSM03 Char(1) Pos(166);
QUSRSV211 Char(2) Pos(167);
QUSLASPN13 BinDec(4:0) Pos(169);
QUSSFILN04 Char(10) Pos(173);
QUSSFLN04 Char(10) Pos(183);
QUSSFMN02 Char(10) Pos(193);
QUSSFUDT02 Char(13) Pos(203);
QUSCUP02 Char(10) Pos(216);
QUSSOBJC02 Char(8) Pos(226);
QUSSL04 Char(9) Pos(234);
QUSPILER02 Char(16) Pos(243);
QUSOBJL03 Char(8) Pos(259);
QUSUC02 Char(1) Pos(267);
QUSLPGM02 Char(16) Pos(268);
QUSPTF02 Char(10) Pos(284);
QUSAPAR02 Char(10) Pos(294);
QUSPG02 Char(10) Pos(304);
QUSRSV702 Char(2) Pos(314);
QUSOSA02 Char(1) Pos(316);
QUSASS02 BinDec(4:0) Pos(317);
QUSRSV303 Char(4) Pos(321);
QUSOSDT01 Char(8) Pos(325);
QUSORDT01 Char(8) Pos(333);
QUSSS02 BinDec(4:0) Pos(341);
QUSSSM01 BinDec(4:0) Pos(345);
QUSSSNBR01 BinDec(4:0) Pos(349);
QUSSCMD01 Char(10) Pos(353);
QUSSVID01 Char(71) Pos(363);
QUSSD03 Char(10) Pos(434);
QUSSFILN05 Char(10) Pos(444);
QUSSFLN05 Char(10) Pos(454);
QUSSL05 Char(17) Pos(464);
QUSSADT01 Char(8) Pos(481);
QUSJS29 Char(1) Pos(489);
QUSJN19 Char(10) Pos(490);
QUSJLIB01 Char(10) Pos(500);
QUSJI01 Char(1) Pos(510);
QUSJEO01 Char(1) Pos(511);
QUSJSDT01 Char(8) Pos(512);
QUSRSV402 Char(13) Pos(520);
QUSLUDT00 Char(8) Pos(533);
QUSRDT00 Char(8) Pos(541);
QUSDUC00 BinDec(4:0) Pos(549);
QUSUIU00 Char(1) Pos(553);
QUSASPDN03 Char(10) Pos(554);
QUSASPDN04 Char(10) Pos(564);
QUSRSV501 Char(3) Pos(574);
QUSOBJS BinDec(4:0) Pos(577);
QUSOBJSM Bindec(4:0) Pos(581);
QUSOASPI Char(1) Pos(585);
QUSRSV6 Char(3) Pos(586);
End-Ds;
// Définition Procédure
Dcl-Pr QcmdExc ExtProc('system');
Command Pointer value options(*string);
End-Pr;
Dcl-Pr SndMsg ExtPgm('QMHSNDM');
Pr1 Char(7) Const;
Pr2 Char(20) Const;
Pr3 Char(32767) Const Options(*Varsize);
Pr4 Int(10) Const;
Pr5 Char(10) Const;
Pr6 Char(20) Const Dim(50) Options(*Varsize);
Pr7 Int(10) Const;
Pr8 Char(20) Const;
Pr9 Char(4);
Pr10 Char(8000) Options(*Varsize);
End-Pr;
Dcl-Pr SendRply ExtPgm('QMHSNDRM');
RnMsgKey Char(4) Const;
RnMsgQName Char(20) Const;
RnRplTxt Char(32767) Const Options(*Varsize);
RnRplLen Int(10) Const;
RnRmvMsg Char(10) Const;
RnError Char(32767) Const Options(*Varsize);
End-Pr;
// Procedure QUSLOBJ
Dcl-Pr QusLobj ExtPgm('QUSLOBJ');
Lobj1 Char(20) Const;
Lobj2 Char(10) Const;
Lobj3 Char(20) Const;
Lobj4 Char(10) Const;
Lobj5 Char(272) Const;
End-Pr;
// Procedure Créate User Space
Dcl-Pr QusCrtUs ExtPgm('QUSCRTUS');
usrp1 Char(20) Const;
usrp2 Char(10) Const;
usrp3 BinDec(9:0) Const;
usrp4 Char(1) Const;
usrp5 Char(10) Const;
usrp6 Char(50) Const;
usrp7 Char(10) Const;
usrp8 Char(272) Const;
End-Pr;
// Retrieve Pointer User Space
Dcl-Pr QusPtrUs ExtPgm('QUSPTRUS');
UserSpc Char(20) Const;
Pointer Pointer;
End-Pr;
Dcl-Pi Main ExtPgm('INF_DLTLIB');
W_Obj Char(10); // *Généric Admis
W_Type Char(10);
End-Pi;
If W_Type = '*LIB';
QualifyObj = W_Obj + '*LIBL';
ListFormat = 'OBJL0700';
ObjectType = W_Type;
QUSLOBJ(
UserSpace:
ListFormat:
QualifyObj:
ObjectType:
Error_Code );
// Lecture user space
QUSPTRUS(UserSpace : P_UsrSpc);
// Boucle Lecture
For Ent = 0 to (ListNumber - 1);
// Init Début Liste
P_Obj = P_UsrSpc + ListOffset + (EntrySize * Ent);
ExSr Delete_Lib;
EndFor;
EndIf;
*InLr = *On;
//*****************************************************************
//* *
//* Suppression Biliothèque *
//* *
//* *
//*****************************************************************
BegSr Delete_Lib;
QcmdExc( 'DLTLIB LIB(' + %Trim( L_Object ) + ')' );
If ReturnMsgId <> *Blanks; // ça c'est mal passé !!
MsgDtaO = ReturnMsgId + ' Erreur lors suppression ' + L_Object;
SndMsg(
*Blanks
: *Blanks
: MsgDtaO
: %Len(MsgDtaO)
: £Msgtyp
: £pgmq
: %Elem(£pgmq)
: '*PGMQ'
: Msgkey
: Errorw);
EndIf;
EndSr;
//*****************************************************************
//* *
//* init programme *
//* *
//* *
//*****************************************************************
// BegSr Create_UsrSpc;
BegSr *InzSr;
//
// Création du USER SPACE
//
QusCrtUs(
UserSpace:
ExtendAttr:
InitialSiz:
InitialVal:
PublicAut:
TextDescrp:
ReplaceSpc:
Error_Code);
EndSr;
Dans les deux cas le User Space est bien cQUSLOBJ dans le premier cas cela fonctionne, mais pas dans le deuxième cas, pourtant l'appel est le même.
Merci de vos lumières, là je ne vois pas.
Cordialement
. Je rectifie mon post en conséquence pour ne pas laisser traîner cette erreur qui peut induire en erreur de futurs visiteurs.