*--------------------------------------------------------------- * David Malle * Objet : Supression / Création d'un UserSpace * Ecriture de données dans le UserSpace *--------------------------------------------------------------- H option(*noxref:*nodebugio) *‚------------------------------------------------------------------------ *‚Procédure de gestion des erreurs *‚------------------------------------------------------------------------ D ErrorHdlr Pr ExtPgm('ERRHDLR') D DumpText 12A const *--------------------------------------------------------------------------------------------- * User Space : extensible *--------------------------------------------------------------------------------------------- D UspExtend Pr ExtPgm('USPEXTEND') D UsrSpc 20A const *--------------------------------------------------------------- * Proc Transfert d'un UserSpace vers l'IFS *--------------------------------------------------------------- D USP2IFS PR ExtPgm('USP2IFS') D pUsrSpaceName 20A D pLng 9P 0 D pDocument 64A D pMode 8A *--------------------------------------------------------------- * Proc création UserSpace *--------------------------------------------------------------- D QUSCRTUS PR ExtPgm('QUSCRTUS') D UsrSpc 20A CONST D ExtAttr 10A CONST D InitialSize 10I 0 CONST D InitialVal 1A CONST D PublicAuth 10A CONST D Text 50A CONST D Replace 10A CONST D ErrorCode 32766A options(*nopass: *varsize) *--------------------------------------------------------------- * Proc supression UserSpace *--------------------------------------------------------------- D QUSDLTUS PR ExtPgm('QUSDLTUS') D UsrSpc 20A CONST D ErrorCode 32766A options(*varsize) *--------------------------------------------------------------- * Proc écriture dans le UserSpace *--------------------------------------------------------------- D QUSCHGUS PR ExtPgm('QUSCHGUS') D UsrSpc 20A CONST D StartPos 9B 0 CONST D StartLen 9B 0 CONST D Data 32767A CONST D Force 1A CONST D ErrorCode 32766A options(*varsize) *--------------------------------------------------------------- * DS Erreur API *--------------------------------------------------------------- D ErrorDS DS D BytesProvided 10I 0 inz(%size(ErrorDS)) D BytesAvail 10I 0 inz(0) D MessageID 7A D Reserved1A 1A D MessageData 240A *--------------------------------------------------------------- * Paramètres de création du UserSpace *--------------------------------------------------------------- DInputDS DS Inz D UserSpace 20 D SpaceName 10 OverLay(UserSpace:1) D Inz('TMP2IFS ') D SpaceLib 10 OverLay(UserSpace:11) D Inz('QTEMP ') D SpaceAttr 10 Inz('USRSPC') D SpaceSize 9B 0 inz(1) D SpaceValue 1 Inz(' ') D SpaceAuth 10 Inz('*ALL') D SpaceText 50 Inz('User Space David') D SpaceReplc 10 Inz('*YES') *--------------------------------------------------------------- * DS pour buffer à écrire dans le User Space *--------------------------------------------------------------- DBufferDS DS Inz D Name20 20 D NameA10 10A OverLay(Name20:1) D Inz('') D NameB10 10A OverLay(Name20:11) D Inz('') D TextA 80A Inz('') *--------------------------------------------------------------- * Variables pour positionnement écriture dans le USERSPACE *--------------------------------------------------------------- D StartPosWr S 9B 0 Inz(1) D StartPosLn S 9B 0 D Force S 1 Inz('1') D InData S 32767 *--------------------------------------------------------------- * Variables locales *--------------------------------------------------------------- D CR S 1A Inz(X'0D') D pDocument S 64A D pMode S 8A D pPackedLng S 9P 0 D c S 10I 0 *--------------------------------------------------------------- * Début du programme *--------------------------------------------------------------- /free // ------------------------------------------ // Supression du UserSpace // Création du UserSpace // ------------------------------------------ QUSDLTUS(UserSpace:ErrorDS); QUSCRTUS(UserSpace:SpaceAttr:SpaceSize:SpaceValue:SpaceAuth: SpaceText:SpaceReplc:ErrorDS); UspExtend(UserSpace); // ------------------------------------------ // Ecriture dans le UserSpace // ------------------------------------------ Name20 = UserSpace; // for c = 1 to 20000; TextA = 'Ecriture dans User Space : 1er Test !'; InData = %trim(BufferDS) +CR; StartPosLn = %Len(%trim(InData)); QUSCHGUS(UserSpace:StartPosWr:StartPosLn:InData:Force:ErrorDS); If BytesAvail > 0; ErrorHdlr('QUSCHGUS'); endif; StartPosWr = StartPosWr + StartPosLn; // TextA = 'Ecriture dans User Space : 2nd Test !'; InData = %trim(BufferDS) +CR; StartPosLn = %Len(%trim(InData)); QUSCHGUS(UserSpace:StartPosWr:StartPosLn:InData:Force:ErrorDS); If BytesAvail > 0; ErrorHdlr('QUSCHGUS'); endif; StartPosWr = StartPosWr + StartPosLn; // TextA = 'Ecriture dans User Space : Troisième Test !'; InData = %trim(BufferDS) +CR; StartPosLn = %Len(%trim(InData)); QUSCHGUS(UserSpace:StartPosWr:StartPosLn:InData:Force:ErrorDS); If BytesAvail > 0; ErrorHdlr('QUSCHGUS'); endif; StartPosWr = StartPosWr + StartPosLn; // TextA = 'Ecriture dans User Space : Quatrième Test, déjà !'; InData = %trim(BufferDS) +CR; StartPosLn = %Len(%trim(InData)); QUSCHGUS(UserSpace:StartPosWr:StartPosLn:InData:Force:ErrorDS); If BytesAvail > 0; ErrorHdlr('QUSCHGUS'); endif; StartPosWr = StartPosWr + StartPosLn; endfor; // ---------------- // Envoi vers l'IFS // ---------------- StartPosWr = StartPosWr -1; pPackedLng = StartPosWr; pDocument = '/HOME/MONDOCUMENT.TXT'; pMode = '*REPLACE'; // USP2IFS(UserSpace:pPackedLng:pDocument:pMode); *inlr = *on; /end-free