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

2013年(15)

2012年(17)

2011年(17)

2010年(135)

2009年(85)

2008年(18)

分类: 系统运维

2010-06-04 15:56:24

List configuration descriptions & Search hardware resource entry


     ** Program     : CBX101
     ** Description : Returns the name of the line currently holding the ECS modem
     **
     **  Program summary
     **  ---------------
     **
     **  Configuration API:
     **    QDCLCFGD      List configuration    Returns a list of configuration
     **                  descriptions          descriptions based on type as
     **                                        well as selection criterias such
     **                                        as status and category.
     **
     **  User space APIs:
     **    QUSCRTUS      Create user space     Creates a user space.
     **
     **    QUSPTRUS      Retrieve pointer to   Returns a pointer to the contents
     **                  user space            of a user space. The data pointed
     **                                        to can be directly modified by
     **                                        the program obtaining the pointer.
     **
     **    QUSDLTUS      Delete user space     Deletes a user space.
     **
     **  Message handling API:
     **    QMHSNDPM      Send program message  Sends a message to a program stack
     **                                        entry (current, previous, etc.) or
     **                                        the joblog.
     **
     **  Hardware resource API:
     **    QRZSCHE       Search hardware       Searches the hardware resources
     **                  resource entry        for entries matching the request
     **                                        criteria(s) in the form of key
     **                                        values. Upon a succesful search
     **                                        the first or next resource name
     **                                        found is returned.
     **
     **  Sequence of events:
     **    1. Create user space
     **
     **    2. List configuration description(s) selected
     **       based on the return value from the GetEscRsc()
     **       procedure to user space
     **
     **    3. Retrieve the configuration description(s)
     **       one by one.
     **
     **    4. Send completion message to inform caller
     **       what line - if any - is currently allocating
     **       the ECS resource.
     **
     **    5. Delete user space.
     **
     **
     **  GetEscRsc() parameters:
     **    Return-     OUTPUT     The name of electronic-customer-support
     **    value                  communications resource is returned.
     **
     **                           If no matching entry was found or an error
     **                           occurred blanks are returned to the caller.
     **
     **                  NOTE:    The resource name that is returned is
     **                           for the first port on the I/O adapter
     **                           in card position B of the first multi-
     **                           multifunction IOP on the bus.
     **
     **                           If both SDLC lines for the original ECS
     **                           modem and a PPP line for the iSeries Uni-
     **                           versal Connection for Electronic Support
     **                           and Service are configured for the adapter
     **                           the first resource name is returned.
     **
     **                           Run the command WRKHDWRSC TYPE(*CMN) and
     **                           specify option 5 to find out which lines
     **                           are configured for the specified resource.
     **
     **
     **  Compile options:
     **
     **   CrtRpgMod Module( CBX101 )  DbgView( *LIST )
     **
     **   CrtPgm    Pgm( CBX101 )
     **             Module( CBX101 )
     **-- Control spec:  -----------------------------------------------------**
     H Option( *SrcStmt )
     **-- API Error Data Structure:  -----------------------------------------**
     D ApiError        Ds
     D  AeBytPro                     10i 0 Inz( %Size( ApiError ))
     D  AeBytAvl                     10i 0 Inz
     **-- Global variables:  -------------------------------------------------**
     D MsgKey          s              4a
     **-- Create User Space Parameter:  --------------------------------------**
     D CuUsrSpcQ       Ds
     D  CuUsrSpcNam                  10    Inz( 'CFGLST   ' )
     D  CuUsrSpcLib                  10    Inz( 'QTEMP ' )
     **-- API format CFGD0200: List information:  ----------------------------**
     D CfgLst200       Ds                  Based( pLstEnt )
     D  C2CurStsNam                  10i 0
     D  C2CfgDscNam                  10a
     D  C2CfgDscCat                  10a
     D  C2CurStsTxt                  20a
     D  C2TxtDsc                     50a
     D  C2JobNam                     10a
     D  C2JobUsr                     10a
     D  C2JobNbr                      6a
     D  C2PasTdev                    10a
     D  C2RtvApiNam                   8a
     D  C2CfgCmdSfx                   4a
     **-- API format CFGD0200: Header information:  --------------------------**
     D HdrInf          Ds                  Based( pHdrInf )
     D  ClCfgTypU                    10a
     D  ClObjQualU                   40a
     D  ClStsQualU                   20a
     D                                2a
     D  ClUspNamU                    10a
     D  ClUspLibU                    10a
     **-- User Space Generic Header:  ---------- -----------------------------**
     D UsrSpc          Ds                  Based( pUsrSpc )
     D  UsOfsHdr                     10i 0 Overlay( UsrSpc: 117 )
     D  UsOfsLst                     10i 0 Overlay( UsrSpc: 125 )
     D  UsNumLstEnt                  10i 0 Overlay( UsrSpc: 133 )
     D  UsSizLstEnt                  10i 0 Overlay( UsrSpc: 137 )
     **-- Pointers:  ---------------------------------------------------------**
     D pUsrSpc         s               *   Inz( *Null )
     D pHdrInf         s               *   Inz( *Null )
     D pLstEnt         s               *   Inz( *Null )
     **-- Get ECS resource:  -------------------------------------------------**
     D GetEcsRsc       Pr            32a
     **-- Search hardware resource entry: ------------------------------------**
     D SchHdwRscE      Pr                  ExtPgm( 'QRZSCHE' )
     D  ShRscNam                     32a
     D  ShRscCri                     60a   Const
     D  ShError                   32767a          Options( *VarSize )
     **-- List configuration descriptions:  ----------------------------------**
     D LstCfgDsc       Pr                  ExtPgm( 'QDCLCFGD' )
     D  LcSpcNamQ                    20a   Const
     D  LcFmtNam                      8a   Const
     D  LcCfgDscTyp                  10a   Const
     D  LcObjQual                    40a   Const
     D  LcStsQual                    20a   Const
     D  LcError                   32767a          Options( *NoPass: *VarSize )
     **-- Create user space: -------------------------------------------------**
     D CrtUsrSpc       Pr                  ExtPgm( 'QUSCRTUS' )
     D  CsSpcNamQ                    20a   Const
     D  C***tAtr                     10a   Const
     D  CsInzSiz                     10i 0 Const
     D  CsInzVal                      1a   Const
     D  CsPubAut                     10a   Const
     D  CsText                       50a   Const
     **-- Optional 1:
     D  CsReplace                    10a   Const  Options( *NoPass )
     D  CsError                   32767a          Options( *NoPass: *VarSize )
     **-- Optional 2:
     D  CsDomain                     10a   Const  Options( *NoPass )
     **-- Retrieve pointer to user space: ------------------------------------**
     D RtvPtrSpc       Pr                  ExtPgm( 'QUSPTRUS' )
     D  RpSpcNamQ                    20a   Const
     D  RpPointer                      *
     D  RpError                   32767a          Options( *NoPass: *VarSize )
     **-- Delete user space: -------------------------------------------------**
     D DltUsrSpc       Pr                  ExtPgm( 'QUSDLTUS' )
     D  DsSpcNamQ                    20a   Const
     D  DsError                   32767a          Options( *VarSize )
     **-- Send program message:  ---------------------------------------------**
     D SndPgmMsg       Pr                  ExtPgm( 'QMHSNDPM' )
     D  SpMsgId                       7a   Const
     D  SpMsgFq                      20a   Const
     D  SpMsgDta                    512a   Const  Options( *VarSize )
     D  SpMsgDtaLen                  10i 0 Const
     D  SpMsgTyp                     10a   Const
     D  SpCalStkE                    10a   Const  Options( *VarSize )
     D  SpCalStkCtr                  10i 0 Const
     D  SpMsgKey                      4a
     D  SpError                     512a          Options( *VarSize )
     **
     D  SpCalStkElen                 10i 0 Const  Options( *NoPass )
     D  SpCalStkEq                   20a   Const  Options( *NoPass )
     D  SpDspWait                    10i 0 Const  Options( *NoPass )
     **
     D  SpCalStkEtyp                 20a   Const  Options( *NoPass )
     D  SpCcsId                      10i 0 Const  Options( *NoPass )
     **-- Send completion message:  ------------------------------------------**
     D SndCmpMsg       Pr            10i 0
     D  PxMsgId                      10a   Const
     D  PxMsgF                       10a   Const
     D  PxMsgFlib                    10a   Const
     D  PxMsgDta                    512a   Const  Varying
     **-----------------------------------------------------------------------**
     **
     C                   CallP     CrtUsrSpc( CuUsrSpcQ
     C                                      : *Blanks
     C                                      : 65535
     C                                      : x'00'
     C                                      : '*CHANGE'
     C                                      : *Blanks
     C                                      : '*YES'
     C                                      : ApiError
     C                                      )
     **
     C                   CallP     LstCfgDsc( CuUsrSpcQ
     C                                      : 'CFGD0200'
     C                                      : '*LIND'
     C                                      : '*RSRC     ' + GetEcsRsc()
     C                                      : '*GE       *VARYON'
     C                                      : ApiError
     C                                      )
     **
     C                   If        AeBytAvl    = *Zero
     C                   CallP     RtvPtrSpc( CuUsrSpcQ
     C                                      : pUsrSpc
     C                                      )
     **
     C                   ExSr      GetCfgDsc
     C                   EndIf
     **
     C                   CallP     DltUsrSpc( CuUsrSpcQ
     C                                      : ApiError
     C                                      )
     **
     C                   Return
     **
     **-- Get Configuration Description:  ------------------------------------**
     C     GetCfgDsc     BegSr
     **
     C                   Eval      pHdrInf     = pUsrSpc + UsOfsHdr
     **
     C                   If        UsNumLstEnt = *Zero
     C                   ExSr      RscVacMsg
     **
     C                   Else
     C                   Eval      pLstEnt     = pUsrSpc + UsOfsLst
     C                   Do        UsNumLstEnt
     **
     C                   ExSr      PrcLstEnt
     C                   Eval      pLstEnt     = pLstEnt + UsSizLstEnt
     C                   EndDo
     C                   EndIf
     **
     C                   EndSr
     **-- Ressource vacant message:  -----------------------------------------**
     C     RscVacMsg     BegSr
     **
     C                   CallP     SndCmpMsg( 'CPF9897'
     C                                      : 'QCPFMSG'
     C                                      : '*LIBL'
     C                                      : 'No lines currently allocating +
     C                                         ECS resource.'
     C                                      )
     **
     C                   EndSr
     **-- Process List Entry:  -----------------------------------------------**
     C     PrcLstEnt     BegSr
     **
     C                   CallP     SndCmpMsg( 'CPF9897'
     C                                      : 'QCPFMSG'
     C                                      : '*LIBL'
     C                                      : 'Line '                +
     C                                        %TrimR( C2CfgDscNam )  + ' (' +
     C                                        %TrimR( C2TxtDsc    )  + ')'  +
     C                                        ' is currently '       +
     C                                        %TrimR( C2CurStsTxt )  +
     C                                        '.'
     C                                      )
     **
     C                   EndSr
     **-- Get ECS resource:  -------------------------------------------------**
     P GetEcsRsc       B                   Export
     D                 Pi            32a
     **-- API parameters:
     D ShRscCri        Ds
     D  ScStcLen                     10i 0 Inz( %Len( ShRscCri ))
     D  ScOfsRcd                     10i 0 Inz( 37 )
     D  ScNbrRcd                     10i 0 Inz( 1 )
     D  ScHandle                     16a   Inz( *Allx'00' )
     D  ScSchRsc                     10i 0 Inz( 1 )
     D  ScSchRqs                     10i 0 Inz( 1 )
     D  ScRcdStc
     D   ScRcdLen                    10i 0 Inz( -1 )
     D                                     Overlay( ScRcdStc: 1 )
     D   ScKey                       10i 0 Inz( 25 )
     D                                     Overlay( ScRcdStc: *Next )
     D   ScDtaLen                    10i 0 Inz( 1 )
     D                                     Overlay( ScRcdStc: *Next )
     D   ScDta                       10a   Overlay( ScRcdStc: *Next )
     **
     D ShRscNam        s             32a
     **
     C                   CallP     SchHdwRscE( ShRscNam: ShRscCri: ApiError )
     **
     C                   If        AeBytAvl   >  *Zero
     C                   Eval      ShRscNam   =  *Blanks
     C                   EndIf
     **
     C                   Return    ShRscNam
     **
     P GetEcsRsc       E
     **-- Send completion message:  ------------------------------------------**
     P SndCmpMsg       B
     D                 Pi            10i 0
     D  PxMsgId                      10a   Const
     D  PxMsgF                       10a   Const
     D  PxMsgFlib                    10a   Const
     D  PxMsgDta                    512a   Const  Varying
     **
     C                   CallP     SndPgmMsg( PxMsgId
     C                                      : PxMsgF + PxMsgFlib
     C                                      : PxMsgDta
     C                                      : %Len( PxMsgDta )
     C                                      : '*COMP'
     C                                      : '*PGMBDY'
     C                                      : 1
     C                                      : MsgKey
     C                                      : ApiError
     C                                      )
     **
     C                   If        AeBytAvl    = *Zero
     C                   Return    0
     **
     C                   Else
     C                   Return    -1
     C                   EndIf
     **
     P SndCmpMsg       E

Thanks to Carsten Flensburg
阅读(614) | 评论(0) | 转发(0) |
给主人留下些什么吧!~~