如何擷取 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) ?
訂閱：
張貼留言 (Atom)
沒有留言:
張貼留言