热爱学习，更热爱生活！ 欲无后悔先修己，各有来因莫羡人
全部博文（5）
2013年（5）
分类： Java
2013-02-16 18:54:20
假设我们有一个服务程序带100多个子过程，某个主程序可能只使用某几个子过程，或者某些条件下才会使用某一子过程。且概率很低。
如果我们不使用dynamic biniding 动态绑定，则必须把整个服务程序绑定到主程序上。每次主程序运行，则必须将全部100多个过程全部在活动组内激活才可以。使用动态绑定机制，可以在控制在run-time需要时某个子过程激活调用。创建服务程序GETSPGMPTR ，需要3个系统函数来实现返回服务程序过程指针。
（1） MI-rslvsp (2)C函数QleActBndPgm (3)C 函数 QleGetExp
3个函数的描述：
The rslvsp (Resolve System Pointer) function locates the AS/400 object and stores the object’s address using system pointer.
QleActBndPgm (Activate Bound Program) and QleGetExp (Get-Export) are C-functions used by the CRTPGM command. QleActBndPgm API activates the bound program (or service program)specified by the system pointer (retrieved from rslvsp). QleActBndPgm returns an “Activationmark”. QleActBndPgm is normally used in conjunction with QleGetExp API.
First you activatethe service program, then later, you use QleGetExp to retrieve pointers to procedures and data from the activation. QleGetExp gets the pointer to the “exported” procedure name.
QleGetExp requires an “Activation mark” for input (retrieved from QleActBndPgm).
F_BUSDATE过程被动态激活，通过改变过程名称，调用GETSPGMPTR可以可以动态激活新的子过程。只整个激活组回收释放掉RCLACTGRP或者主程序结束时，已激活的子过程可被释放掉。
/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
主程序如下：
....省略...
D GetSPgmPtr PR * ProcPtr
D SrvPgm 10A Const
D Library 10A Const
D Procedure 100A Const Varying
D DateBus PR 10A ExtProc(#DateBus)
D Date_Fmt 4A Value
D #DateBus S * ProcPtr
D DateReq S 10A
*
C Eval SrvPgm = 'DATEBUS'
C Eval Lib = '*LIBL'
C Eval Procedure = 'F_BUSDATE'
C Eval #DateBus = GetSPgmPtr(SrvPgm:Lib:
C Procedure)
C Eval DateReq = DateBus(*MDY)
相关代码引用自alex nubla 《DYNAMIC SERVICE PROGRAM BINDING》2002
