000100 Identification Division.
000200 PROGRAM-ID. COBUNSTR.
000300*===============================================================
000400* exemple d'UNSTRING avec comptage longueurs sur tableau indexé
000500* -------   + STRING de reconstitution du message final
000600* Ce pgm lit une ligne en SYSIN et fait un display des mots lus
000700* apres reformatage : chaque mot est rendu via un DISPLAY sur
000800* 8 caractères maxi mais on y ajoute sa longueur effective
000900* 6 mots maxi traités dans cet exemple (via tableau indexé).
001000*   (seuls l'occurs et l'Unstring à modifier pour + de mots)
001100*===============================================================
001200*=exemple de restitution : =====================================
001300* LU=  TEST       PGM         COBOLTEST001   COBTSTU
001400* TR=TEST    (04) PGM     (03) COBOLTES(12) COBTSTU (07)
001500* Nombre de mots : 0004 (Long. totale : 0026)
001600*===============================================================
001700 Data Division.
001800 Working-Storage Section.
001900*========================
002000 01.
002100*    Variables de gestion
002200     05  LG-TOT                pic s9(4) comp-3.
002300     05  LG-MOT                pic 99.
002400     05  WS-MOT                pic x(8).
002500     05  CPTR-MOTS             Pic s9(4) comp-3.
002600     05  TABLEAU  occurs 6     Indexed by IM.
002700         10  LG-MOTS           pic s9(4).
002800         10  MOTS              pic x(78).
002900*    Donnée en Input et Output
003000 01  WS-DATA                   pic x(120).
003100
003200*===================
003300 Procedure Division.
003400*===================
003500 DEBUT-PGM.
003600     Accept WS-DATA from SYSIN
003700
003800     Move ZERO  to CPTR-MOTS
003900*       Alimentation tableau via Unstring
004000*      (Si ligne vide ou commence par des blancs, 1er poste à 0)
004100     Unstring WS-DATA      Delimited by all SPACE or all ';'
004200              Into MOTS(1) Count in LG-MOTS(1)
004300                   MOTS(2) Count in LG-MOTS(2)
004400                   MOTS(3) Count in LG-MOTS(3)
004500                   MOTS(4) Count in LG-MOTS(4)
004600                   MOTS(5) Count in LG-MOTS(5)
004700                   MOTS(6) Count in LG-MOTS(6)
004800              Tallying           in CPTR-MOTS
004900         On Overflow   Display 'PLUS DE 6 MOTS DANS LA PHRASE !'
005000                       Move    8 To RETURN-CODE
005100         Not On Overflow
005200                       If CPTR-MOTS < 2 and LG-MOTS(1) = 0 then
005300                          Display 'Ligne lue en SYSIN vide !'
005400                          Move 4 To RETURN-CODE
005500                       Else
005600                          Move 0 To RETURN-CODE
005700                          Perform AFFICHER
005800                       End-if
005900     End-Unstring
006000     Goback.
006100
006200 AFFICHER.
006300* -- Display donnée lue et résultat de la remise en forme
006400     Display 'LU=' WS-DATA
006500
006600     Move ';'   to WS-DATA
006700     Move  0    to LG-TOT
006800     Set  IM    to 1
006900*    Boucle pour constitution donnée pour Display Global
007000     Perform    CPTR-MOTS   Times
007100        If      LG-MOTS(IM) >  0   then
007200           Add  LG-MOTS(IM) to LG-TOT
007300           Move LG-MOTS(IM) to LG-MOT
007400           Move    MOTS(IM) to WS-MOT
007500           String  WS-DATA                    delimited by ';'
007600                   WS-MOT '(' LG-MOT ') ;'    delimited by size
007700              into WS-DATA
007800        End-If
007900        Set IM up by 1
008000     End-Perform
008100
008200*    Suppression du dernier séparateur de mots
008300     Inspect WS-DATA converting ';' to x'40'
008400
008500     Display 'TR=' WS-DATA
008600     If LG-MOTS(1) = 0 and CPTR-MOTS > 0 then
008700*       La donnée commence par un ou des blancs : CPTR1 NS
008800        Subtract 1 from CPTR-MOTS
008900     End-If
009000     Display 'Nombre de mots : ' CPTR-MOTS
009100             ' (Long. totale : ' LG-TOT ')'
009200                    .
009300 End Program COBUNSTR.