Utilisation api QUSLOBJ en free syntaxe et full free syntaxe
-
- Messages : 20
- Enregistré le : mer. 18 févr. 2015, 20:41:00
Utilisation api QUSLOBJ en free syntaxe et full free syntaxe
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
-
- Site Admin
- Messages : 813
- Enregistré le : mer. 14 févr. 2007, 18:00:03
- Localisation : Nantes
- Contact :
pas facile
ce post n'est pas très facile à lire, si vous pouvez utilisez la balise code pour placer du RPG
sinon, le user space est-il créé ? contient-il qqchose (DMPOBJ pour le voir)
faites un DEBUG et regardez si vous avez un code erreur dans la DS error_code (en cas de pépin, l'API ne plante pas mais place le code erreur dans cette DS)
Code : Tout sélectionner
comme ceci
faites un DEBUG et regardez si vous avez un code erreur dans la DS error_code (en cas de pépin, l'API ne plante pas mais place le code erreur dans cette DS)
Christian Massé (Volubis.fr)
-
- Messages : 11
- Enregistré le : lun. 02 févr. 2015, 19:46:00
En effet, utiliser la balise rendra le RPG moins difficile à lire.
Néanmoins, j'ai une question. Dans la définition suivante :
Y a-t-il bien 3 blancs entre le nom du user space QUSLOBJ et celui de la bibliothèque QTEMP ? On ne pas juger sur le post où le programme a été publié, à cause du manque d'indentation et de respect des espaces d'origine.
Code : Tout sélectionner
code
Néanmoins, j'ai une question. Dans la définition suivante :
Code : Tout sélectionner
Dcl-s UserSpace Char(20) INZ('QUSLOBJ QTEMP ');
-
- Messages : 20
- Enregistré le : mer. 18 févr. 2015, 20:41:00
API QUSLOBJ
Bonjour,
Le User Space est bien créé dans les deux cas et dans les deux cas il est bien rempli des informations attendues à savoir : liste des bibliothèques qui commencent par B1 (B1* en paramètre d'entrée)
dans le premier cas le nombre d'éléments retournés est 3 et dans le second cas le nombre d'éléments retournés est 0
Je post le dump avec les balises (si j'y arrive)
/b
F5F1F1F3 F8F2F9C3 000008F8 000000C0 000000A0 00000000 00000000 00000160 *5113829C 8 é ` -*
00000798 00000003 00000288 00000000 00000000 00000000 00000000 00000000 * q h *
00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000 * *
D8E4E2D3 D6C2D140 4040D8E3 C5D4D740 40404040 D6C2D1D3 F0F7F0F0 C2F15C40 *QUSLOBJ QTEMP OBJL0700B1* *
40404040 40405CD3 C9C2D340 40404040 5CD3C9C2 40404040 40400000 00004040 * *LIBL *LIB *
00000030 00000000 00000080 00000001 0000008A 00000001 00000015 00000000 * « *
00000094 00000001 00000018 5C404040 40404040 40404040 40404040 40404040 * m * *
5CC1D5E8 40404040 40405CC5 E7C5C3E4 E3C54040 5C000000 00000000 00000000 **ANY *EXECUTE * *
C2F1C9D5 C6F14040 4040D8E2 E8E24040 40404040 5CD3C9C2 40404040 404040D7 *B1INF1 QSYS *LIB P*
D9D6C440 40404040 40404040 40404040 40404040 40404040 40404040 40404040 *ROD *
40404040 40404040 40404040 40404040 40404040 40404040 40404040 40404040 * *
40404040 40000000 00000000 00000001 C9D5C6D6 E9C5D540 40405CE2 9B51A197 * INFOZEN *Sº{¨p*
B7890000 9B51A197 E7D52001 5CD2C5C5 D7404040 4040E7F1 F05CD5D6 D5C54040 *¼i º{¨pXN *KEEP X10*NONE *
404040F0 F0F00000 00000001 40404040 40404040 40404040 40404040 40404040 * 000 *
40404040 40404040 40404040 40404040 40404040 404040C9 D5C6D6E9 C5D54040 * INFOZEN *
40E2C9C7 F4F0F040 40E5F0F7 D9F0F1D4 F0F04040 40404040 40404040 40404040 * SIG400 V07R01M00 *
40404040 40404040 4040F140 40404040 40404040 40404040 40404040 40404040 * 1 *
40404040 40404040 40404040 4040405C D5D6D5C5 40404040 400000F1 00002000 * *NONE 1 *
00000000 00000000 00000000 00000000 00000000 00000000 00000001 00000000 * *
b/
Le User Space est bien créé dans les deux cas et dans les deux cas il est bien rempli des informations attendues à savoir : liste des bibliothèques qui commencent par B1 (B1* en paramètre d'entrée)
dans le premier cas le nombre d'éléments retournés est 3 et dans le second cas le nombre d'éléments retournés est 0
Je post le dump avec les balises (si j'y arrive)
/b
F5F1F1F3 F8F2F9C3 000008F8 000000C0 000000A0 00000000 00000000 00000160 *5113829C 8 é ` -*
00000798 00000003 00000288 00000000 00000000 00000000 00000000 00000000 * q h *
00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000 * *
D8E4E2D3 D6C2D140 4040D8E3 C5D4D740 40404040 D6C2D1D3 F0F7F0F0 C2F15C40 *QUSLOBJ QTEMP OBJL0700B1* *
40404040 40405CD3 C9C2D340 40404040 5CD3C9C2 40404040 40400000 00004040 * *LIBL *LIB *
00000030 00000000 00000080 00000001 0000008A 00000001 00000015 00000000 * « *
00000094 00000001 00000018 5C404040 40404040 40404040 40404040 40404040 * m * *
5CC1D5E8 40404040 40405CC5 E7C5C3E4 E3C54040 5C000000 00000000 00000000 **ANY *EXECUTE * *
C2F1C9D5 C6F14040 4040D8E2 E8E24040 40404040 5CD3C9C2 40404040 404040D7 *B1INF1 QSYS *LIB P*
D9D6C440 40404040 40404040 40404040 40404040 40404040 40404040 40404040 *ROD *
40404040 40404040 40404040 40404040 40404040 40404040 40404040 40404040 * *
40404040 40000000 00000000 00000001 C9D5C6D6 E9C5D540 40405CE2 9B51A197 * INFOZEN *Sº{¨p*
B7890000 9B51A197 E7D52001 5CD2C5C5 D7404040 4040E7F1 F05CD5D6 D5C54040 *¼i º{¨pXN *KEEP X10*NONE *
404040F0 F0F00000 00000001 40404040 40404040 40404040 40404040 40404040 * 000 *
40404040 40404040 40404040 40404040 40404040 404040C9 D5C6D6E9 C5D54040 * INFOZEN *
40E2C9C7 F4F0F040 40E5F0F7 D9F0F1D4 F0F04040 40404040 40404040 40404040 * SIG400 V07R01M00 *
40404040 40404040 4040F140 40404040 40404040 40404040 40404040 40404040 * 1 *
40404040 40404040 40404040 4040405C D5D6D5C5 40404040 400000F1 00002000 * *NONE 1 *
00000000 00000000 00000000 00000000 00000000 00000000 00000001 00000000 * *
b/
-
- Messages : 20
- Enregistré le : mer. 18 févr. 2015, 20:41:00
Code:
//--------------------------------------------------------*
// *
// 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;
//--------------------------------------------------------*
// *
// 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;
-
- Messages : 20
- Enregistré le : mer. 18 févr. 2015, 20:41:00
Oui il y a bien 3 espace entrePhilippe S a écrit :En effet, utiliser la baliserendra le RPG moins difficile à lire.Code : Tout sélectionner
code
Néanmoins, j'ai une question. Dans la définition suivante :Y a-t-il bien 3 blancs entre le nom du user space QUSLOBJ et celui de la bibliothèque QTEMP ? On ne pas juger sur le post où le programme a été publié, à cause du manque d'indentation et de respect des espaces d'origine.Code : Tout sélectionner
Dcl-s UserSpace Char(20) INZ('QUSLOBJ QTEMP ');
-
- Messages : 20
- Enregistré le : mer. 18 févr. 2015, 20:41:00
Code : Tout sélectionner
//--------------------------------------------------------*
// *
// 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;
Modifié en dernier par Alain MOIROUD le lun. 13 avr. 2015, 22:51:39, modifié 1 fois.
-
- Messages : 20
- Enregistré le : mer. 18 févr. 2015, 20:41:00
Code : Tout sélectionner
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 : 8)
**-- 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
P GetSysVal B Export
D Pi 4096a Varying
D PxSysVal 10a Const
**-- Local variables:
D Idx s 10i 0
D SysVal s 4096a Varying
**
D ApiPrm Ds Qualified
D RtnVarLen 10i 0
D SysValNbr 10i 0 Inz( %Elem( ApiPrm.SysVal ))
D SysVal 10a Dim( 1 )
**
D RtnVar Ds Qualified
D RtnVarNbr 10i 0
D RtnVarOfs 10i 0 Dim( %Elem( ApiPrm.SysVal ))
D RtnVarDta 4096a
**
D SysValInf Ds Qualified Based( pSysVal )
D SysValKwd 10a
D DtaTyp 1a
D InfSts 1a
D DtaLen 10i 0
D Dta 4096a
D DtaInt 10i 0 Overlay( Dta )
/Free
ApiPrm.RtnVarLen = %Elem( ApiPrm.SysVal ) * 24 + %Size( SysVal ) + 4;
ApiPrm.SysVal(1) = PxSysVal;
RtvSysVal( RtnVar
: ApiPrm.RtnVarLen
: ApiPrm.SysValNbr
: ApiPrm.SysVal
: ERRC0100
);
If ERRC0100.BytAvl > *Zero;
SysVal = NULL;
Else;
For Idx = 1 to RtnVar.RtnVarNbr;
pSysVal = %Addr( RtnVar ) + RtnVar.RtnVarOfs(Idx);
If SysValInf.SysValKwd = PxSysVal;
Select;
When SysValInf.DtaTyp = 'C';
SysVal = %Subst( SysValInf.Dta: 1: SysValInf.DtaLen );
When SysValInf.DtaTyp = 'B';
SysVal = %Char( SysValInf.DtaInt );
Other;
SysVal = NULL;
EndSl;
EndIf;
EndFor;
EndIf;
Return SysVal;
/End-Free
P GetSysVal E
-
- Messages : 20
- Enregistré le : mer. 18 févr. 2015, 20:41:00
DUMP du User Space
Code : Tout sélectionner
852319/INFOZEN/QPADEV0009
MPOBJ PARAMETERS
OBJ-QUSLOBJ CONTEXT- QTEMP
OBJTYPE-*USRSPC
OBJECT TYPE- SPACE *USRSPC
NAME- QUSLOBJ TYPE- 19 SUBTYPE- 34
LIBRARY- QTEMP 04CF9B50E6A09DC19001 TYPE- 04 SUBTYPE- C1
CREATION- 25/03/15 11:38:29 SIZE- 0000002000
OWNER- INFOZEN TYPE- 08 SUBTYPE- 01
ATTRIBUTES- 0800 ADDRESS- 0F1B8AEE2B 000000
PACE ATTRIBUTES-
000000 00FFF000 00000074 1934D8E4 E2D3D6C2 D1404040 40404040 40404040 40404040 * 0 È QUSLOBJ *
000020 40404040 40404040 E0000000 00000000 00001000 00110000 00000000 00000000 * \ *
000040 00000000 00000000 1F916F64 57000400 00000000 00000000 00000000 00000000 * j?Àï *
000060 00000000 00000000 00000000 00000000 00FFF000 * 0 *
SPACE-
000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000 * *
000020 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000 * *
000040 00000080 F0F1F0F0 D6C2D1D3 F0F7F0F0 D8E4E2D3 D6C2D140 4040F1F1 F5F0F3F2 * 0100OBJL0700QUSLOBJ 115032*
000060 F5F1F1F3 F8F2F9C3 000008F8 000000C0 000000A0 00000000 00000000 00000160 *5113829C 8 { µ -*
000080 00000798 00000003 00000288 00000000 00000000 00000000 00000000 00000000 * q h *
0000A0 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000 * *
0000C0 D8E4E2D3 D6C2D140 4040D8E3 C5D4D740 40404040 D6C2D1D3 F0F7F0F0 C2F15C40 *QUSLOBJ QTEMP OBJL0700B1* *
0000E0 40404040 40405CD3 C9C2D340 40404040 5CD3C9C2 40404040 40400000 00004040 * *LIBL *LIB *
000100 00000030 00000000 00000080 00000001 0000008A 00000001 00000015 00000000 * « *
000120 00000094 00000001 00000018 5C404040 40404040 40404040 40404040 40404040 * m * *
000140 5CC1D5E8 40404040 40405CC5 E7C5C3E4 E3C54040 5C000000 00000000 00000000 **ANY *EXECUTE * *
000160 C2F1C9D5 C6F14040 4040D8E2 E8E24040 40404040 5CD3C9C2 40404040 404040D7 *B1INF1 QSYS *LIB P*
000180 D9D6C440 40404040 40404040 40404040 40404040 40404040 40404040 40404040 *ROD *
0001A0 40404040 40404040 40404040 40404040 40404040 40404040 40404040 40404040 * *
0001C0 40404040 40000000 00000000 00000001 C9D5C6D6 E9C5D540 40405CE2 9B51A197 * INFOZEN *Sºé~p*
0001E0 B7890000 9B51A197 E7D52001 5CD2C5C5 D7404040 4040E7F1 F05CD5D6 D5C54040 *¼i ºé~pXN *KEEP X10*NONE *
000200 404040F0 F0F00000 00000001 40404040 40404040 40404040 40404040 40404040 * 000 *
000220 40404040 40404040 40404040 40404040 40404040 404040C9 D5C6D6E9 C5D54040 * INFOZEN *
000240 40E2C9C7 F4F0F040 40E5F0F7 D9F0F1D4 F0F04040 40404040 40404040 40404040 * SIG400 V07R01M00 *
000260 40404040 40404040 4040F140 40404040 40404040 40404040 40404040 40404040 * 1 *
000280 40404040 40404040 40404040 4040405C D5D6D5C5 40404040 400000F1 00002000 * *NONE 1 *
0002A0 00000000 00000000 00000000 00000000 00000000 00000000 00000001 00000000 * *
0002C0 40404040 40404040 40404040 40404040 40404040 40404040 40404040 40404040 * *
LINES 0002E0 TO 00033F SAME AS ABOVE
000340 00000000 00000000 F0404040 40404040 40404040 40404040 40404040 40404000 * 0 *
000360 00000000 00000040 00000000 00000000 00000000 00000000 00000000 00000000 * *
000380 00000000 00000000 D55CE2E8 E2C2C1E2 4040405C E2E8E2C2 C1E24040 40000000 * N*SYSBAS *SYSBAS *
0003A0 00012000 00000001 F05CE2E8 E2C2C1E2 4040405C E2E8E2C2 C1E24040 40000000 * 0*SYSBAS *SYSBAS *
0003C0 00000000 00000000 00000000 00000000 00000000 00000000 00000000 00000000 * *
0003E0 00000000 00000000 C2F1C9D5 C6F24040 4040D8E2 E8E24040 40404040 5CD3C9C2 * B1INF2 QSYS *LIB*
000400 40404040 404040D7 D9D6C440 40404040 40404040 40404040 40404040 40404040 * PROD *
000420 40404040 40404040 40404040 40404040 40404040 40404040 40404040 40404040 * *
000440 40404040 40404040 40404040 40000000 00000000 00000001 C9D5C6D6 E9C5D540 * INFOZEN *
000460 40405CE2 9B51A19C 7C3D0000 9B51A19D 60267001 5CD2C5C5 D7404040 4040E7F1 * *Sºé~æ@ ºé~¸- ø *KEEP X1*
000480 F05CD5D6 D5C54040 404040F0 F0F00000 00000001 40404040 40404040 40404040 *0*NONE 000 *
0004A0 40404040 40404040 40404040 40404040 40404040 40404040 40404040 404040C9 * I*
0004C0 D5C6D6E9 C5D54040 40E2C9C7 F4F0F040 40E5F0F7 D9F0F1D4 F0F04040 40404040 *NFOZEN SIG400 V07R01M00 *
0004E0 40404040 40404040 40404040 40404040 4040F140 40404040 40404040 40404040 * 1 *
-
- Messages : 20
- Enregistré le : mer. 18 févr. 2015, 20:41:00
Codes et dump
Voilà ci-dessus le code des deux progammes et extrait du dump user space lorsque je lance INF_DLTLIB
Il est bien rempli mais apparemment le nombre d'éléments retournés est = 0 quand je suis en débug du programme
Merci de votre aide
Il est bien rempli mais apparemment le nombre d'éléments retournés est = 0 quand je suis en débug du programme
Merci de votre aide
-
- Messages : 11
- Enregistré le : lun. 02 févr. 2015, 19:46:00
-
- Messages : 20
- Enregistré le : mer. 18 févr. 2015, 20:41:00
Bonjour,
Merci de la réponse, effectivement il y avait bien 3 éléments retournés. Le problème venait de la définition de la DS GenRcvDS, voici la correction apportée :
Dans ce type de description en full free et surtout lorsqu'on fait du positionnel les zones de type binary ne doivent pas e^tre définies en 4:0 qui est l'espace occupé par la zone dans le buffer, mais plutot la taille 9:0 qui renvoi bien les nombres attendus.
En clair :
ListNumber 133 136B 0 en free syntaxe c'est bien longueur 4
il faut pour avoir la même utilisation en full free puisque que l'on ne peut plus utilisé les positions dans une DS déclarée en DCL-DS donc :
ListNumber BinDec(9:0) Pos(133); format étendu
Voilà c'est du moins ce que j'ai compris, mais peut être mes explications ne seront pas suffisamment claires.
En tous cas merci de votre aide
Merci de la réponse, effectivement il y avait bien 3 éléments retournés. Le problème venait de la définition de la DS GenRcvDS, voici la correction apportée :
Code : Tout sélectionner
Dcl-Ds GenRcvrDS BASED(P_UsrSpc);
UserArea Char(64) Pos(1);
GenHdrSize BinDec(9: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(9:0) Pos(105);
InpParmOff BinDec(9:0) Pos(109);
InpParmSiz BinDec(9:0) Pos(113);
HeadOffset BinDec(9:0) Pos(117);
HeaderSize BinDec(9:0) Pos(121);
ListOffset BinDec(9:0) Pos(125);
ListSize BinDec(9:0) Pos(129);
ListNumber BinDec(9:0) Pos(133);
EntrySize BinDec(9:0) Pos(137);
End-Ds;
En clair :
ListNumber 133 136B 0 en free syntaxe c'est bien longueur 4
il faut pour avoir la même utilisation en full free puisque que l'on ne peut plus utilisé les positions dans une DS déclarée en DCL-DS donc :
ListNumber BinDec(9:0) Pos(133); format étendu
Voilà c'est du moins ce que j'ai compris, mais peut être mes explications ne seront pas suffisamment claires.
En tous cas merci de votre aide
-
- Messages : 11
- Enregistré le : lun. 02 févr. 2015, 19:46:00
Non. Il faut de les définir en INT(10) en all free ou 10I 0 en free pour définir 4 octets binaires et de préférence ne pas utiliser le paramètre de position, hérité du GAP II (sic!), qui ne doit être employé qu'à titre exceptionnel lorsque par exemple il est nécessaire de définir une position particulière dans une DS qui contient beaucoup de zones et qu'on ne veut pas les définir toutes.Dans ce type de description en full free et surtout lorsqu'on fait du positionnel les zones de type binary ne doivent pas e^tre définies en 4:0 qui est l'espace occupé par la zone dans le buffer, mais plutot la taille 9:0 qui renvoi bien les nombres attendus.
Le type de donnée "B" ou "BinDec" du RPG n'est pas véritablement un entier binaire. Un entier binaire de quatre octets peut stocker des valeurs allant de -2147483648 à 2147483647. Une zone "9B 0" ou "BinDec(9:0)" en RPG ILE est certes un entier binaire de 4 octets mais ne peut stocker que des valeurs allant de -999999999 à 999999999. Et c'est pour cette raison qu'on ne doit plus utiliser du tout le type de donnée "B" ou "BinDec" en RPG ILE.
Voir à ce sujet cette page sur les APIs.
La DS ci-dessus devrait être définie comme suit :
Code : Tout sélectionner
Dcl-Ds GenRcvrDS BASED(P_UsrSpc);
UserArea Char(64);
GenHdrSize Int(10);
StrucLevel Char(4);
FormatName Char(8);
APIused Char(10);
CreateStamp Char(13);
InfoStatus Char(1);
SizeUSused Int(10);
InpParmOff Int(10);
InpParmSiz Int(10);
HeadOffset Int(10);
HeaderSize Int(10);
ListOffset Int(10);
ListSize Int(10);
ListNumber Int(10);
EntrySize Int(10);
End-Ds;
Modifié en dernier par Philippe S le ven. 27 mars 2015, 15:58:03, modifié 3 fois.
-
- Site Admin
- Messages : 813
- Enregistré le : mer. 14 févr. 2007, 18:00:03
- Localisation : Nantes
- Contact :
integer
Tout a fait d'accord sur le fait de ne plus utiliser le type B qui s'écrit BINDEC en full free.
par contre, pour le type INT(x) en full free, x peux prendre la valeur 3 (max 255 = 1 octet), 5 (max 32767 = 2 octets), 10 (4 octets) et enfin 20 (8 octets), pas 4 !
par contre, pour le type INT(x) en full free, x peux prendre la valeur 3 (max 255 = 1 octet), 5 (max 32767 = 2 octets), 10 (4 octets) et enfin 20 (8 octets), pas 4 !
Christian Massé (Volubis.fr)
-
- Messages : 11
- Enregistré le : lun. 02 févr. 2015, 19:46:00