496 lines
20 KiB
HTML
496 lines
20 KiB
HTML
|
<?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 > 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 > 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 > 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 > 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 > 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>
|