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
阅读(582) | 评论(0) | 转发(0) |
