如何擷取 PF 欄位定義(Command RTVFFD with API QUSLFLD) ?
File : QRPGLESRC
Member: RTVFFD
Type : RPGLE
Usage : CRTBNDRPG RTVFFD
*--------------------------------------------------------------*
* AS400ePaper Support For DDSC 2006 *
* *
* \\\\\\\ *
* ( o o ) *
*---------------------oOOO----(_)----OOOo----------------------*
* *
* System name. . : Programmer Tool *
* Program name . : RTVFFD *
* Text . . . . . : Retrieve File Field Description by FldName*
* *
* Author . . . . : Vengoal Chang *
* *
* *
* OOOOO OOOOO *
* ( ) ( ) *
*--------------------( )-------------( )-------------------*
* (_) (_) *
* *
*--------------------------------------------------------------*
* Modification Log : *
* *
* Task Programmer/ *
* Date No. Description *
* -------- ------ ------------------------------------------ *
* Vengoal Chang *
* 20061109 Creation Date *
* *
*--------------------------------------------------------------*
* APIs Used: *
* *
* QUSDLTUS ? Delete user space *
* QUSCRTUS ? Create user space *
* QUSPTRUS ? Retrieve pointer to user space *
* QUSLFLD ? List Fields *
* QUSRTVUS ? Retrieve user space *
* *
*--------------------------------------------------------------*
H DFTACTGRP(*NO) debug
**-- API format FLDL0100:
D FldLst100 Ds Based( pLstEnt )
D F1FldNam 10a
D F1DtaTyp 1a
D F1DtaUse 1a
D F1OutBufPos 10i 0
D F1InpBufPos 10i 0
D F1Len 10i 0
D F1Digits 10i 0
D F1DecPos 10i 0
D F1TxtDsc 50a
D F1EdtCod 2a
D F1EdtWrdLen 10i 0
D F1EdtWrd 64a
D F1ColHdg1 20a
D F1ColHdg2 20a
D F1ColHdg3 20a
D F1IntFldNam 10a
D F1AltFldNam 30a
D F1AltFldNamLn 10i 0
D F1NbrChrDbcs 10i 0
D F1AlwNull 1a
D F1HstVarInd 1a
D F1DatTimFmt 4a
D F1DatTimSep 1a
D F1VarFldLenIn 1a
D F1TxtDscCcsId 10i 0
D F1DtaCcsId 10i 0
D F1ColHdgCcsId 10i 0
D F1EdtWrdCcsId 10i 0
D F1Ucs2DspFldL 10i 0
**-- Api error data structure: -----------------------------------------**
D ApiError Ds
D AeBytPro 10i 0 Inz( %Size( ApiError ))
D AeBytAvl 10i 0 Inz
D AeMsgId 7a
D 1a
D AeMsgDta 128a
**-- Global constants: -------------------------------------------------**
D Null c ''
D UsrSpc c 'DBFLST QTEMP'
D FldVal S 1024a
D PxFilNam S 10a
D PxLibNam S 10a
D PxFldNam S 10a
D QualFilNam S 20a
** --------------------**
D CrtUsrSpc Pr ExtPgm( 'QUSCRTUS' )
D CsSpcNamQ 20a Const
D CsExtAtr 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 )
**-- List fields to user space: ----------------------------------------**
D LstFldSpc Pr ExtPgm( 'QUSLFLD' )
D LfSpcNamQ 20a Const
D LfFmtNam 8a Const
D LfFilNamQual 20a Const
D LfRcdFmtNam 10a Const
D LfOvrPrc 1a Const
D LfError 32767a Options( *NoPass: *VarSize )
**-- List fields: ------------------------------------------------------**
D LstFld Pr 7a
D PxUsrSpc 20a Const
D PxFilNam 10a Const
**-- Retrieve field: ---------------------------------------------------**
D RtvFld Pr 1024a
D PxUsrSpc 20a Const
D PxFldNam 10a Const
C *Entry Plist
C Parm QualFilNam
C Parm PxFldNam
C Parm FldLen 5 0
C Parm FldTxt 50
C Parm FldType 1
C Parm FldCOLHDG1 20
C Parm FldCOLHDG2 20
C Parm FldCOLHDG3 20
C Parm FldDigits 5 0
C Parm FldDecPos 5 0
C Parm FldDtaCCSID 5 0
C Eval PxFilNam = %SubSt(QualFilNam: 1:10)
C Eval PxLibNam = %SubSt(QualFilNam:11:10)
C CallP CrtUsrSpc( UsrSpc
C : *Blanks
C : 65535
C : x'00'
C : '*CHANGE'
C : *Blanks
C : '*YES'
C : ApiError
C )
**
C If AeBytAvl = *Zero
C Eval FldVal = LstFld( UsrSpc
C : PxFilNam
C )
C EndIf
C Eval FldVal = RtvFld( UsrSpc
C : PxFldNam
C )
C If %len(%trim(FldVal)) > 0
C Eval pLstEnt = %Addr(FldVal)
C If %Addr(FldTxt) <> *NULL
C Eval FldTxt = F1TxtDsc
C EndIf
C If %Addr(FldLen) <> *NULL
C If F1VarFldLenIn = '0'
C Eval FldLen = F1Len
C Else
C Eval FldLen = F1Len - 2
C EndIf
C EndIf
C If %Addr(FldType) <> *NULL
C Eval FldType= F1DtaTyp
C EndIf
C If %Addr(FldCOLHDG1) <> *NULL
C Eval FldCOLHDG1 = F1ColHdg1
C EndIf
C If %Addr(FldCOLHDG2) <> *NULL
C Eval FldCOLHDG2 = F1ColHdg2
C EndIf
C If %Addr(FldCOLHDG3) <> *NULL
C Eval FldCOLHDG3 = F1ColHdg3
C EndIf
C If %Addr(FldDigits) <> *NULL
C Eval FldDigits = F1Digits
C EndIf
C If %Addr(FldDecPos) <> *NULL
C Eval FldDecPos = F1DecPos
C EndIf
C If %Addr(FldDtaCCSID) <> *NULL
C Eval FldDtaCCSID= F1DtaCcsId
C EndIf
C EndIf
**
C CallP DltUsrSpc( UsrSpc
C : ApiError
C )
C Return
**-- List fields: ------------------------------------------------------**
P LstFld B
D Pi 7a
D PxUsrSpc 20a Const
D PxFilNam 10a Const
**-- List fields: ------------------------------------------------------**
**
C* CallP LstFldSpc( PxUsrSpc
C* : 'FLDL0100'
C* : PxFilNam + '*LIBL'
C* : '*FIRST'
C* : '0'
C* : ApiError
C* )
C CallP LstFldSpc( PxUsrSpc
C : 'FLDL0100'
C : QualFilNam
C : '*FIRST'
C : '0'
C : ApiError
C )
**
C If AeBytAvl = *Zero
C Return Null
**
C Else
C Return AeMsgId
C EndIf
**
P LstFld E
**-- Retrieve field: ---------------------------------------------------**
P RtvFld B
D Pi 1024a
D PxUsrSpc 20a Const
D PxFldNam 10a Const
**-- Local variables:
D FldVal s 1024a
D Idx s 10u 0
**-- API format FLDL0100:
D FldLst100 Ds Based( pLstEnt )
D F1FldNam 10a
D F1DtaTyp 1a
D F1DtaUse 1a
D F1OutBufPos 10i 0
D F1InpBufPos 10i 0
D F1Len 10i 0
D F1Digits 10i 0
D F1DecPos 10i 0
D F1TxtDsc 50a
D F1EdtCod 2a
D F1EdtWrdLen 10i 0
D F1EdtWrd 64a
D F1ColHdg1 20a
D F1ColHdg2 20a
D F1ColHdg3 20a
D F1IntFldNam 10a
D F1AltFldNam 30a
D F1AltFldNamLn 10i 0
D F1NbrChrDbcs 10i 0
D F1AlwNull 1a
D F1HstVarInd 1a
D F1DatTimFmt 4a
D F1DatTimSep 1a
D F1VarFldLenIn 1a
D F1TxtDscCcsId 10i 0
D F1DtaCcsId 10i 0
D F1ColHdgCcsId 10i 0
D F1EdtWrdCcsId 10i 0
D F1Ucs2DspFldL 10i 0
**-- API header information:
D HdrInf Ds Based( pHdrInf )
D FlFilNamU 10a
D FlFilLibU 10a
D FlFilTyp 10a
D FlRcdFmtNamU 10a
D FlRcdLen 10i 0
D FlRcdFmtId 13a
D FlRcdTxtDsc 50a
D 1a
D FlRcdTxtCcsId 10i 0
D FlVarLenFldIn 1a
D FlGphFldInd 1a
D FlDatTimFldIn 1a
D FlNulCapFldIn 1a
**-- 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 )
**-- User space pointers:
D pUsrSpc s * Inz( *Null )
D pHdrInf s * Inz( *Null )
D pLstEnt s * Inz( *Null )
**-- Retrieve field: ---------------------------------------------------**
**
C CallP RtvPtrSpc( PxUsrSpc: pUsrSpc )
**
C Eval pHdrInf = pUsrSpc + UsOfsHdr
C Eval pLstEnt = pUsrSpc + UsOfsLst
**
C For Idx = 1 To UsNumLstEnt
**
C If F1FldNam = PxFldNam
**
C Eval FldVal = FldLst100
**
C Leave
C EndIf
**
C If Idx < UsNumLstEnt
C Eval pLstEnt = pLstEnt + UsSizLstEnt
C EndIf
C EndFor
**
C* Return %TrimR( FldVal )
C Return FldVal
**
P RtvFld E
File : QCMDSRC
Member: RTVFFD
Type : CMD
Usage : CRTCMD CMD(lib/RTVCMD) PGM(lib/RTVFFD) ALLOW(*IPGM *BPGM)
/* =============================================================== */
/* = Command....... RtvFfd = */
/* = CPP........... RtvFfd = */
/* = Description... Retrieve File Field Descriptions = */
/* = by Field names = */
/* = = */
/* = CrtCmd Cmd( RtvFfd ) = */
/* = Pgm( RtvFfd ) ) = */
/* = SrcFile( YourSourceFile ) = */
/* =============================================================== */
/* = Date : 2006/11/09 = */
/* = Author: Vengoal Chang = */
/* =============================================================== */
CMD PROMPT('RTV File Field Descriptions')
PARM KWD(FILE) TYPE(Q014D) MIN(1) CHOICE(*NONE) +
PROMPT('File' 1)
PARM KWD(FLDNAME) TYPE(*CHAR) LEN(10) RTNVAL(*NO) +
MIN(1) PROMPT('Field name')
PARM KWD(FLDLEN) TYPE(*DEC) LEN(5) RTNVAL(*YES) +
PROMPT('CL var for Fld length in bytes')
PARM KWD(FLDTXT) TYPE(*CHAR) LEN(50) RTNVAL(*YES) +
PROMPT('CL var for Field text')
PARM KWD(FLDTYP) TYPE(*CHAR) LEN(1) RTNVAL(*YES) +
PROMPT('CL var for Field data type')
PARM KWD(COLHDG1) TYPE(*CHAR) LEN(20) +
RTNVAL(*YES) PROMPT('CL var for Column +
heading 1')
PARM KWD(COLHDG2) TYPE(*CHAR) LEN(20) +
RTNVAL(*YES) PROMPT('CL var for Column +
heading 2')
PARM KWD(COLHDG3) TYPE(*CHAR) LEN(20) +
RTNVAL(*YES) PROMPT('CL var for Column +
heading 3')
PARM KWD(FLDDIGITS) TYPE(*DEC) LEN(5) +
RTNVAL(*YES) PROMPT('CL var for Field +
digits')
PARM KWD(FLDDECPOS) TYPE(*DEC) LEN(5) +
RTNVAL(*YES) PROMPT('CL var for Field +
decimal pos')
PARM KWD(FLDCCSID) TYPE(*DEC) LEN(5) RTNVAL(*YES) +
PROMPT('CL var for Field data ccsid')
Q014D: QUAL TYPE(*NAME) +
LEN(10) +
MIN(1)
QUAL TYPE(*NAME) +
LEN(10) +
DFT(*LIBL) +
SPCVAL( +
(*LIBL )) +
PROMPT('Library')
指令範例畫面
RTV File Field Descriptions (RTVFFD)
Type choices, press Enter.
File . . . . . . . . . . . . . . Name
Library . . . . . . . . . . . *LIBL Name, *LIBL
Field name . . . . . . . . . . . Character value
CL var for Fld length in bytes Number
CL var for Field text . . . . . Character value
CL var for Field data type . . . Character value
CL var for Column heading 1 . . Character value
CL var for Column heading 2 . . Character value
CL var for Column heading 3 . . Character value
CL var for Field digits . . . . Number
CL var for Field decimal pos . . Number
CL var for Field data ccsid . . Number
Bottom
F3=Exit F4=Prompt F5=Refresh F12=Cancel F13=How to use this display
F24=More keys
File : QCLSRC
Member: RTVFFDTEST
Type : CLP
Usage : CRTCLPGM RTVFFDTEST
CALL RTVFFD ('library' 'file' 'fldName')
WRKJOB select option 4 WRKSPLF, 檢視報表 QPPGMDMP
例如:
CALL RTVFFD ('QGPL' 'QRPGSRC' 'SRCDTA')
檢視報表 QPPGMDMP 有如下內容:
&COLHDG1 *CHAR 20 ' '
&COLHDG3 *CHAR 20 ' '
&FIELD *CHAR 10 'SRCDTA '
&FILE *CHAR 10 'QRPGSRC '
&FLDCCSID *DEC 5 0 28709
&FLDDECPOS *DEC 5 0 0
&FLDDIGITS *DEC 5 0 0
&FLDLEN *DEC 5 0 80
&FLDTXT *CHAR 50 '
+26 '
&FLDTYP *CHAR 1 'A'
&LIB *CHAR 10 'QGPL '
PGM (&LIB &FILE &FIELD)
DCL VAR(&LIB) TYPE(*CHAR) LEN(10)
DCL VAR(&FILE) TYPE(*CHAR) LEN(10)
DCL VAR(&FIELD) TYPE(*CHAR) LEN(10)
DCL VAR(&FLDLEN) TYPE(*DEC ) LEN(5 0)
DCL VAR(&FLDTXT) TYPE(*CHAR) LEN(50)
DCL VAR(&FLDTYP) TYPE(*CHAR) LEN(1)
DCL VAR(&COLHDG1) TYPE(*CHAR) LEN(20)
DCL VAR(&COLHDG2) TYPE(*CHAR) LEN(20)
DCL VAR(&COLHDG3) TYPE(*CHAR) LEN(20)
DCL VAR(&FLDDIGITS) TYPE(*DEC) LEN(5 0)
DCL VAR(&FLDDECPOS) TYPE(*DEC) LEN(5 0)
DCL VAR(&FLDCCSID) TYPE(*DEC) LEN(5 0)
RTVFFD FILE(&LIB/&FILE) FLDNAME(&FIELD) +
FLDLEN(&FLDLEN) FLDTXT(&FLDTXT) +
FLDTYP(&FLDTYP) COLHDG1(&COLHDG1) +
COLHDG3(&COLHDG3) FLDDIGITS(&FLDDIGITS) +
FLDDECPOS(&FLDDECPOS) FLDCCSID(&FLDCCSID)
DMPCLPGM
ENDPGM
星期二, 11月 07, 2023
2006-11-10 如何擷取 PF 欄位定義(Command RTVFFD with API QUSLFLD) ?
2006-08-24 如何擷取 PF 檔案格式的長度 ? (RTVRECLEN command with API QUSLRCD)
如何擷取 PF 檔案格式的長度 ? (RTVRECLEN command with API QUSLRCD)
File : QCLSRC
Member: RTVRECLENC
Type : CLP
Usage : CRTCLPGM RTVRECLENC
/* Program : RTVRCDLENC */
/* System : iSeries */
/* AUTHOR : Vengoal Chang August 24, 2006 */
/* */
/* Retrieve record length */
/* TO COMPILE : */
/* */
/* CRTCLPGM PGM(XXX/RTVRECLENC) + */
/* SRCFILE(XXX/QLSRC) + */
RTVRCDLEN: PGM PARM(&FILEQUAL &RCDLEN)
DCL VAR(&FILEQUAL) TYPE(*CHAR) LEN(20) /* +
qualified file name */
DCL VAR(&RCDLEN) TYPE(*DEC) LEN(5 0) /* record +
length in decimal */
DCL VAR(&RCDLENCHR) TYPE(*CHAR) LEN(5) /* record +
length in character format */
DCL VAR(&FILENAME) TYPE(*CHAR) LEN(10) /* file +
name */
DCL VAR(&LIBNAME) TYPE(*CHAR) LEN(10) /* library +
name */
/* API DATA */
DCL VAR(&RCDLENBIN) TYPE(*CHAR) LEN(4)
DCL VAR(&RCDFMT) TYPE(*CHAR) LEN(10)
DCL VAR(&RCDTXT) TYPE(*CHAR) LEN(50)
/* PARAMETERS FOR THE QUSLRCD API */
DCL VAR(&FILQUAL) TYPE(*CHAR) LEN(20)
/* PARAMETERS FOR THE QUSCRTUS API */
DCL VAR(&USP_NAME) TYPE(*CHAR) LEN(10) /* user +
space name */
DCL VAR(&USP_LIB) TYPE(*CHAR) LEN(10) /* user +
space library */
DCL VAR(&USP_QUAL) TYPE(*CHAR) LEN(20) /* user +
space qualified name */
DCL VAR(&USP_TYPE) TYPE(*CHAR) LEN(10) /* user +
space type */
DCL VAR(&USP_SIZE) TYPE(*CHAR) LEN(4) /* user +
space size */
DCL VAR(&USP_FILL) TYPE(*CHAR) LEN(1) /* user +
space fill character */
DCL VAR(&USP_AUT) TYPE(*CHAR) LEN(10) /* user +
space authority */
DCL VAR(&USP_TEXT) TYPE(*CHAR) LEN(50) /* user +
space text */
DCL VAR(&USP_REPL) TYPE(*CHAR) LEN(10) /* user +
space replace */
DCL VAR(&USP_ERROR) TYPE(*CHAR) LEN(256) /* user +
space error */
/* PARAMETERS FOR THE QUSRTVUS API */
DCL VAR(&STARTPOS) TYPE(*CHAR) LEN(4)
DCL VAR(&DATALEN ) TYPE(*CHAR) LEN(4)
DCL VAR(&RECEIVER) TYPE(*CHAR) LEN(16)
DCL VAR(&LISTOFFSET) TYPE(*DEC) LEN(5 0) /* +
offset of first data */
DCL VAR(&LISTSIZE) TYPE(*DEC) LEN(5 0) /* size +
of data */
DCL VAR(&ENTNBR) TYPE(*DEC) LEN(5 0) /* number +
of entries */
DCL VAR(&ENTLEN) TYPE(*DEC) LEN(5 0) /* entry +
length in dec */
DCL VAR(&ENTLENBIN) TYPE(*CHAR) LEN(4) /* entry +
length in binary */
DCL VAR(&LISTPOSBIN) TYPE(*CHAR) LEN(4) /* +
position of first entry in binary */
DCL VAR(&COUNT) TYPE(*DEC) LEN(5) VALUE(0) /* +
counter */
DCL VAR(&DATA) TYPE(*CHAR) LEN(4096)
CHGVAR VAR(&FILENAME) VALUE(%SST(&FILEQUAL 1 10))
CHGVAR VAR(&LIBNAME) VALUE(%SST(&FILEQUAL 11 10))
CHKOBJ OBJ(&LIBNAME/&FILENAME) OBJTYPE(*FILE)
MONMSG MSGID(CPF0000) EXEC(DO)
SNDPGMMSG MSG('** ERROR ** File ' *CAT &LIBNAME *TCAT +
'/' *CAT &FILENAME *BCAT 'does not exist +
or you are not authorised') MSGTYPE(*DIAG)
SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('** +
Error **') MSGTYPE(*ESCAPE)
GOTO CMDLBL(END)
ENDDO
/* CREATE USER SPACE */
CHGVAR VAR(&USP_NAME) VALUE('MYUSRSPACE') /* set +
user space name */
CHGVAR VAR(&USP_LIB) VALUE('QTEMP') /* set user +
space library */
CHGVAR VAR(&USP_QUAL) VALUE(&USP_NAME *CAT +
&USP_LIB) /* set user space qualified name */
CHGVAR VAR(&USP_TYPE) VALUE('MYTYPE') /* set user +
space type */
CHGVAR VAR(%BIN(&USP_SIZE)) VALUE(64000) /* set user +
space size */
CHGVAR VAR(&USP_FILL) VALUE(' ') /* set user space +
fill character */
CHGVAR VAR(&USP_AUT) VALUE('*USE') /* set user +
space authority */
CHGVAR VAR(&USP_TEXT) VALUE('HVDS : my user space') +
/* set user space text */
CHGVAR VAR(%BIN(&USP_ERROR 1 4)) VALUE(0)
CALL PGM(QUSCRTUS) PARM(&USP_QUAL &USP_TYPE +
&USP_SIZE &USP_FILL &USP_AUT &USP_TEXT)
/* EXECUTE API */
CALL PGM(QUSLRCD) PARM(&USP_QUAL 'RCDL0200' +
&FILEQUAL '0' &USP_ERROR)
/* RETRIEVE DATA IN USER SPACE */
CHGVAR VAR(%BIN(&STARTPOS)) VALUE(125) /* set start +
position */
CHGVAR VAR(%BIN(&DATALEN)) VALUE(16) /* set data +
length */
CALL PGM(QUSRTVUS) PARM(&USP_QUAL &STARTPOS +
&DATALEN &RECEIVER)
CHGVAR VAR(&LISTOFFSET) VALUE(%BIN(&RECEIVER 1 4))
CHGVAR VAR(&LISTSIZE) VALUE(%BIN(&RECEIVER 5 4))
CHGVAR VAR(&ENTNBR) VALUE(%BIN(&RECEIVER 9 4))
CHGVAR VAR(&ENTLEN) VALUE(%BIN(&RECEIVER 13 4))
CHGVAR VAR(%BIN(&LISTPOSBIN)) VALUE(&LISTOFFSET + 1)
CHGVAR VAR(&ENTLENBIN) VALUE(%SST(&RECEIVER 13 4))
/* ENTRY RETRIEVAL */
CHGVAR VAR(&COUNT) VALUE(0)
IF COND(&COUNT *EQ &ENTNBR) THEN(GOTO +
CMDLBL(DONE))
CALL PGM(QUSRTVUS) PARM(&USP_QUAL &LISTPOSBIN +
&ENTLENBIN &DATA)
/* EXTRACT DATA */
CHGVAR VAR(&RCDFMT) VALUE(%SST(&DATA 1 10))
CHGVAR VAR(&RCDLENBIN) VALUE(%SST(&DATA 25 4))
CHGVAR VAR(&RCDTXT) VALUE(%SST(&DATA 33 50))
CHGVAR VAR(&RCDLEN) VALUE(%BIN(&RCDLENBIN))
CHGVAR VAR(&RCDLENCHR) VALUE(&RCDLEN)
/* send completion message */
SNDPGMMSG MSG(&LIBNAME *TCAT '/' *CAT &FILENAME *BCAT +
'Record length = ' *CAT &RCDLENCHR) +
MSGTYPE(*COMP)
DONE: DLTUSRSPC USRSPC(&USP_LIB/&USP_NAME)
END: ENDPGM
File : QCMDSRC
Member: RTVRECLEN
Type : CMD
Usage : CRTCMD CMD(RTVRECLEN) PGM(yourlib/RTVRECLENC) ALLOW(*IPGM *BPGM)
/* Command : RTVRCDLEN */
/* System : iSeries */
/* AUTHOR : Vengoal Chang August 24, 2006 */
/* Retrieve record length */
/* TO COMPILE : */
/* */
/* CRTCMD CMD(XXX/RTVRECLEN) PGM(XXX/RTVRECLENC) + */
/* SRCFILE(XXX/QCMDSRC) + */
/* ALLOW(*IPGM *BPGM) */
RTVRECLEN: CMD PROMPT('Retrieve record length')
PARM KWD(FILE) TYPE(FILENAME) PROMPT('File name')
PARM KWD(RECLEN) TYPE(*DEC) LEN(5 0) RTNVAL(*YES) +
PROMPT('Record length')
FILENAME: QUAL TYPE(*NAME) LEN(10) MIN(1)
QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
SPCVAL((*CURLIB) (*LIBL)) PROMPT('Library')
File : QCLSRC
Member: RTVRECLENT
Type : CLP
Usage : CRTCLPGM RTVRECLENT
CALL RTVRECLENT
DSPJOBLOG -> Enter -> F10 -> pageup
會看到
QGPL/QDDSSRC Record length = 00092 訊息
PGM
DCL &RECLENC *CHAR 5
DCL &RECLEN *DEC 5 0
RTVRECLEN FILE(QGPL/QDDSSRC) RECLEN(&RECLEN)
CHGVAR &RECLENC &RECLEN
ENDPGM
訂閱：
文章 (Atom)