/TITLE GETSPGMPTR Get Service Program Pointer
*--------------------------------------------------------------*
*‚ Programmers Group & Management Resources Copyright 2002 €*
* *
* \\\\\\\ *
* ( o o ) *
*---------------------oOOO----(_)----OOOo----------------------*
* *
* System name. . :‚ IT €*
* Service Program:‚ GETSPGMPTR €*
* Text . . . . . :‚ Get Service Program Pointer €*
* Author . . . . :‚ Alex Nubla €*
* *
* OOOOO OOOOO *
* ( ) ( ) *
*--------------------( )-------------( )-------------------*
* (_) (_) *
* *
* Description. . : The idea behind this is to allow dynamic *
* procedure (service program) call from *
* the calling program. What this procedure *
* does is activate the bound *SRVPGMs *
* at execution time and set all the function*
* pointers after determining what *SRVPGMs *
* to activate. *
* *
* Create the module first. Then CRTSRVPGM. *
* *
* CRTSRVPGM SRVPGM(GETSPGMPTR) *
* MODULE(GETSPGMPTR) *
* EXPORT(*ALL) *
* BNDSRVPGM(*LIBL/QC2UTIL1) *
* *
*--------------------------------------------------------------*
* *
* Modification Log : *
* *
* Req *
*„Date „Number„Programmer/Description €*
* 11/28/01 Alex Nubla *
* Creation Date *
* *
*--------------------------------------------------------------*
/EJECT
H NOMAIN
H COPYRIGHT('(C) Alex Nubla of PGMR, Inc. 2002')
H DATEDIT(*DMY)
H DEBUG OPTION(*SRCSTMT:*NODEBUGIO)
****************************************************************
*‚ D E F I N I T I O N S P E C I F I C A T I O N €*
****************************************************************
*--------------------------------------------------------------*
*
* Get Service Program Pointer
*
D GetSPgmPtr PR * ProcPtr
D SrvPgm 10A Const
D Library 10A Const
D Procedure 100A Const Varying
D Pointer S * ProcPtr
D Based(frog)
****************************************************************
*‚ G E T S P G M P T R P R O T O T Y P E €*
****************************************************************
*==============================================================*
* *
* Get Service Program Pointer Prototype *
* *
P GetSPgmPtr B Export
*==============================================================*
D GetSPgmPtr PI * ProcPtr
D SrvPgm 10A Const
D Library 10A Const
D Procedure 100A Const Varying
*--------------------------------------------------------------*
*
* Resolve system pointer (calls RSLVSP.H)
*
D RslvSp PR * ProcPtr ExtProc('rslvsp')
D ObjectType 2A Value
D ObjectName 31A
D ObjectLib 31A
D Req_Auth 2A Value
D Type_Lib C x'0401'
D Type_SrvPgm C x'0203'
D Auth_Obj_Ctrl C x'8000'
D Auth_Obj_Mgmt C x'4000'
D Auth_Pointer C x'2000'
D Auth_Space C x'1000'
D Auth_Retrieve C x'0800'
D Auth_Insert C x'0400'
D Auth_Delete C x'0200'
D Auth_Update C x'0100'
D Auth_Owner C x'0080'
D Auth_Excluded C x'0040'
D Auth_Lst_Mgmt C x'0020'
D Auth_Execute C x'0010'
D Auth_Alter C x'0008'
D Auth_Ref C x'0004'
D Auth_All C x'FF1C'
D Auth_None C x'0000'
*--------------------------------------------------------------*
*
* Activate Bound Program (service program QLEAWI)
*
D ActBndPgm PR 10I 0 ExtProc('QleActBndPgm')
D SrvPgmPtr * Value
D ActMark 10I 0 Options(*Omit)
D ActInfo Like(Act_Info) Options(*Omit)
D ActInfoLen 10I 0 Options(*Omit)
D ErrorCode Like(@ErrData) Options(*Omit)
*
* Format of Activation Information (ActInfo)
*
* *-------------------------------------------------------------*
* |‚Offset €| | |
* |-----+-----| | |
* |‚Dec€|‚Key€|‚Type€ |‚Field€ |
* |-----+-----+-----------+-------------------------------------|
* | 0 | 0 | Binary(4) | Bytes returned |
* |-----+-----+-----------+-------------------------------------|
* | 4 | 4 | Binary(4) | Bytes available |
* |-----+-----+-----------+-------------------------------------|
* | 8 | 8 | Char(8) | Reserved |
* |-----+-----+-----------+-------------------------------------|
* | 16 | 10 | Binary(4) | Activation group mark |
* |-----+-----+-----------+-------------------------------------|
* | 20 | 14 | Binary(4) | Activation mark |
* |-----+-----+-----------+-------------------------------------|
* | 24 | 18 | Char(7) | Reserved |
* |-----+-----+-----------+-------------------------------------|
* | 31 | 1F | Char(1) | Flags |
* |-----+-----+-----------+-------------------------------------|
* | 32 | 20 | Char(16) | Reserved |
* *-------------------------------------------------------------*
*
D Act_Info ds
D Act_Ret 9B 0 Inz(%size(Act_Info))
D Act_Avail 9B 0
D Act_Resrvd1 8A Inz(*Allx'00')
D Act_ActGrp 9B 0
D Act_ActMark 9B 0
D Act_Resrvd2 7A Inz(*Allx'00')
D Act_Flags 1A
D Act_Resrvd3 1A Inz(*Allx'00')
*--------------------------------------------------------------*
*
* Get Export (service program QLEAWI)
*
D GetExport PR * ProcPtr ExtProc('QleGetExp')
D SrvPgmMark Like(ActMark)
D ExportId 10I 0 Const
D ExportNamLen 10I 0 Const Options(*Omit)
D ExportName 30A Const Options(*Omit)
D ExportPtr * ProcPtr Options(*Omit)
D ExportType 10I 0 Options(*Omit)
D ErrorCode Like(@ErrData) Options(*Omit)
*
* Type of export item (ExportType)
*
D Export_Gone C 0
D Export_Proc C 1
D Export_Data C 2
D Export_No_Acc C 3
D@ErrData DS
D @BytesProv 9B 0 Inz(200)
D @BytesAval 9B 0
D @ExcpId 7
D @Reserved1 1
D @ExcpData 184
*--------------------------------------------------------------*
*
* Standalone fields
*
D SrvPgmPtr S Like(Pointer)
D ActMark S 10I 0
D ProcPtr S * ProcPtr
D ExportType S 10I 0
D ExportNbr S 10I 0 Inz(1)
D ObjectType S 2A Inz(Type_SrvPgm)
D ObjectName S 31A
D ObjectLib S 31A
C/EJECT
C
****************************************************************
*‚ C A L C U L A T I O N S P E C I F I C A T I O N €*
****************************************************************
*
*----------------------------------------------------*
* Include stop codes (*Null) at end of names *
*----------------------------------------------------*
C Eval ObjectName = %Trimr(SrvPgm) + x'00'
C Eval ObjectLib = %Trimr(Library)+ x'00'
*
*----------------------------------------------------*
* Get the pointer of the service program *
*----------------------------------------------------*
C Eval SrvPgmPtr = RslvSp(ObjectType: ObjectName:
C ObjectLib: Auth_None)
*----------------------------------------------------*
* Activate the service program *
*----------------------------------------------------*
C Eval ActMark = ActBndPgm(%addr(SrvPgmPtr):
C *Omit: *Omit:
C *Omit: *Omit)
*----------------------------------------------------*
* Get the Procedure Pointer for Procedure Name *
*----------------------------------------------------*
C Eval ProcPtr = GetExport(ActMark: 1:
C *Omit: *Omit: *Omit:
C *Omit: *Omit)
*----------------------------------------------------*
* Return the procedure pointer *
*----------------------------------------------------*
C Return ProcPtr
P GetSPgmPtr E