このサンプル プログラムは、入力ファイルを使用してカタログを識別し、関数、データ セット名、およびメンバー名を渡します。また、カタログから取得した情報が含まれた、出力ファイルの書き込みも行います。
IDENTIFICATION DIVISION. PROGRAM-ID. TESTCNTL. AUTHOR. MICRO FOCUS LTD. ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. *----------------------------------------------------------- SELECT INFILE ASSIGN TO IN-DSN ORGANIZATION IS LINE SEQUENTIAL FILE STATUS IN-STATUS. SELECT OUTFILE ASSIGN TO OUT-DSN ORGANIZATION IS LINE SEQUENTIAL FILE STATUS OUT-STATUS. *----------------------------------------------------------- DATA DIVISION. FILE SECTION. FD INFILE LABEL RECORDS STANDARD. 01 IN-REC. 03 IN-COL1 PIC x. 03 IN-FUNC PIC x(4). 03 FILLER PIC x(4). 03 IN-DSNAME PIC x(44). 03 FILLER PIC x. 03 IN-MEMBER PIC x(8). 03 FILLER PIC x(18). FD OUTFILE LABEL RECORDS STANDARD. 01 OUT-REC PIC X(500). working-storage section. 01 IN-status pic X(2). 01 IN-dsn pic x(260). 01 OUT-status pic X(2). 01 OUT-dsn pic x(260). 01 IN-REC-LEN pic x(4) comp-x. 01 ws-mfsyscat pic x(255) value spaces. *--------------------------------------------------------------- 01 rec-type pic x(8). 01 field-name pic x(15). 01 field-value pic x(50). 01 field-value-len pic xx comp-x. 01 input-record-len pic xx comp-x. 01 string-start pic xx comp-x. 01 string-len pic xx comp-x. 01 ix pic xx comp-x. *---------------------------------------------------------------- 01 disp-retcode pic 9(6). 01 disp-rsncode pic 9(6). 01 disp-lrecl pic 9(6). 01 mvscatpb-pp procedure-pointer. 01 mvscatio-pp procedure-pointer. *---------------------------------------------------------------- * parse catalog api fields *--------------------------------------------------------------- 01 CMD-PROCESSOR-PARM. 10 CP-PARM-LEN PIC 9(04) COMP. 10 CP-PARM-STR PIC X(4096). *---------------------------------------------------------------- * public catalog api fields *--------------------------------------------------------------- 01 PUBCAT-AREA. copy 'mfpubcat.cpy' replacing ==()== by ==WS==. linkage section. procedure division. perform init-rtn perform main-process perform end-rtn goback. init-rtn section. set mvscatpb-pp to entry 'MVSCATPB' set mvscatio-pp to entry 'MVSCATIO' move length of in-rec to in-rec-len move 'd:\visualstudio2010\projects\testcat\infile.dat' to in-dsn move 'd:\visualstudio2010\projects\testcat\outfile.dat' to out-dsn perform open-infile perform open-outfile exit section. main-process section. perform read-infile perform until in-status <> '00' evaluate in-rec (1:1) when '*' continue *> comment when space move low-values to pubcat-area move in-func to ws-func move in-dsname to ws-dsname move in-member to ws-member perform call-pub-api perform build-string perform write-outfile when 'C' perform set-mfsyscat end-evaluate perform read-infile end-perform exit section. set-mfsyscat section. move in-rec (2:79) to ws-mfsyscat DISPLAY 'MFSYSCAT' UPON ENVIRONMENT-NAME DISPLAY ws-mfsyscat UPON ENVIRONMENT-VALUE exit section. call-pub-api section. call 'mvscatpb' using pubcat-area exit section. build-string section. move spaces to out-rec move ws-rsncode to disp-rsncode move ws-retcode to disp-retcode move ws-lrecl to disp-lrecl string ' return code ' delimited by size disp-retcode delimited by size ' reason code ' delimited by size disp-rsncode delimited by size ' dsname ' delimited by size ws-dsname delimited by spaces ' member ' delimited by size ws-member delimited by spaces ' dsorg ' delimited by size ws-dsorg delimited by size ' recfm ' delimited by size ws-recfm delimited by size ' lrecl ' delimited by size disp-lrecl delimited by size into out-rec exit section. end-rtn section. close infile close outfile exit section. *---------------------------------------------------------------- * routines for accessing the files *---------------------------------------------------------------- open-infile section. open input infile evaluate in-status when '00' continue when other DISPLAY 'OPEN infile FAILED ' in-status goback end-evaluate exit section. open-outfile section. open output outfile evaluate out-status when '00' continue when other DISPLAY 'OPEN outfile FAILED ' out-status goback end-evaluate exit section. read-infile section. read infile evaluate in-status when '00' when '10' continue when other DISPLAY 'read infile FAILED ' out-status goback end-evaluate exit section. write-outfile section. write out-rec evaluate out-status when '00' continue when other DISPLAY 'write outfile FAILED ' out-status goback end-evaluate exit section. error-rtn section. continue exit section.