S/400 Code Samples - AS/400 - DREC - GSS Display Record and File information Author: George Pearson Company: Green Springs Software, Inc. Purpose: A simple utility to Display Record and File information. Components: DREC CMD DRECC CL Program DRECFM Display File Parameters: File Name (Qualified or unqualified File name) Required Member Name (Default is *First) Optional Special Values: *First Written: 1989 /* ***************************************************************** */ /* */ /* GREEN SPRINGS SOFTWARE, INC. */ /* */ /* ***************************************************************** */ /* */ /* COMMAND NAME - DREC AS/400 VERSION */ /* COMMAND PROC PGM. - DREC */ /* CREATED BY - George Pearson */ /* DATE CREATED - 4/15/89 */ /* */ /* PURPOSE - Displays the Actual Record Count of any */ /* Physical File */ /* */ /* Copyright 1989 Green Springs Software, Ashland OR */ /* (541) 488-2560 */ /* www.green-springs.com */ /* ***************************************************************** */ CMD PROMPT('GSS Display File Record Count') PARM KWD(FILE) TYPE(QUAL1) MIN(1) MAX(1) + " " PARM KWD(MBR) TYPE(*NAME) DFT(*FIRST) + SPCVAL((*FIRST)) MAX(1) PROMPT('Member + Name:' 2) QUAL1: QUAL TYPE(*NAME) LEN(10) SPCVAL((*ALL)) MIN(1) + EXPR(*YES) QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) + SPCVAL((*LIBL)) PROMPT('In Library:') /* ***** End of Source (DREC) Command ****************************** */ /* *********************************************************************/ /* */ /* Green Springs Software, Inc. Ashland, OR */ /* */ /* *********************************************************************/ /* */ /* PROGRAM ID - DRECC AS/400 VERSION */ /* DISPLAY FILE NAME - DRECFM */ /* CREATED BY - George Pearson */ /* DATE CREATED - 3/14/89 */ /* */ /* PURPOSE - Display Record Counts of a Data Base File */ /* */ /* NOTES - Executed by DREC Command. */ /* */ /* (c) 1998 Green Springs Software Inc. */ /* PO Box 3336, Ashland, OR 97520 */ /* (541) 488-2560 www.green-springs.com */ /* */ /* *********************************************************************/ PGM PARM(&FILLIB &MBR) DCL &CD TYPE(*CHAR) LEN(13) DCL &FILATR TYPE(*CHAR) LEN(03) DCL &FILLIB TYPE(*CHAR) LEN(20) DCL &FILETYPE TYPE(*CHAR) LEN(05) DCL &GD TYPE(*CHAR) LEN(13) DCL &LIB TYPE(*CHAR) LEN(10) DCL &LMTCPB TYPE(*CHAR) LEN(10) DCL &MBR TYPE(*CHAR) LEN(10) DCL &RD TYPE(*CHAR) LEN(13) DCL &SD TYPE(*CHAR) LEN(13) DCL &SHARE TYPE(*CHAR) LEN(04) DCL &UD TYPE(*CHAR) LEN(07) DCLF FILE(DRECFM) MONMSG MSGID(CPF9800 CPF2981) EXEC(GOTO + CMDLBL(ERR01)) MONMSG MSGID(CPF3027) EXEC(GOTO CMDLBL(ERR02)) MONMSG MSGID(CPF2990) EXEC(GOTO CMDLBL(ERR03)) CHGVAR VAR(&FILE) VALUE(%SST(&FILLIB 1 10)) CHGVAR VAR(&LIB) VALUE(%SST(&FILLIB 11 10)) RTVUSRPRF LMTCPB(&LMTCPB) RETRIVE: IF COND(&MBR = '*FIRST') THEN(DO) CHKOBJ OBJ(&LIB/&FILE) OBJTYPE(*FILE) ENDDO ELSE CMD(DO) CHKOBJ OBJ(&LIB/&FILE) OBJTYPE(*FILE) MBR(&MBR) ENDDO RTVNETA SYSNAME(&SYSNAME) RTVMBRD FILE(&LIB/&FILE) MBR(&MBR) RTNLIB(&RTNLIB) + RTNMBR(&RTNMBR) FILEATR(&FILATR) + FILETYPE(&FILETYPE) CRTDATE(&CD) + TEXT(&TEXT) NBRCURRCD(&NBRCURRCD) + NBRDLTRCD(&NBRDLTRCD) SHARE(&SHARE) + DTASPCSIZ(&DTASPCSIZ) + ACCPTHSIZ(&ACCPTHSIZ) CHGDATE(&GD) + SAVDATE(&SD) RSTDATE(&RD) USEDATE(&UD) + USECOUNT(&CNT) CHGVAR VAR(&CRTDAT) VALUE(%sst(&CD 4 2) *cat '/' + *cat %sst(&CD 6 2) *cat '/' *cat + %sst(&CD 2 2)) CHGVAR VAR(&SAVDAT) VALUE(%sst(&SD 4 2) *cat '/' + *cat %sst(&SD 6 2) *cat '/' *cat + %sst(&SD 2 2)) CHGVAR VAR(&CHGDAT) VALUE(%sst(&GD 4 2) *cat '/' + *cat %sst(&GD 6 2) *cat '/' *cat + %sst(&GD 2 2)) CHGVAR VAR(&RSTDAT) VALUE(%sst(&RD 4 2) *cat '/' + *cat %sst(&RD 6 2) *cat '/' *cat + %sst(&RD 2 2)) CHGVAR VAR(&USEDAT) VALUE(%sst(&UD 4 2) *cat '/' + *cat %sst(&UD 6 2) *cat '/' *cat + %sst(&UD 2 2)) DISPLAY: SNDRCVF RCDFMT(FORMAT01) F5: IF &IN05 THEN(GOTO RETRIVE) /* F5=REDISPLAY */ F3: IF COND(&IN03) THEN(RETURN) /* F3=EXIT */ F7: IF &IN07 THEN(DO) /* F7=DBU*/ IF COND(&LMTCPB = '*NO') THEN(DO) DBU &RTNLIB/&FILE *FILE &MBR MONMSG MSGID(CPF6801) EXEC(GOTO CMDLBL(DISPLAY)) ENDDO IF COND(&LMTCPB = '*YES') THEN(DO) DBU FILE(&RTNLIB/&FILE) DBUTYP(*FILE) + MBR(&MBR) CHGNAM(*NO) MONMSG MSGID(CPF6801) EXEC(GOTO CMDLBL(DISPLAY)) ENDDO GOTO DISPLAY ENDDO F8: IF COND(&IN08) THEN(DO) /* F8=OBJLCK */ ? WRKOBJLCK OBJ(&RTNLIB/&FILE) OBJTYPE(*FILE) MONMSG MSGID(CPF6801) EXEC(GOTO CMDLBL(DISPLAY)) GOTO DISPLAY ENDDO F9: IF &IN09 THEN(DO) /* F9=DSPFD*/ ? DSPFD &RTNLIB/&FILE MONMSG MSGID(CPF6801) EXEC(GOTO CMDLBL(DISPLAY)) GOTO DISPLAY ENDDO F11: IF COND(&IN11) THEN(DO) /* F11=DSPDBR */ DSPDBR &RTNLIB/&FILE &RTNMBR MONMSG MSGID(CPF6801) EXEC(GOTO CMDLBL(DISPLAY)) GOTO DISPLAY ENDDO /* F13=RGZPFM */ F14: IF COND(&IN14 *AND &FILATR *EQ '*PF') THEN(DO) DSPPFM &RTNLIB/&FILE &MBR MONMSG MSGID(CPF6801) EXEC(GOTO CMDLBL(DISPLAY)) GOTO DISPLAY ENDDO IF COND(&IN14 *AND &FILATR *NE '*PF') THEN(DO) SNDPGMMSG MSG('File ' *CAT &LIB *TCAT '/' *CAT &FILE + "*TCAT ' is not a PF, Not Displayed.')" GOTO DISPLAY ENDDO F15: IF COND(&IN15) THEN(DO) ? FIELDS FILE(&RTNLIB/&FILE) MONMSG MSGID(CPF6801) EXEC(GOTO CMDLBL(DISPLAY)) GOTO DISPLAY ENDDO F16: IF COND(&IN16) THEN(DO) ? WRKOBJ OBJ(&RTNLIB/&FILE) MONMSG MSGID(CPF6801) EXEC(GOTO CMDLBL(DISPLAY)) GOTO DISPLAY ENDDO /* Stuff After this line require LMTCPB = *No! */ /* ------------------------------------------- */ IF COND(&LMTCPB = '*YES') THEN(DO) "SNDPGMMSG MSG('Sorry, but you are not authorized for +" this option') GOTO DISPLAY ENDDO F6: IF COND(&IN06) THEN(DO) /* F6 =EV */ EZVIEW &RTNLIB/&FILE &MBR MONMSG MSGID(CPF6801) EXEC(GOTO CMDLBL(DISPLAY)) GOTO DISPLAY ENDDO F13: IF COND(&IN13 *AND &FILATR = '*PF' *AND &LMTCPB + = '*NO') THEN(DO) ?RGZPFM FILE(&RTNLIB/&FILE) MBR(&MBR) MONMSG MSGID(CPF6801) EXEC(GOTO CMDLBL(DISPLAY)) GOTO DISPLAY ENDDO IF COND(&IN13 *AND &FILATR = '*PF') THEN(DO) SNDPGMMSG MSG('File ' *CAT &LIB *TCAT '/' *CAT &FILE + "*TCAT ' is not a PF, Not Reorganized.')" GOTO DISPLAY ENDDO F12: IF COND(&IN21) THEN(DO) CALL QUSCMDLN MONMSG MSGID(CPF6801) EXEC(GOTO CMDLBL(DISPLAY)) GOTO DISPLAY ENDDO RETURN ERR01: SNDPGMMSG MSG('File ' *CAT &LIB *TCAT '/' *CAT &FILE + "*TCAT ', Mbr:' *CAT &MBR *TCAT ' not found.')" RETURN ERR02: SNDPGMMSG MSG('File ' *CAT &LIB *TCAT '/' *CAT &FILE + "*TCAT ' is not a database File, Dummy!')" RETURN ERR03: SNDPGMMSG MSG('You dont have enough authority for File + ' *CAT &LIB *TCAT '/' *CAT &FILE *TCAT '.') ENDPGM: ENDPGM /* ******** End Of Source (DRECC) CL Program *************************/ /* ***************************************************************** */ /* */ /* GREEN SPRINGS SOFTWARE, INC. */ /* */ /* ***************************************************************** */ /* */ /* DISPLAY FILE NAME - DRECFM AS/400 VERSION */ /* COMMAND PROC PGM. - DREC */ /* CREATED BY - George Pearson, Green Springs Software, Inc*/ /* DATE CREATED - 4/15/89 */ /* */ /* PURPOSE - Displays the Actual Record Count of any */ /* Physical File */ /* */ /* Copyright MMII Green Springs Software, Inc, Ashland OR */ /* (541) 488-2560 */ /* www.green-springs.com */ /* ***************************************************************** */ A* 91/10/21 13:12:00 CPGMR REL-R03M00 5728-PW1 A*%%EC A DSPSIZ(24 80 *DS3) A* 91/10/21 13:12:00 CPGMR REL-R03M00 5728-PW1 A* A R FORMAT01 A*%%TS SD 19990225 111039 GEOPEA REL-V4R2M0 5769-PW1 A CF03(03) A CF12(03) A CF05(05) A CF06(06) A CF07(07) A CF08(08) A CF09(09) A CF11(11) A CF13(13) A CF14(14) A CF15(15) A CF16(16) A CF21(21) A 1 2DATE(*JOB *YY) A EDTCDE(Y) A COLOR(WHT) A 1 13TIME A COLOR(WHT) A 1 27'Green Springs Software, Inc.'" A DSPATR(HI) A COLOR(BLU) A 1 63'System:' A SYSNAME 8A O 1 72COLOR(WHT) A 2 28'Display Number of Records' A DSPATR(HI) A COLOR(BLU) A 5 2'File Name ..:' A FILE 10A O 5 16COLOR(WHT) A TEXT 50A O 5 29COLOR(WHT) A 6 2'Library ....:' A RTNLIB 10A O 6 16COLOR(WHT) A 7 2'Member .....:' A RTNMBR 10A O 7 16COLOR(WHT) A 9 5'Current Records :' A NBRCURRCD 10Y 0O 9 29EDTCDE(1) A COLOR(WHT) A 10 5'Deleted Records :' A NBRDLTRCD 10Y 0O 10 29EDTCDE(1) A COLOR(WHT) A 11 5'Data Space Size :' A DTASPCSIZ 15Y 0O 11 23EDTCDE(2) A COLOR(WHT) A 12 5'Access Path Size:' A ACCPTHSIZ 12Y 0O 12 27EDTCDE(2) A COLOR(WHT) A 14 5'Create Date ....:' A CRTDAT 8A O 14 24COLOR(WHT) A 15 5'Change Date ....:' A CHGDAT 8A O 15 24COLOR(WHT) A 16 5'Last Used Date .:' A USEDAT 8A O 16 24COLOR(WHT) A 16 35'Days Used:' A CNT 5Y 0O 16 47EDTCDE(Z) A COLOR(WHT) A 17 5'Last Rest Date .:' A RSTDAT 8A O 17 24COLOR(WHT) A 18 5'Last Save Date .:' A SAVDAT 8A O 18 24COLOR(WHT) A 22 2'F3=Exit F5=Re-Display' A COLOR(BLU) A 22 26'F6=EZView' A COLOR(BLU) A 22 38'F7=DBU' A COLOR(BLU) A 22 46'F8=ObjLcks' A COLOR(BLU) A 22 58'F9=DSPFD' A COLOR(BLU) A 22 68'F11=DSBDBR' A COLOR(BLU) A 23 2'F12=Cancel' A COLOR(BLU) A 23 14'F13=RGZPFM' A COLOR(BLU) A 23 26'F14=DSPPFM' A COLOR(BLU) A 23 38'F15=Layout' A COLOR(BLU) A 23 50'F16=WRKOBJ' A COLOR(BLU) A 23 62'F21=CmdLine' A COLOR(BLU) A 24 51'(c) 1999 GSS (541) 488-2560' A COLOR(TRQ) /* ************* End Of Source (DRECFM) Display File ******************* */