QleActBndPgm - Activate Bound Program
QleGetExp - Get Export
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
***********************************************************
/COPY QCPYSRC,Activator
*===========================================================*
* Activate Service Program, return Activation Mark
DActSrvPgm PR 10I 0
D SrvPgm 10A value
D Lib 10A value
*===========================================================*
* Return procptr to ProcName
DRtvSrvPgmProc@ PR * procptr opdesc
D ActMark 10I 0 value
D ProcName 32767A const options(*VARSIZE)
*===========================================================*
Example of a calling program
*****************************************************************
D Example1 pr
*---------------------------------------------------------------*
* This program activates service program SRVPGM1, which has
* procedure Proc1.
* A pointer to Proc1 is then recovered, and Proc1 is executed.
*
* Note that SRVPGM1 needn't be listed as a BNDSRVPGM when
* this program is created.
*---------------------------------------------------------------*
/COPY QCPYSRC,Activator
D Example1 pi
D ActMark s 10i 0
D Proc1 pr extproc(Proc1@)
D Proc1@ s * procptr
C eval ActMark=ActSrvPgm('SRVPGM1'
C :'*LIBL')
C eval Proc1@=RtvSrvPgmProc@(ActMark
C :'Proc1')
C callp Proc1
C eval *INLR=*ON
C return
*****************************************************************
Thanks to Johny Thompson
阅读(935) | 评论(0) | 转发(0) |
