如何使用 COBOL 获取 PDS 的成员列表(使用批处理作业中指定的 DD 名称)？ 可以动态处理使用 DDNAME 指定的 PDS。因此，可以使用 TCB 获取给定 DDNAME 的 PDS 列表并处理指定的成员名称。
但是如何使用COBOL获取PDS的成员列表呢？我知道这可以使用 REXX 轻松实现。但我需要 COBOL 中的它或直接从 COBOL 中调用它。
最佳答案
如果你指定这个，通过一个简单的 SELECT(当然包括文件状态)，你将能够读取 PDS 目录。
FD INPUT-FILE
RECORDING MODE IS U
LABEL RECORDS ARE STANDARD.
01 INPUT-RECORD.
05 FILLER PIC X(256).
在 JCL 中，您可以这样指定 DDName:
//ffffffff DD DISP=OLD,DSN=yourpdsname,
// RECFM=U,LRECL=256
您还可以在 COBOL 程序中将 RECORDING MODE 更改为 F，在 JCL 中将 RECFM 更改为 F。两者都可以工作(U(未定义)或F(固定))。
然后你就将该目录视为普通文件即可。
但是，每个目录 block 有多个条目，您需要了解这些条目才能使用数据。
这是一个大约 1982 年的程序。在某个时候，我将最初的 GO TO 循环更改为内联 PERFORM，并对当时在 IBM VS COBOL II 下可用的新内容进行了其他更改，以达到 1985 COBOL 标准.
EXPANDED-DIRECTORY 是我为您粘贴的抄写本。
您可以使用上面定义的输入记录和 EXPANDED-DIRECTORY 来调用程序。
然后，在每次调用之后，您都可以访问当前 block 中的成员(如果有的话)。
ID DIVISION.
PROGRAM-ID. OCDIRBLK.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 LENGTH-UP-DIRECTORY BINARY PIC 9(4).
01 LENGTH-OF-USER-DATA BINARY PIC 9(4).
01 DIRECTORY-DATA-LENGTH BINARY PIC 9(4).
01 HIGH-ORDER-BIT-VALUE BINARY PIC 9(4) VALUE 128.
01 BIT-ONE-VALUE BINARY PIC 9(4) VALUE 64.
01 BIT-TWO-VALUE BINARY PIC 9(4) VALUE 32.
01 USER-DATA-LENGTH BINARY PIC 9(4).
88 NO-USER-HALFWORDS VALUE ZERO.
88 SOME-USER-HALFWORDS VALUE 1 THRU 31.
88 MEMBER-HAS-ONE-POINTER VALUE 32 THRU 63.
88 MEMBER-HAS-TWO-POINTERS VALUE 64 THRU 127.
88 MEMBER-IS-AN-ALIAS VALUE 128 THRU 255.
01 FILLER REDEFINES USER-DATA-LENGTH.
05 FILLER PIC X.
05 USER-DATA-BYTE PIC X.
LINKAGE SECTION.
01 INPUT-DIRECTORY.
05 I-D-LENGTH BINARY PIC 9(4).
88 I-D-NO-MEMBERS VALUE ZERO.
05 FILLER OCCURS 0 TO 252 TIMES
DEPENDING ON LENGTH-UP-DIRECTORY
PIC X.
05 I-D-MEMBER-NAME PIC X(8).
88 I-D-END-OF-BLOCK VALUE HIGH-VALUES.
05 I-D-TRACK-ADDRESS PIC XXX.
05 I-D-INDICATOR PIC X.
05 I-D-USER-DATA.
10 FILLER
OCCURS 0 TO 62 TIMES
DEPENDING ON
LENGTH-OF-USER-DATA.
15 FILLER PIC X.
01 EXPANDED-DIRECTORY.
05 E-D-NUMBER-OF-ENTRIES BINARY PIC 9(4).
05 FILLER OCCURS 22 TIMES.
10 E-D-MEMBER-NAME PIC X(8).
10 E-D-TRACK-ADDRESS PIC X(3).
10 E-D-INDICATOR PIC X(1).
10 E-D-ALIAS-FLAG PIC X.
88 E-D-ALIAS VALUE "Y".
88 E-D-ALIAS-NOT VALUE "N".
10 E-D-NO-OF-POINTERS PIC 9.
10 E-D-USER-DATA PIC X(62).
PROCEDURE DIVISION USING
INPUT-DIRECTORY
EXPANDED-DIRECTORY
.
IF I-D-NO-MEMBERS
MOVE ZERO TO DIRECTORY-DATA-LENGTH
ELSE
SUBTRACT +2 FROM I-D-LENGTH
GIVING DIRECTORY-DATA-LENGTH
END-IF
MOVE ZERO TO E-D-NUMBER-OF-ENTRIES
LENGTH-UP-DIRECTORY
PERFORM UNTIL ( LENGTH-UP-DIRECTORY
NOT LESS THAN DIRECTORY-DATA-LENGTH )
OR ( I-D-END-OF-BLOCK )
ADD 1 TO E-D-NUMBER-OF-ENTRIES
MOVE I-D-MEMBER-NAME TO E-D-MEMBER-NAME
( E-D-NUMBER-OF-ENTRIES )
MOVE I-D-TRACK-ADDRESS TO E-D-TRACK-ADDRESS
( E-D-NUMBER-OF-ENTRIES )
MOVE I-D-INDICATOR TO E-D-INDICATOR
( E-D-NUMBER-OF-ENTRIES )
USER-DATA-BYTE
MOVE ZERO TO E-D-NO-OF-POINTERS
( E-D-NUMBER-OF-ENTRIES )
IF MEMBER-IS-AN-ALIAS
SET E-D-ALIAS ( E-D-NUMBER-OF-ENTRIES )
TO TRUE
SUBTRACT HIGH-ORDER-BIT-VALUE
FROM USER-DATA-LENGTH
ELSE
SET E-D-ALIAS-NOT ( E-D-NUMBER-OF-ENTRIES )
TO TRUE
END-IF
IF MEMBER-HAS-TWO-POINTERS
MOVE 2 TO E-D-NO-OF-POINTERS
( E-D-NUMBER-OF-ENTRIES )
SUBTRACT BIT-ONE-VALUE
FROM USER-DATA-LENGTH
END-IF
IF MEMBER-HAS-ONE-POINTER
ADD 1 TO E-D-NO-OF-POINTERS
( E-D-NUMBER-OF-ENTRIES )
SUBTRACT BIT-TWO-VALUE
FROM USER-DATA-LENGTH
END-IF
IF SOME-USER-HALFWORDS
MULTIPLY USER-DATA-LENGTH BY 2
GIVING LENGTH-OF-USER-DATA
MOVE I-D-USER-DATA TO E-D-USER-DATA
( E-D-NUMBER-OF-ENTRIES )
ADD LENGTH-OF-USER-DATA TO LENGTH-UP-DIRECTORY
ELSE
MOVE SPACE TO E-D-USER-DATA
( E-D-NUMBER-OF-ENTRIES )
MOVE ZERO TO LENGTH-OF-USER-DATA
END-IF
ADD 12 TO LENGTH-UP-DIRECTORY
END-PERFORM
GOBACK
.
以下是读取 PDS/PDSE 目录并使用 OCDIRBLK 作为包含/嵌套/嵌入程序的程序示例。
IDENTIFICATION DIVISION.
PROGRAM-ID. STOB30.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT INPUT-FILE ASSIGN TO PDSIND
FILE STATUS IS W-PDSIND-FILE-STATUS.
DATA DIVISION.
FILE SECTION.
FD INPUT-FILE
RECORDING MODE IS U
RECORD IS VARYING FROM 1 TO 256 DEPENDING ON
W-RECORD-LENGTH
LABEL RECORDS ARE STANDARD.
01 INPUT-RECORD.
05 FILLER PIC X(252).
WORKING-STORAGE SECTION.
01 W-THIS-PROGRAM PIC X(9) VALUE
"STOB30".
01 W-WHEN-COMPILED PIC X(8)BX(8).
01 W-RECORD-LENGTH BINARY PIC 9(8).
01 W-PDSIND-FILE-STATUS PIC XX.
88 W-PDSIND-FILE-STATUS-OK VALUE ZERO "10".
88 W-END-OF-INPUT-PDSIND VALUE "10".
01 EXPANDED-DIRECTORY.
05 E-D-NUMBER-OF-ENTRIES BINARY PIC 9(4).
05 FILLER
OCCURS 22 TIMES
INDEXED BY E-D-IND.
10 E-D-MEMBER-NAME PIC X(8).
10 E-D-TRACK-ADDRESS PIC X(3).
10 E-D-INDICATOR PIC X(1).
10 E-D-ALIAS-FLAG PIC X.
88 E-D-ALIAS VALUE "Y".
88 E-D-ALIAS-NOT VALUE "N".
10 E-D-NO-OF-POINTERS PIC 9.
10 E-D-USER-DATA PIC X(62).
PROCEDURE DIVISION.
PERFORM 00-START-UP
PERFORM 10-INTIAL-FILE-PROCESSING
PERFORM UNTIL W-END-OF-INPUT-PDSIND
CALL "OCDIRBLK" USING INPUT-RECORD
EXPANDED-DIRECTORY
SET E-D-IND TO 1
PERFORM E-D-NUMBER-OF-ENTRIES TIMES
DISPLAY
E-D-MEMBER-NAME ( E-D-IND )
SET E-D-IND UP BY 1
END-PERFORM
PERFORM 99A-READ-INPUT-FILE
END-PERFORM
PERFORM 30-FINALISE-INPUT-PROCESSING
GOBACK
.
00-START-UP.
MOVE WHEN-COMPILED TO W-WHEN-COMPILED
DISPLAY
W-THIS-PROGRAM
" COMPILED ON "
W-WHEN-COMPILED
.
10-INTIAL-FILE-PROCESSING.
OPEN INPUT INPUT-FILE
IF NOT W-PDSIND-FILE-STATUS-OK
DISPLAY W-THIS-PROGRAM " DODGY PDSIND OPEN STATUS "
">" W-PDSIND-FILE-STATUS "<"
CALL "BBDUMP"
END-IF
PERFORM 10A-PRIMING-READ
.
10A-PRIMING-READ.
PERFORM 99A-READ-INPUT-FILE
.
30-FINALISE-INPUT-PROCESSING.
CLOSE INPUT-FILE
IF NOT W-PDSIND-FILE-STATUS-OK
DISPLAY W-THIS-PROGRAM " DODGY PDSIND CLOSE STATUS "
">" W-PDSIND-FILE-STATUS "<"
CALL "BBDUMP"
END-IF
.
99A-READ-INPUT-FILE.
IF W-END-OF-INPUT-PDSIND
DISPLAY "YOIKS"
END-IF
READ INPUT-FILE
IF NOT W-PDSIND-FILE-STATUS-OK
DISPLAY W-THIS-PROGRAM " DODGY PDSIND READ "
">" W-PDSIND-FILE-STATUS "<"
CALL "BBDUMP"
END-IF
.
IDENTIFICATION DIVISION.
PROGRAM-ID. OCDIRBLK.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 LENGTH-UP-DIRECTORY BINARY PIC 9(4).
01 LENGTH-OF-USER-DATA BINARY PIC 9(4).
01 DIRECTORY-DATA-LENGTH BINARY PIC 9(4).
01 HIGH-ORDER-BIT-VALUE BINARY PIC 9(4) VALUE 128.
01 BIT-ONE-VALUE BINARY PIC 9(4) VALUE 64.
01 BIT-TWO-VALUE BINARY PIC 9(4) VALUE 32.
01 USER-DATA-LENGTH BINARY PIC 9(4).
88 NO-USER-HALFWORDS VALUE ZERO.
88 SOME-USER-HALFWORDS VALUE 1 THRU 31.
88 MEMBER-HAS-ONE-POINTER VALUE 32 THRU 63.
88 MEMBER-HAS-TWO-POINTERS VALUE 64 THRU 127.
88 MEMBER-IS-AN-ALIAS VALUE 128 THRU 255.
01 FILLER REDEFINES USER-DATA-LENGTH.
05 FILLER PIC X.
05 USER-DATA-BYTE PIC X.
LINKAGE SECTION.
01 INPUT-DIRECTORY.
05 I-D-LENGTH BINARY PIC 9(4).
88 I-D-NO-MEMBERS VALUE ZERO.
05 FILLER OCCURS 0 TO 252 TIMES
DEPENDING ON LENGTH-UP-DIRECTORY
PIC X.
05 I-D-MEMBER-NAME PIC X(8).
88 I-D-END-OF-BLOCK VALUE HIGH-VALUES.
05 I-D-TRACK-ADDRESS PIC XXX.
05 I-D-INDICATOR PIC X.
05 I-D-USER-DATA.
10 FILLER
OCCURS 0 TO 62 TIMES
DEPENDING ON
LENGTH-OF-USER-DATA.
15 FILLER PIC X.
01 EXPANDED-DIRECTORY.
05 E-D-NUMBER-OF-ENTRIES BINARY PIC 9(4).
05 FILLER OCCURS 22 TIMES.
10 E-D-MEMBER-NAME PIC X(8).
10 E-D-TRACK-ADDRESS PIC X(3).
10 E-D-INDICATOR PIC X(1).
10 E-D-ALIAS-FLAG PIC X.
88 E-D-ALIAS VALUE "Y".
88 E-D-ALIAS-NOT VALUE "N".
10 E-D-NO-OF-POINTERS PIC 9.
10 E-D-USER-DATA PIC X(62).
PROCEDURE DIVISION USING
INPUT-DIRECTORY
EXPANDED-DIRECTORY
.
IF I-D-NO-MEMBERS
MOVE ZERO TO DIRECTORY-DATA-LENGTH
ELSE
SUBTRACT +2 FROM I-D-LENGTH
GIVING DIRECTORY-DATA-LENGTH
END-IF
MOVE ZERO TO E-D-NUMBER-OF-ENTRIES
LENGTH-UP-DIRECTORY
PERFORM UNTIL ( LENGTH-UP-DIRECTORY
NOT LESS THAN DIRECTORY-DATA-LENGTH )
OR ( I-D-END-OF-BLOCK )
ADD 1 TO E-D-NUMBER-OF-ENTRIES
MOVE I-D-MEMBER-NAME TO E-D-MEMBER-NAME
( E-D-NUMBER-OF-ENTRIES )
MOVE I-D-TRACK-ADDRESS TO E-D-TRACK-ADDRESS
( E-D-NUMBER-OF-ENTRIES )
MOVE I-D-INDICATOR TO E-D-INDICATOR
( E-D-NUMBER-OF-ENTRIES )
USER-DATA-BYTE
MOVE ZERO TO E-D-NO-OF-POINTERS
( E-D-NUMBER-OF-ENTRIES )
IF MEMBER-IS-AN-ALIAS
SET E-D-ALIAS ( E-D-NUMBER-OF-ENTRIES )
TO TRUE
SUBTRACT HIGH-ORDER-BIT-VALUE
FROM USER-DATA-LENGTH
ELSE
SET E-D-ALIAS-NOT ( E-D-NUMBER-OF-ENTRIES )
TO TRUE
END-IF
IF MEMBER-HAS-TWO-POINTERS
MOVE 2 TO E-D-NO-OF-POINTERS
( E-D-NUMBER-OF-ENTRIES )
SUBTRACT BIT-ONE-VALUE
FROM USER-DATA-LENGTH
END-IF
IF MEMBER-HAS-ONE-POINTER
ADD 1 TO E-D-NO-OF-POINTERS
( E-D-NUMBER-OF-ENTRIES )
SUBTRACT BIT-TWO-VALUE
FROM USER-DATA-LENGTH
END-IF
IF SOME-USER-HALFWORDS
MULTIPLY USER-DATA-LENGTH BY 2
GIVING LENGTH-OF-USER-DATA
MOVE I-D-USER-DATA TO E-D-USER-DATA
( E-D-NUMBER-OF-ENTRIES )
ADD LENGTH-OF-USER-DATA TO LENGTH-UP-DIRECTORY
ELSE
MOVE SPACE TO E-D-USER-DATA
( E-D-NUMBER-OF-ENTRIES )
MOVE ZERO TO LENGTH-OF-USER-DATA
END-IF
ADD 12 TO LENGTH-UP-DIRECTORY
END-PERFORM
GOBACK
.
END PROGRAM OCDIRBLK.
END PROGRAM STOB30.
这是 JCL 的示例:
//LISTDIR EXEC PGM=STOB30,TIME=(,2)
//STEPLIB DD DSN=yours as necessary
//SYSOUT DD SYSOUT=* for the DISPLAY output
//PDSIND DD DSN=your pds/pdse,
// DISP=SHR,LRECL=256,RECFM=U
请注意，在设置 JCL 时，我没有包含 RECFM=U(意外)。使用 RECFM=FB,LRECL=80 PDS 和 RECFM=U PDSE 运行干净，产生正确的结果。
这让我很惊讶。您的里程可能会有所不同。
关于cobol - 与 DDNAME 关联的 PDS 成员列表，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/34352693/