manipulation de USER SPACES

BoTTom |
      *=====================================================================
      * User Space Procedures
      *
      * Copyright (C) Julian Monypenny 1997
      *=====================================================================
     H NoMain
 
      *---------------------------------------------------------------------
      * Global definitions
      *---------------------------------------------------------------------
      /Copy ToolkitCpy,ApiErrH
      /Copy ToolkitCpy,ObjH
      /Copy ToolkitCpy,StdTypH
      /Copy ToolkitCpy,UsrSpcH
 
      *=====================================================================
     P CreateUsrSpc    B                   Export
      *=====================================================================
     D                 Pi                  Like( LglTyp )
     D  SpcNam                             Like( NamTyp )  Value
     D  SpcLib                             Like( NamTyp )  Value
     D  InzSiz                             Like( IntTyp )  Value
     D  UsrSpc                             Like( UsrSpcTyp )
     D  SpcTxt_O                           Like( TxtTyp )  Value
     D                                     Options( *NoPass )
 
     D SpcTxt          S                   Like( TxtTyp )
     D InzVal          S                   Like( ChrTyp )  Inz( X'00' )
     D ObjAtr          S                   Like( NamTyp )
     D ObjAut          S                   Like( NamTyp )  Inz( '*CHANGE' )
     D ObjRpl          S                   Like( NamTyp )  Inz( '*YES' )
 
     C                   Eval      UsrSpc = SpcNam + SpcLib
 
     C                   If        %Parms   > 4
     C                   Eval      SpcTxt   = SpcTxt_O
     C                   EndIf
 
     C                   Call      'QUSCRTUS'
     C                   Parm                    UsrSpc
     C                   Parm                    ObjAtr
     C                   Parm                    InzSiz
     C                   Parm                    InzVal
     C                   Parm                    ObjAut


|
     C                   Parm                    SpcTxt
     C                   Parm                    ObjRpl
     C                   Parm                    ApiErrDs
 
     C                   Return    ( ApiErrLen = 0 )
 
     P                 E
 
      *=====================================================================
     P UsrSpcExists    B                   Export
      *=====================================================================
     D                 Pi                  Like( LglTyp )
     D  SpcNam                             Like( NamTyp )  Value
     D  SpcLib                             Like( NamTyp )  Value
 
     C                   Return    ObjExists( SpcNam: SpcNam: '*USRSPC' )
 
     P                 E
 
      *=====================================================================
     P DeleteUsrSpc    B                   Export
      *=====================================================================
     D                 Pi                  Like( LglTyp )
     D  UsrSpc                             Like( UsrSpcTyp )
 
     C                   Call      'QUSDLTUS'
     C                   Parm                    UsrSpc
     C                   Parm                    ApiErrDs
 
     C                   Return    ( ApiErrLen = 0 )
 
     P                 E
 
      *=====================================================================
     P GetUsrSpcDta    B                   Export
      *=====================================================================
     D                 Pi                  Like( LglTyp )
     D  UsrSpc                             Like( UsrSpcTyp )
     D  DtaPos                             Like( IntTyp )  Value
     D  DtaLen                             Like( IntTyp )  Value
     D  Dta                                Like( BufTyp )
     D                                     Options( *VarSize )
 
     C                   Call      'QUSRTVUS'


|
     C                   Parm                    UsrSpc
     C                   Parm                    DtaPos
     C                   Parm                    DtaLen
     C                   Parm                    Dta
     C                   Parm                    ApiErrDs
 
     C                   Return    ( ApiErrLen = 0 )
 
     P                 E
 
      *=====================================================================
     P GetUsrSpcPtr    B                   Export
      *=====================================================================
     D                 Pi                  Like( LglTyp )
     D  UsrSpc                             Like( UsrSpcTyp )
     D  Ptr                                Like( PtrTyp )
 
     C                   Call      'QUSPTRUS'
     C                   Parm                    UsrSpc
     C                   Parm                    Ptr
     C                   Parm                    ApiErrDs
 
     C                   Return    ( ApiErrLen = 0 )
 
     P                 E
 
      *=====================================================================
     P SetUsrSpcDta    B                   Export
      *=====================================================================
     D                 Pi                  Like( LglTyp )
     D  UsrSpc                             Like( UsrSpcTyp )
     D  DtaPos                             Like( IntTyp )  Value
     D  DtaLen                             Like( IntTyp )  Value
     D  Dta                                Like( BufTyp )  Value
 
     D FrcWrt          S                   Like( ChrTyp )  Inz( *Off )
 
     C                   Call      'QUSCHGUS'
     C                   Parm                    UsrSpc
     C                   Parm                    DtaPos
     C                   Parm                    DtaLen
     C                   Parm                    Dta
     C                   Parm                    FrcWrt
     C                   Parm                    ApiErrDs


|
 
     C                   Return    ( ApiErrLen = 0 )
 
     P                 E




©AF400