ibm-information-center/dist/eclipse/plugins/i5OS.ic.apiref_5.4.0.1/expackilerpg.htm

496 lines
20 KiB
HTML
Raw Permalink Normal View History

2024-04-02 14:02:31 +00:00
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html
PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html lang="en-us" xml:lang="en-us">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<meta name="security" content="public" />
<meta name="Robots" content="index,follow" />
<meta http-equiv="PICS-Label" content='(PICS-1.1 "http://www.icra.org/ratingsv02.html" l gen true r (cz 1 lz 1 nz 1 oz 1 vz 1) "http://www.rsac.org/ratingsv01.html" l gen true r (n 0 s 0 v 0 l 0) "http://www.classify.org/safesurf/" l gen true r (SS~~000 1))' />
<meta name="DC.Type" content="reference" />
<meta name="DC.Title" content="Example in ILE RPG: Program for packaging a product" />
<meta name="abstract" content="This example shows you the steps necessary to package your product like IBM products." />
<meta name="description" content="This example shows you the steps necessary to package your product like IBM products." />
<meta name="DC.Relation" scheme="URI" content="ExTaskPackprog.htm" />
<meta name="copyright" content="(C) Copyright IBM Corporation 1998, 2006" />
<meta name="DC.Rights.Owner" content="(C) Copyright IBM Corporation 1998, 2006" />
<meta name="DC.Format" content="XHTML" />
<meta name="DC.Identifier" content="expackilerpg" />
<meta name="DC.Language" content="en-us" />
<!-- All rights reserved. Licensed Materials Property of IBM -->
<!-- US Government Users Restricted Rights -->
<!-- Use, duplication or disclosure restricted by -->
<!-- GSA ADP Schedule Contract with IBM Corp. -->
<link rel="stylesheet" type="text/css" href="./ibmdita.css" />
<link rel="stylesheet" type="text/css" href="./ic.css" />
<title>Example in ILE RPG: Program for packaging a product</title>
</head>
<body id="expackilerpg"><a name="expackilerpg"><!-- --></a>
<!-- Java sync-link --><script language="Javascript" src="../rzahg/synch.js" type="text/javascript"></script>
<h1 class="topictitle1">Example in ILE RPG: Program for packaging a product</h1>
<div><p>This example shows you the steps necessary to package your product
like IBM products.</p>
<div class="section"><pre> F*****************************************************************
F*****************************************************************
F*
F*Program Name: SFTWPRDEX
F*
F*Language: ILE RPG
F*
F*Descriptive Name: Software Product Example
F*
F*Description: This example shows you the steps necessary to
F* package your product like IBM products.
F*
F*Header Files Included: QUSEC - Error Code Parameter
F* QSZCRTPD - Create Product Definition API
F* QSZCRTPL - Create Product Load API
F* QSZPKGPO - Package Product Option API
F*
F*****************************************************************
F*****************************************************************
F*
FQPRINT O F 132 PRINTER OFLIND(*INOF) USROPN
D*
D* Error Code parameter include. As this sample program
D* uses /COPY to include the error code structure, only the first
D* 16 bytes of the error code structure are available. If the
D* application program needs to access the variable length
D* exception data for the error, the developer should physically
D* copy the QSYSINC include and modify the copied include to
D* define additional storage for the exception data.
D*
D/COPY QSYSINC/QRPGLESRC,QUSEC
D*
D* Create Product Definition API Include
D*
D/COPY QSYSINC/QRPGLESRC,QSZCRTPD
D*
D* Create Product Load API Include
D*
D/COPY QSYSINC/QRPGLESRC,QSZCRTPL
D*
D* Package Product Option API Include
D*
D/COPY QSYSINC/QRPGLESRC,QSZPKGPO
D*
D* Compile Time Array
D*
DOBJ_INFO S 41 DIM(15) CTDATA PERRCD(1)
D*
DOBJ_INFO_I DS BASED(OBJ_PTR)
D OBJ_NAME 10
D OBJ_TYPE 10
D PRD_OPT_ID 4
D PRD_OPT_LD 4
D LP_ID 13
D*
D* Change Object Information parameter
D*
DCOBJI DS
D NUMKEY 9B 0 INZ(3)
D KEY13 9B 0 INZ(13)
D LEN13 9B 0 INZ(4)
D PID13 4
D KEY12 9B 0 INZ(12)
D LEN12 9B 0 INZ(4)
D LID12 4
D KEY5 9B 0 INZ(5)
D LEN5 9B 0 INZ(13)
D LP5 13
D*
D* Miscellaneous data
D*
DAPI_NAME S 10
DFIRST_ERR S 1 INZ('0')
DPROD_ID S 7 INZ('0ABCABC')
DPROD_NAME S 20 INZ('ABC0050 ABC ')
DRLS_LVL S 6 INZ('V3R1M0')
DNBR_OPTS S 9B 0 INZ(1)
DNBR_LANGS S 9B 0 INZ(1)
DTEXT_DESC S 50 INZ('ABC Product')
DPUB_AUT S 10 INZ('*USE')
DNBR_ADD_LB S 9B 0 INZ(0)
DNBR_PE S 9B 0 INZ(1)
DNBR_FLDRS S 9B 0 INZ(0)
DOBJNAM S 20
C*
C* Beginning of Mainline
C*
C* Initialize the error code parameter. To signal exceptions to
C* this program by the API, you need to set the bytes provided
C* field of the error code to zero. Because this program has
C* exceptions sent back through the error code parameter, it sets
C* the bytes provided field to the number of bytes it gives the
C* API for the parameter.
C*
C EVAL QUSBPRV = %SIZE(QUSEC)
C*
C* Create Product Definition Object - ABC0050
C*
C EXSR PRDDFN <span class="uicontrol">(1)</span>
C*
C* Create Product Load Objects - ABC0050 (MRM) and ABC0029 (MRI)
C*
C EXSR PRDLOD <span class="uicontrol">(2)</span>
C*
C* Change Object Description for all objects associated with
C* the ABC Product.
C*
C EXSR COBJD <span class="uicontrol">(3)</span>
C*
C* Package the ABC Product so that all the SAVLICPGM, RSTLIBPGM,
C* and DLTLICPGM commands work with the product.
C*
C EXSR PKGPO <span class="uicontrol">(4)</span>
C*
C* All done, product is ready to ship.
C*
C EVAL *INLR = '1'
C RETURN
C*
C* End of MAINLINE
C*
C*
C*****************************************************************
C*****************************************************************
C*
C* Subroutine: PRDDFN
C*
C* Descriptive Name: Create product definitions.
C*
C* Description: This subroutine will create the product definition
C* ABC0050 for the ABC product.
C*
C*****************************************************************
C*****************************************************************
C*
C PRDDFN BEGSR
C*
C* Setup for Product Definition
C* Fill Product Definition Information Parameter
C*
C EVAL QSZPID = PROD_ID
C EVAL QSZRL = RLS_LVL
C EVAL QSZMFIL = 'ABCMSG'
C EVAL QSZFC = '*CURRENT'
C EVAL QSZCC = '*CURRENT'
C EVAL QSZRD = '941201'
C EVAL QSZAMR = '*NO'
C EVAL QSZRIDT = '*PHONE'
C EVAL QSZRIDV = '5072535010'
C*
C* Fill Product Load Parameter
C*
C EVAL QSZOPT = '0000'
C EVAL QSZMID = 'ABC0001'
C EVAL QSZADN = '*NODYNNAM'
C EVAL QSZCL = '5001'
C EVAL QSZERVED00 = *BLANKS
C*
C* Fill Language Load List Parameter
C*
C EVAL QSZLL00 = '2924'
C EVAL QSZOPT00 = '0000'
C EVAL QSZERVED01 = *BLANKS
C*
C* Create the Product Definition for the ABC Product
C*
C CALL 'QSZCRTPD'
C PARM PROD_NAME
C PARM QSZPI
C PARM QSZPO
C PARM 1 NBR_OPTS
C PARM QSZLL
C PARM 1 NBR_LANGS
C PARM TEXT_DESC
C PARM PUB_AUT
C PARM QUSEC
C*
C* If an exception occurs, the API returns the exception in the
C* error code parameter. The bytes available field is set to
C* zero if no exception occurs and greater than zero if an
C* exception does occur.
C*
C IF QUSBAVL &gt; 0
C EVAL API_NAME = 'QSZCRTPD'
C EXSR ERRCOD
C ENDIF
C*
C ENDSR
C*
C*****************************************************************
C*****************************************************************
C*
C* Subroutine: PRDLOD
C*
C* Descriptive Name: Create product loads.
C*
C* Description: This subroutine will create the product loads,
C* ABC0050 and ABC0029, for the ABC product.
C*
C*****************************************************************
C*****************************************************************
C*
C PRDLOD BEGSR
C*
C* Setup for Product Load for MRM Objects
C* Fill Product Load Information Parameter
C*
C EVAL QSZPID00 = PROD_ID
C EVAL QSZRL00 = RLS_LVL
C EVAL QSZOPT01 = '0000'
C EVAL QSZLT = '*CODE'
C EVAL QSZLID = '*CODEDFT'
C EVAL QSZRIDT00 = '*PRDDFN'
C EVAL QSZRIDV00 = *BLANKS
C EVAL QSZMTR = '*CURRENT'
C EVAL QSZERVED02 = *BLANKS
C*
C* Fill Principal Library Information Parameter
C*
C EVAL QSZDL = 'ABC'
C EVAL QSZPL = 'ABC'
C EVAL QSZPEP = 'ABCPGMMRM2'
C*
C* Fill Preoperation Exit Programs Parameter
C*
C EVAL QSZPEP00 = 'ABCPGMMRM1'
C EVAL QSZDL00 = 'ABC'
C*
C* Fill Additional Library List Parameter
C* None
C*
C* Fill Folder List Parameter
C* None
C*
C* Let's create the product load for the ABC Product - MRM Objects
C*
C CALL 'QSZCRTPL'
C PARM 'ABC0050' PROD_ID_NM 10
C PARM QSZLI
C PARM *BLANKS SEC_LANG 10
C PARM QSZLI00
C PARM QSZAL
C PARM NBR_ADD_LB
C PARM QSZPE
C PARM NBR_PE
C PARM QSZFL
C PARM NBR_FLDRS
C PARM TEXT_DESC
C PARM PUB_AUT
C PARM QUSEC
C*
C* If an exception occurs, the API returns the exception in the
C* error code parameter. The bytes available field is set to
C* zero if no exception occurs and greater than zero if an
C* exception does occur.
C*
C IF QUSBAVL &gt; 0
C EVAL API_NAME = 'QSZCRTPL'
C EXSR ERRCOD
C ENDIF
C*
C* Setup for Product Load for MRI Objects
C* Fill Product Load Information Parameter
C*
C EVAL QSZLT = '*LNG'
C EVAL QSZLID = '2924'
C*
C* Fill Principal Library Information Parameter
C*
C EVAL QSZPEP = 'ABCPGMMRI2'
C*
C* Fill Preoperation Exit Programs Parameter
C*
C EVAL QSZPEP00 = 'ABCPGMMRI1'
C*
C* Fill Additional Library List Parameter
C* None
C*
C* Fill Folder List Parameter
C* None
C*
C* Let's create the product load for the ABC Product - MRI Objects
C*
C CALL 'QSZCRTPL'
C PARM 'ABC0029' PROD_ID_NM
C PARM QSZLI
C PARM 'ABC2924' SEC_LANG
C PARM QSZLI00
C PARM QSZAL
C PARM NBR_ADD_LB
C PARM QSZPE
C PARM NBR_PE
C PARM QSZFL
C PARM NBR_FLDRS
C PARM TEXT_DESC
C PARM PUB_AUT
C PARM QUSEC
C*
C* If an exception occurs, the API returns the exception in the
C* error code parameter. The bytes available field is set to
C* zero if no exception occurs and greater than zero if an
C* exception does occur.
C*
C IF QUSBAVL &gt; 0
C EVAL API_NAME = 'QSZCRTPL'
C EXSR ERRCOD
C ENDIF
C*
C ENDSR
C*
C*****************************************************************
C*****************************************************************
C*
C* Subroutine: COBJD
C*
C* Descriptive Name: Change object descriptions for ABC Product.
C*
C* Description: This subroutine will change the object
C* descriptions for all objects that make up the
C* ABC Product. Currently that is 15 objects. They
C* are listed at the end of this program.
C*
C*****************************************************************
C*****************************************************************
C*
C COBJD BEGSR
C*
C* Need to associate all objects with the ABC Product
C*
C 1 DO 15 I 3 0
C EVAL OBJ_PTR = %ADDR(OBJ_INFO(I))
C EVAL OBJNAM = OBJ_NAME + 'ABC'
C EVAL LP5 = LP_ID
C EVAL PID13 = PRD_OPT_ID
C EVAL LID12 = PRD_OPT_LD
C EVAL TYPE = OBJ_TYPE
C*
C CALL 'QLICOBJD'
C PARM RTN_LIB 10
C PARM OBJNAM
C PARM TYPE 10
C PARM COBJI
C PARM QUSEC
C*
C* If an exception occurs, the API returns the exception in the
C* error code parameter. The bytes available field is set to
C* zero if no exception occurs and greater than zero if an
C* exception does occur.
C*
C IF QUSBAVL &gt; 0
C EVAL API_NAME = 'QLICOBJD'
C EXSR ERRCOD
C ENDIF
C*
C ENDDO
C*
C ENDSR
C*
C*****************************************************************
C*****************************************************************
C*
C* Subroutine: PKGPO
C*
C* Descriptive Name: Package software ABC Product.
C*
C* Description: This subroutine will package the ABC Product.
C* It makes sure that all objects exist that are
C* associated with the product.
C*
C*****************************************************************
C*****************************************************************
C*
C PKGPO BEGSR
C*
C* Setup for packing the ABC Product.
C* Fill Product Option Information Parameter
C*
C EVAL QSZOPT02 = '0000'
C EVAL QSZPID01 = PROD_ID
C EVAL QSZRL01 = RLS_LVL
C EVAL QSZLID00 = '*ALL'
C EVAL QSZERVED03 = *BLANKS
C*
C* Let's package the ABC Product.
C*
C*
C CALL 'QSZPKGPO'
C PARM QSZPOI
C PARM '*YES' REPKG 4
C PARM '*NO' ALWCHG 5
C PARM QUSEC
C*
C* If an exception occurs, the API returns the exception in the
C* error code parameter. The bytes available field is set to
C* zero if no exception occurs and greater than zero if an
C* exception does occur.
C*
C IF QUSBAVL &gt; 0
C EVAL API_NAME = 'QSZPKGPO'
C EXSR ERRCOD
C ENDIF
C*
C ENDSR
C*
C*****************************************************************
C*****************************************************************
C*
C* Subroutine: ERROR
C*
C* Descriptive Name: Process API errors.
C*
C* Description: This subroutine will print a line to a spooled
C* file if any errors are returned in the error code
C* parameter.
C*
C*****************************************************************
C*****************************************************************
C*
C ERRCOD BEGSR
C*
C* Process errors returned from the API.
C*
C* If first error found, then open QPRINT *PRTF
C*
C IF FIRST_ERR = '0'
C OPEN QPRINT
C EVAL FIRST_ERR = '1'
C ENDIF
C*
C* Output the error and the API that received the error
C*
C EXCEPT BAD_NEWS
C*
C ENDSR
OQPRINT E BAD_NEWS 1
O 'Failed in API '
O API_NAME
O 'with error '
O QUSEI
**CTDATA OBJ_INFO
ABCPGMMRM1*PGM 000050010ABCABCV3R1M0
ABCPGMMRM2*PGM 000050010ABCABCV3R1M0
ABCPGMMRI1*PGM 000029240ABCABCV3R1M0
ABCPGMMRI2*PGM 000029240ABCABCV3R1M0
ABCPGM *PGM 000050010ABCABCV3R1M0
QCLSRC *FILE 000029240ABCABCV3R1M0
ABCDSPF *FILE 000029240ABCABCV3R1M0
ABCPF *FILE 000029240ABCABCV3R1M0
ABCMSG *MSGF 000029240ABCABCV3R1M0
ABC *CMD 000029240ABCABCV3R1M0
ABCPNLGRP *PNLGRP 000029240ABCABCV3R1M0
ABC0050 *PRDDFN 000050010ABCABCV3R1M0
ABC0050 *PRDLOD 000050010ABCABCV3R1M0
ABC0029 *PRDLOD 000029240ABCABCV3R1M0
ABC *LIB 000050010ABCABCV3R1M0</pre>
</div>
</div>
<div>
<div class="familylinks">
<div class="parentlink"><strong>Parent topic:</strong> <a href="ExTaskPackprog.htm" title="You can define, create, distribute, and maintain your own product using APIs. These examples demonstrate how you can use the APIs to package a product similar to the way IBM packages products.">Examples: Packaging your own software products</a></div>
</div>
</div>
</body>
</html>