Filename Routines - Example

************************************************************
*                                                          *
*         (C) Micro Focus International Ltd 2000           *
*                                                          *
*                     SPLTJOIN.CBL                         *
*                                                          *
*  This program demonstrates the use of the routines that  *
*  enable you to separate a filename into its component    *
*  strings (CBL_SPLIT_FILENAME), and to join strings       *
*  together to form a filename (CBL_JOIN_FILENAME).        *
*                                                          *
************************************************************

 identification division.
 program-id. SPLTJOIN.
 environment division.
 data division.
 working-storage section.

 copy "cbltypes.cpy".

 78 environ          value "dos".

 01 split-buffer                     pic x(65).
 01 split-params                          cblt-splitjoin-buf.
*    03  cblte-sj-param-length            cblt-x2-compx value 24.
*    03  cblte-sj-split-join-flag1        cblt-x1-compx value 0.
*    03  cblte-sj-split-join-flag2        cblt-x1-compx.
*    03  cblte-sj-device-offset           cblt-x2-compx.
*    03  cblte-sj-device-length           cblt-x2-compx.
*    03  cblte-sj-basename-offset         cblt-x2-compx.
*    03  cblte-sj-basename-length         cblt-x2-compx.
*    03  cblte-sj-extension-offset        cblt-x2-compx.
*    03  cblte-sj-extension-length        cblt-x2-compx.
*    03  cblte-sj-total-length            cblt-x2-compx.
*    03  cblte-sj-split-buf-len           cblt-x2-compx value 65.
*    03  cblte-sj-join-buf-len            cblt-x2-compx value 65.
*    03  cblte-sj-first-component-length  cblt-x1-compx.

 01 join-buffer              pic x(65).
 01 path-buffer              pic x(65).
 01 basename-buffer          pic x(65).
 01 extension-buffer         pic x(3) value "cbl".

 procedure division.

* Set up lengths
     move 65 to cblte-sj-split-buf-len
                cblte-sj-join-buf-len

* Set flag for space-terminated, fold to upper
     move 1 to cblte-sj-split-join-flag1

$if environ = "unix"
     move "/dir/file.ext" to split-buffer
$else
     move "a:\dir\file.ext" to split-buffer

$end
     move 1 to cblte-sj-split-join-flag1
     move 24 to cblte-sj-param-length
     call "CBL_SPLIT_FILENAME" using split-params
                                     split-buffer

* This sets up most of the parameters you need for a join

* The join below replaces the original extension in 
* split-buffer with the extension in extension-buffer, and
* puts the result in join-buffer.
     move 1 to cblte-sj-extension-offset
     move 3 to cblte-sj-extension-length
     call "CBL_JOIN_FILENAME" using split-params
                                    join-buffer
                                    split-buffer
                                    split-buffer
                                    extension-buffer

$if environ = "unix"
     if join-buffer = "/DIR/FILE.CBL" then
$else
     if join-buffer = "A:\DIR\FILE.CBL" then
$end
         display "first test passed"
     else
         display "first test failed"
     end-if

* It is harder to set up a join without doing a split first,
* but this is what you would need to do.

     move 1 to cblte-sj-device-offset
               cblte-sj-basename-offset
               cblte-sj-extension-offset

     move length of path-buffer to cblte-sj-device-length
     move length of basename-buffer 
                                to cblte-sj-basename-length
     move length of extension-buffer 
                                to cblte-sj-extension-length
     move length of join-buffer to cblte-sj-join-buf-len

     move 0 to cblte-sj-split-join-flag1
     move 24 to cblte-sj-param-length

$if environ = "unix"
     move "/path" to path-buffer
$else
     move "c:\path" to path-buffer
$end
     move "basename" to basename-buffer

     move "ext" to extension-buffer

     call "CBL_JOIN_FILENAME" using split-params
                                    join-buffer
                                    path-buffer
                                    basename-buffer
                                    extension-buffer

$if environ = "unix"
     if join-buffer = "/path/basename.ext" then
$else
     if join-buffer = "c:\path\basename.ext" then
$end
         display "second test passed"
     else

         display "second test failed"
     end-if
  stop run.