|
THE RPGIV LIBRARY |
|
H nomain BndDir('QC2LE')
***********************************************************
* PROTOTYPES
***********************************************************
/COPY QCPYSRC,Activator
*------------------------------------------*
* DYNAMIC
*------------------------------------------*
* Retrieve operational descriptor
D CEEDOD PR
D ParmNum 10I 0 const
D DescType 10I 0
D DataType 10I 0
D DescInfo1 10I 0
D DescInfo2 10I 0
D Length 10I 0
D UnknownParm 12A options(*OMIT)
* Resolve System Pointer
DRslvSP PR * extproc('rslvsp') procptr
D HexType 2A value
D Object * value options(*STRING)
D Lib * value options(*STRING)
D Auth 2A value
* Get Object Type Hex Value
DQLICVTTP PR extpgm('QLICVTTP')
D CvtType 10A const
D ObjType 10A const
D HexType 2A
D ErrorDS 32767A options(*VARSIZE:*OMIT) noopt
* Activate Bound Program
DQleActBndPgm PR 10I 0 extproc('QleActBndPgm')
D SrvPgmPtr * procptr const
D ActMark 10I 0 const options(*OMIT)
D ActInfo 64A const options(*OMIT)
D ActInfoLen 10I 0 const options(*OMIT)
D ErrorDS 32767A options(*VARSIZE:*OMIT) noopt
* Get export pointer
DQleGetExp PR * extproc('QleGetExp') procptr
D ActMark 10I 0 const options(*OMIT)
D ExpNo 10I 0 const options(*OMIT)
D ExpNameLen 10I 0 const options(*OMIT)
D ExpName 32767A const options(*VARSIZE:*OMIT)
D Exp@ * options(*OMIT) procptr
D ExpType 10I 0 options(*OMIT)
D ErrorDS 32767A options(*VARSIZE:*OMIT) noopt
*------------------------------------------*
* PRIVATE
*------------------------------------------*
* Retrieve System Pointer
DRtvSysPtr PR * procptr
D SrvPgm 10A value
D Lib 10A value
***********************************************************
* GLOBALS
***********************************************************
D G_HexType S 2A inz(*LOVAL)
D ErrorDS DS
D Err_BytProv 10I 0
D Err_BytAvail 10I 0
D Err_MsgID 7A
D Err_Rsvd 1A
D Err_Parms 128A
***********************************************************
* PUBLIC PROCEDURES
***********************************************************
PActSrvPgm B export
* Activate Service Program, return Activation Mark
DActSrvPgm PI 10I 0
D SrvPgm 10A value
D Lib 10A value
* Locals:
D ActMark S 10I 0 inz(0)
D ActInfo S 64A
C return QleActBndPgm(RtvSysPtr(SrvPgm:Lib)
C :ActMark
C :ActInfo
C :%size(ActInfo)
C :ErrorDS)
P E
***********************************************************
PRtvSrvPgmProc@ B export
* Return procptr to ProcName
DRtvSrvPgmProc@ PI * procptr opdesc
D ActMark 10I 0 value
D ProcName 32767A const options(*VARSIZE)
* Locals:
D ExpNo S 10I 0 inz(0)
D Length S 10I 0
D Exp@ S * procptr inz(*NULL)
D ExpType S 10I 0 inz(0)
D DescType S 10I 0
D DataType S 10I 0
D DescInfo1 S 10I 0
D DescInfo2 S 10I 0
C callp CEEDOD(2 : DescType : DataType
C : DescInfo1 : DescInfo2 : Length
C : *OMIT)
C return QleGetExp(ActMark
C :ExpNo
C :Length
C :%subst(ProcName:1:Length)
C :Exp@
C :ExpType
C :ErrorDS)
P E
***********************************************************
* PRIVATE PROCEDURES
***********************************************************
PRtvSysPtr B
* Retrieve System Pointer
DRtvSysPtr PI * procptr
D SrvPgm 10A value
D Lib 10A value
* Locals:
D Auth S 2A inz(*LOVAL)
* get hex value of type '*SRVPGM':
C if G_HexType=*LOVAL
C callp QLICVTTP('*SYMTOHEX'
C :'*SRVPGM'
C :G_HexType
C :ErrorDS)
C endif
C if Err_MsgID<>*BLANKS
C return *NULL
C endif
* get service program system pointer:
C return rslvSP(G_HexType
C :%trim(SrvPgm)
C :%trim(Lib)
C :Auth)
P E
***********************************************************