Chinaunix首页 | 论坛 | 博客
  • 博客访问: 1271811
  • 博文数量: 287
  • 博客积分: 11000
  • 博客等级: 上将
  • 技术积分: 3833
  • 用 户 组: 普通用户
  • 注册时间: 2007-08-16 08:43
文章分类
文章存档

2013年(15)

2012年(17)

2011年(17)

2010年(135)

2009年(85)

2008年(18)

分类: 系统运维

2010-06-04 17:07:22

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
阅读(895) | 评论(0) | 转发(0) |
给主人留下些什么吧!~~