01 entry-data.
03 entry-data-attribute cblt-x4-comp5. *> pic x(4) comp-5
03 entry-data-date-stamp.
05 stamp-year cblt-x4-comp5. *> pic x(4) comp-5
05 stamp-month cblt-x2-comp5. *> pic x(2) comp-5
05 stamp-day cblt-x2-comp5. *> pic x(2) comp-5
05 stamp-hour cblt-x2-comp5. *> pic x(2) comp-5
05 stamp-minute cblt-x2-comp5. *> pic x(2) comp-5
05 stamp-sec cblt-x2-comp5. *> pic x(2) comp-5
05 stamp-msec cblt-x2-comp5. *> pic x(2) comp-5
05 stamp-dst cblt-x1-comp5. *> pic x comp-5
05 stamp-size cblt-x8-comp5. *> pic x(8) comp-5
05 entry-data-name.
07 name-length cblt-x2-comp5. *> pic x(2) comp-5
07 name-text pic x(max-len).
次の例は、UNIX 環境と Windows 環境の両方で使用できます。
$SET FOLDCOPYNAME"LOWER"
*
* Environment variable COBCPY must be set as follows:
*
* Unix:
* COBCPY=$COBDIR/cpylib:$COBCPY
* export COBCPY
*
* Windows:
* set COBCPY=%COBDIR%\cpylib;%COBCPY%
*
copy cblproto.
identification division.
program-id. dirdemo.
data division.
working-storage section.
* Variables for CBL_DIR_SCAN_BEGIN
* Some used by other CBL_DIR_SCAN_ routines.
* The handle.
01 dir-handle pointer.
* The pattern. I chose a null terminator instead of
* specified length.
01 dir-name-pattern.
10 dir-name-pattern-length cblt-x2-comp5 value zero.
10 dir-name-pattern-text pic x(2048).
* The terminator.
01 pattern-terminator pic x value low-values.
* Search attributes.
01 search-attributes cblt-x4-comp5 value zero.
78 find-file value 1.
78 find-directory value 2.
78 find-neither value 4.
* Flags
01 dirflags cblt-os-flags.
78 escape-seq value 1.
78 wildcards value 2.
01 search-status pic xx comp-5.
* Variables for CBL_DIR_SCAN_READ
* The entry.
01 entry-data.
10 entry-data-attribute cblt-x4-comp5.
10 entry-data-date-stamp.
20 stamp-year cblt-x4-comp5.
20 stamp-month cblt-x2-comp5.
20 stamp-day cblt-x2-comp5.
20 stamp-hour cblt-x2-comp5.
20 stamp-minute cblt-x2-comp5.
20 stamp-sec cblt-x2-comp5.
20 stamp-msec cblt-x2-comp5.
20 stamp-dst cblt-x1-comp5.
20 stamp-size cblt-x8-comp5.
10 entry-data-name.
20 name-length cblt-x2-comp5 value 50.
20 name-text pic x(50).
* Variables for CBL_DIR_SCAN_END
* No additional data items required.
* Command line argument data area
01 arg-pos pic 9 value 1.
01 arg-text pic x(2048) value spaces.
* Variables to make program Unix/Windows universal
01 default-path pic x(7).
78 win-path value 'C:\xyz'.
78 unix-path value '/var'.
* Parameter block for CBL_GET_OS_INFO, ignoring all but OS type
01 osinfo.
10 osinfo-length pic x(2) comp-x value 23.
10 os-type pic x comp-x.
10 osinfo-junk pic x(25).
* OTHER VARIABLES
01 attrib-work pic x comp-5.
01 attrib-text pic x(10).
01 nonblank-len pic 9(9).
01 terminator-position pic 9(9).
01 return-val cblt-rtncode.
procedure division.
* Find out whether this is Unix or Windows,
* and set default path appropriately.
call 'CBL_GET_OS_INFO' using osinfo
returning return-val.
if os-type = 128 or os-type = 129
* Unix
move unix-path to default-path
else
* Windows, OS/2, or DOS.
move win-path to default-path.
* Check for directory specification on command line.
display arg-pos upon argument-number.
accept arg-text from argument-value.
if arg-text = spaces
move default-path to dir-name-pattern-text
else
move arg-text to dir-name-pattern-text.
* Find the nonblank length and append string terminator.
perform varying nonblank-len
from function length(dir-name-pattern-text)
by -1 until
dir-name-pattern-text(nonblank-len:1) <> space
or
nonblank-len = 1.
add 1 to nonblank-len giving terminator-position.
move pattern-terminator
to dir-name-pattern-text(terminator-position:1).
* Set desired search attributes by name.
compute search-attributes =
find-file +
find-directory +
find-neither.
move zero to dirflags.
* Start the scan -- similar to opening a file.
call 'CBL_DIR_SCAN_START' using
dir-handle
dir-name-pattern
search-attributes
dirflags
returning
search-status.
* Read to end, similar to reading a file.
perform walk-dir thru walk-dir-exit until
search-status <> zero.
* At end or upon error, end the scan, similar to closing a file.
call 'CBL_DIR_SCAN_END' using
dir-handle
returning
search-status.
* End the program.
display 'That''s all!'.
goback.
walk-dir.
* Initialize name-text; function does not right-pad to length.
move spaces to name-text.
* Do the read.
call 'CBL_DIR_SCAN_READ' using
dir-handle
entry-data
returning
search-status.
if search-status <> zero exit paragraph.
* Remove all but the two rightmost bits of result.
move function MOD(entry-data-attribute, 3) to attrib-work.
* Format result display.
evaluate attrib-work
when 1 move 'File' to attrib-text
when 2 move 'Directory' to attrib-text
when other move '???' to attrib-text.
display 'Next entry is: '
attrib-text ' ' name-text(1:name-length).
walk-dir-exit.
説明：
エントリ名フィールドが結果を収容するには小さすぎるというエラーは無視されます。十分な大きさのフィールドを供給しない場合、結果はフィールドの大きさに合うよう切り詰められます。また、name-length より短い長さのフィールドを供給した場合はメモリの内容が破壊される可能性があります。