01 entry
03 attribute cblt-x4-comp5. *> pic x(4) comp-5
03 date-stamp
05 year cblt-x4-comp5. *> pic x(4) comp-5
05 month cblt-x2-comp5. *> pic x(2) comp-5
05 day cblt-x2-comp5. *> pic x(2) comp-5
05 hour cblt-x2-comp5. *> pic x(2) comp-5
05 minute cblt-x2-comp5. *> pic x(2) comp-5
05 second cblt-x2-comp5. *> pic x(2) comp-5
05 millisec cblt-x2-comp5. *> pic x(2) comp-5
05 dst cblt-x1-comp5. *> pic x comp-5
05 size cblt-x8-comp5. *> pic x(8) comp-5
05 name
07 max-len cblt-x2-comp5. *> pic x(2) comp-5
07 entry-name 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.
コメント：
エントリ名フィールドが結果を収容するには小さすぎるというエラーは無視される。十分な大きさのフィールドを供給しない場合、結果はフィールドの大きさに合うよう切り詰められる。また、max-len より短い長さのフィールドを供給した場合はメモリの内容が破壊される可能性がある。