このサンプル プログラムは、入力ファイルを使用してカタログを識別し、関数、データ セット名、およびメンバー名を渡します。また、カタログから取得した情報が含まれた、出力ファイルの書き込みも行います。
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.