
|
*===================================================================== * 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 |