Tous les articles par Mr COBOL

COBOL Exemple

Exemple – MULTIPLY

Programme utilisant le MULTIPLY :

IDENTIFICATION DIVISION.
PROGRAM-ID.  MULTIPLY.
AUTHOR.      LA COMMUNAUTE DU COBOL.

ENVIRONMENT DIVISION.                                            
CONFIGURATION SECTION.                                           
SPECIAL-NAMES.                                                   
    DECIMAL-POINT IS COMMA. 

DATA DIVISION.
WORKING-STORAGE SECTION.

01  WS-AUXILIARES.
    05  VALEUR-1         PIC S9(009)       VALUE ZEROES. 
    05  VALEUR-2         PIC S9(009)       VALUE ZEROES. 
    05  VALEUR-3         PIC S9(009)       VALUE ZEROES. 

PROCEDURE DIVISION.

001-INIT.

Exemple MULTIPLY

    MOVE   8 TO VALEUR-1
    MOVE   9 TO VALEUR-2
    MULTIPLY VALEUR-1 BY VALEUR-2	
    DISPLAY "VALEUR-1  " VALEUR-1 
    DISPLAY "VALEUR-2  " VALEUR-2 

* Resultat de test:

* VALEUR-1  +000000008
* VALEUR-2  +000000072

    MOVE  23 TO VALEUR-1
    MULTIPLY 5 BY VALEUR-1	
    DISPLAY "VALEUR-1  " VALEUR-1 

* Resultat de test:

* VALEUR-1  +000000115

    MOVE -10 TO VALEUR-1
    MULTIPLY 5 BY VALEUR-1	
    DISPLAY "VALEUR-1  " VALEUR-1 

* Resultat de test:

* VALEUR-1  -000000050

    MOVE -10 TO VALEUR-1
    MULTIPLY -5 BY VALEUR-1	
    DISPLAY "VALEUR-1  " VALEUR-1 

* Resultat de test:

* VALEUR-1  +000000050

Exemple MULTIPLY GIVING

    MOVE   8 TO VALEUR-1
    MOVE   9 TO VALEUR-2
    MOVE  16 TO VALEUR-3
    MULTIPLY VALEUR-1 BY VALEUR-2 GIVING VALEUR-3	
    DISPLAY "VALEUR-1  " VALEUR-1 
    DISPLAY "VALEUR-2  " VALEUR-2 
    DISPLAY "VALEUR-3  " VALEUR-3 

* Resultat de test:

* VALEUR-1  +000000008
* VALEUR-2  +000000009
* VALEUR-3  +000000072

    MOVE  10 TO VALEUR-1
    MOVE  -2 TO VALEUR-2
    MULTIPLY VALEUR-1 BY VALEUR-2 GIVING VALEUR-3	
    DISPLAY "VALEUR-1  " VALEUR-1 
    DISPLAY "VALEUR-2  " VALEUR-2 
    DISPLAY "VALEUR-3  " VALEUR-3 

* Resultat de test:

* VALEUR-1  +000000010
* VALEUR-2  -000000002
* VALEUR-3  -000000020

    MOVE -10 TO VALEUR-1
    MOVE   2 TO VALEUR-2
    MULTIPLY VALEUR-1 BY VALEUR-2 GIVING VALEUR-3	
    DISPLAY "VALEUR-1  " VALEUR-1 
    DISPLAY "VALEUR-2  " VALEUR-2 
    DISPLAY "VALEUR-3  " VALEUR-3 

* Resultat de test:

* VALEUR-1  -000000010
* VALEUR-2  +000000002
* VALEUR-3  -000000020

    MOVE -10 TO VALEUR-1
    MOVE  -2 TO VALEUR-2
    MULTIPLY VALEUR-1 BY VALEUR-2 GIVING VALEUR-3	
    DISPLAY "VALEUR-1  " VALEUR-1 
    DISPLAY "VALEUR-2  " VALEUR-2 
    DISPLAY "VALEUR-3  " VALEUR-3 

* Resultat de test:

* VALEUR-1  -000000010
* VALEUR-2  -000000002
* VALEUR-3  +000000020

    MOVE  23 TO VALEUR-1
    MOVE  78 TO VALEUR-2
    MULTIPLY 5       BY VALEUR-2 GIVING VALEUR-2	
    DISPLAY "VALEUR-1  " VALEUR-1 
    DISPLAY "VALEUR-2  " VALEUR-2 

* Resultat de test:

* VALEUR-1  +000000023
* VALEUR-2  +000000390
COBOL Exemple

Exemple – PERFORM VARYING UNTIL AFTER

Un bloc d’instruction ou un paragraphe/section sera exécuté dans PERFORM VARYING jusqu’à ce que la condition devienne vraie dans la phrase UNTIL.

Dans l’exemple ci-dessous, il y a trois DEPARTEMENTS et chaque département a deux EMPLOYES.

       IDENTIFICATION DIVISION.                                         
       PROGRAM-ID.       PERFORM.                                      
       AUTHOR.           LA COMMUNAUTE DU COBOL.                      
       ENVIRONMENT DIVISION.                                            
    
       CONFIGURATION SECTION.                                           
       SPECIAL-NAMES.                                                   
               DECIMAL-POINT IS COMMA. 

       DATA DIVISION.

       WORKING-STORAGE SECTION.                                         

       01  WS-AUXILIARES.
           05 WS-DEPT-01       PIC 9(002) VALUE ZEROES.
           05 WS-DEPT-02       PIC 9(002) VALUE ZEROES.

       01  TABLE-DEPARTAMENT.
           05 DEPARTAMENT                OCCURS 3 TIMES.
              10 NOM-DEPT      PIC X(20).
              10 NOM-EMPL      PIC X(20) OCCURS 2 TIMES.

       PROCEDURE DIVISION.

           MOVE "FACTURATION"   TO NOM-DEPTO (1)
           MOVE "QUALITE"       TO NOM-DEPTO (2)
           MOVE "MARKETING"     TO NOM-DEPTO (3)

           MOVE "Carl"          TO NOM-EMPL (1 1)	
           MOVE "Albert"        TO NOM-EMPL (1 2)	
           MOVE "Augustin"      TO NOM-EMPL (2 1)	
           MOVE "Eduard"        TO NOM-EMPL (2 2)	
           MOVE "Antoine"       TO NOM-EMPL (3 1)	
           MOVE "Marie"         TO NOM-EMPL (3 2)  

           DISPLAY "--------------------------------------------------------------------------------------------"
           DISPLAY "En utilisant PERFORM VARYING UNTIL "
           DISPLAY "--------------------------------------------------------------------------------------------"
           
           PERFORM VARYING WS-DEPT-01 FROM 1 BY 1
                     UNTIL WS-DEPT-01 > 3
              PERFORM VARYING WS-DEPT-02 FROM 1 BY 1
                        UNTIL WS-DEPT-02 > 2
                 PERFORM PARAGRAF-1 THRU PARAGRAF-1-FIN
              END-PERFORM                                                     
           END-PERFORM                                                     
           
           DISPLAY "--------------------------------------------------------------------------------------------"
           DISPLAY "En utilisant PERFORM VARYING UNTIL AFTER"
           DISPLAY "--------------------------------------------------------------------------------------------"
			  
           PERFORM PARAGRAF-1 THRU PARAGRAF-1-FIN
                  VARYING WS-DEPT-01 FROM 1 BY 1
                          UNTIL WS-DEPT-01 > 3
                  AFTER   WS-DEPT-02 FROM 1 BY 1
                          UNTIL WS-DEPT-02 > 2.
           STOP RUN.

       PARAGRAFO-1.

           DISPLAY " DEPARTAMENT : "  NOM-DEPT (WS-DEPT-01)
                   " EMPLOYEES   : "  NOME-EMPL (WS-DEPT-01 WS-DEPT-02).

       PARAGRAF-1-FIN.
           EXIT.

Résultat du test

--------------------------------------------------------------------------------------------
En utilisant PERFORM VARYING UNTIL 
--------------------------------------------------------------------------------------------
       DEPARTAMENT: FACTURATION          EMPLOYEES   : Carl
       DEPARTAMENT: FACTURATION          EMPLOYEES   : Albert
       DEPARTAMENT: QUALITE              EMPLOYEES   : Augustin
       DEPARTAMENT: QUALITE              EMPLOYEES   : Eduard
       DEPARTAMENT: MARKETING            EMPLOYEES   : Antoine
       DEPARTAMENT: MARKETING            EMPLOYEES   : Marie
--------------------------------------------------------------------------------------------
En utilisant PERFORM VARYING UNTIL AFTER
--------------------------------------------------------------------------------------------
       DEPARTAMENT: FACTURATION          EMPLOYEES   : Carl
       DEPARTAMENT: FACTURATION          EMPLOYEES   : Albert
       DEPARTAMENT: QUALITE              EMPLOYEES   : Augustin
       DEPARTAMENT: QUALITE              EMPLOYEES   : Eduard
       DEPARTAMENT: MARKETING            EMPLOYEES   : Antoine
       DEPARTAMENT: MARKETING            EMPLOYEES   : Marie
COBOL Exemple

Exemple – SEARCH dans une table

Programme utilisant le SEARCH :

      *----------------------------------------------------
       IDENTIFICATION DIVISION.                                         
      *----------------------------------------------------
       PROGRAM-ID.       SEARCH.                                      
       AUTHOR.           LA COMMUNAUTE DU COBOL.                      
      *----------------------------------------------------
      *  PROGRAMME     : SEARCH                                       
      *  OBJECTIF      : UTILISER LA COMMANDE SEARCH DANS 
      *                : UNE TABLE          
      *----------------------------------------------------

      *----------------------------------------------------
       ENVIRONMENT DIVISION.                                            
    
       CONFIGURATION SECTION.                                           
       SPECIAL-NAMES.                                                   
               DECIMAL-POINT IS COMMA. 

       DATA DIVISION.

       WORKING-STORAGE SECTION.                                         

       01  WS-TABLE-ETATS.                                           
           05 TAB-NOM-ETAT.                                              
              10  FILLER       PIC X(021) VALUE "ACACRE               ".
              10  FILLER       PIC X(021) VALUE "ALALAGOAS            ".
              10  FILLER       PIC X(021) VALUE "AMAMAZONAS           ".
              10  FILLER       PIC X(021) VALUE "APAMAPA              ".
              10  FILLER       PIC X(021) VALUE "BABAHIA              ".
              10  FILLER       PIC X(021) VALUE "CECEARA              ".
              10  FILLER       PIC X(021) VALUE "DFDISTRITO FEDERAL   ".
              10  FILLER       PIC X(021) VALUE "ESESPIRITO SANTO     ".
              10  FILLER       PIC X(021) VALUE "GOGOIAS              ".
              10  FILLER       PIC X(021) VALUE "MAMARANHAO           ".
              10  FILLER       PIC X(021) VALUE "MGMINAS GERAIS       ".
              10  FILLER       PIC X(021) VALUE "MSMATO GROSSO DO SUL ".
              10  FILLER       PIC X(021) VALUE "MTMATO GROSSO        ".
              10  FILLER       PIC X(021) VALUE "PAPARA               ".
              10  FILLER       PIC X(021) VALUE "PBPARAIBA            ".
              10  FILLER       PIC X(021) VALUE "PEPERNAMBUCO         ".
              10  FILLER       PIC X(021) VALUE "PIPIAUI              ".
              10  FILLER       PIC X(021) VALUE "PRPARANA             ".
              10  FILLER       PIC X(021) VALUE "RJRIO DE JANEIRO     ".
              10  FILLER       PIC X(021) VALUE "RNRIO GRANDE DO NORTE".
              10  FILLER       PIC X(021) VALUE "RORONDONIA           ".
              10  FILLER       PIC X(021) VALUE "RRRORAIAMA           ".
              10  FILLER       PIC X(021) VALUE "RSRIO GRANDE DO SUL  ".
              10  FILLER       PIC X(021) VALUE "SCSANTA CATARINA     ".
              10  FILLER       PIC X(021) VALUE "SESERGIPE            ".
              10  FILLER       PIC X(021) VALUE "SPSAO PAULO          ".
              10  FILLER       PIC X(021) VALUE "TOTOCANTINS          ".
           05 TAB-NOM-ETAT-R    REDEFINES  TAB-NOM-ETAT.                  
              07  WS-ETAT      OCCURS 27 TIMES                          
                               ASCENDING KEY SIGLA-UF                  
                               INDEXED BY IX-TAB.                       
                  10  SIGLE-ETAT PIC X(002).                              
                  10  NOM-ETAT   PIC X(019).                              

       01  WS-AUXILIARES.                                               
           05 NON-TROUVE         PIC 9(003) VALUE ZEROES.       
           05 WS-SIGLE-ETAT      PIC X(002) VALUE SPACES.       
           05 WS-VARIABLE        PIC X(019) VALUE SPACES.       

       PROCEDURE DIVISION.                                              

           MOVE ZEROES TO NON-TROUVE                                
           MOVE "SP"   TO WS-SIGLE-ETAT
           SET IX-TAB TO 1                                              
           SEARCH WS-ETAT                                           
                  AT END                                                
                     MOVE 1 TO NON-TROUVE                         
                WHEN SIGLE-ETAT (IX-TAB) EQUAL WS-SIGLE-ETAT                
                     MOVE NOM-ETAT (IX-TAB) TO WS-VARIABLE                           
           END-SEARCH                                                   

           IF  NON-TROUVE  EQUAL 1
               DISPLAY "SIGLE - " WS-SIGLE-ETAT " NON TROUVE"
           ELSE
               DISPLAY "SIGLE - " WS-SIGLE-ETAT " - "
                        WS-VARIABLE " TROUVE "
           END-IF 
           STOP RUN.

           SIGLE - SP - SAO PAULO           TROUVE

           MOVE "FN"   TO WS-SIGLE-ETAT
           SIGLE - FN NON TROUVE
COBOL Exemple

Exemple – SEARCH (Plusieurs conditions)

SEARCH fonctionne comme ceci :

  • SEARCH sur nom-tableau commence par la valeur initiale de l’index associé.
  • Si l’une des conditions 1, 2, 3, etc. est satisfaite, l’instruction impérative respective s’exécutera et SEARCH se terminera et l’index restera défini au point où la condition était remplie.
  • Si aucune des conditions n’est remplie, l’index est automatiquement incrémenté de 1.
    La recherche se poursuit jusqu’à ce que la fin du tableau ou de la condition soit remplie.
  • AT END de la recherche, instruction-impérative-1 sera exécutée et l’index aura une valeur imprévisible

Syntaxe basique

SEARCH nom-tableau
       AT END instruction-impérative-1
     WHEN condition-1
          instruction-impérative-2
     WHEN condition-2
          instruction-impérative-3 ...
     WHEN condition-3
          instruction-impérative-4 ...
END-SEARCH

Exemple

      *----------------------------------------------------
       IDENTIFICATION DIVISION.       
      *----------------------------------------------------
       PROGRAM-ID.    SEARCH.                                  
       AUTHOR.        LA COMMUNAUTE DU COBOL.

      *----------------------------------------------------
       ENVIRONMENT DIVISION.                                            
      *----------------------------------------------------
       CONFIGURATION SECTION.                                           
       SPECIAL-NAMES.                                                   
               DECIMAL-POINT IS COMMA. 

      *----------------------------------------------------
       DATA DIVISION.
      *----------------------------------------------------

       WORKING-STORAGE SECTION.                                         

       01  WS-TABLE-ETAT.                                           
           05 TAB-NOM-ETAT.                                              
              10  FILLER    PIC X(023) VALUE "ACACRE               01".
              10  FILLER    PIC X(023) VALUE "ALALAGOAS            02".
              10  FILLER    PIC X(023) VALUE "AMAMAZONAS           03".
              10  FILLER    PIC X(023) VALUE "APAMAPA              04".
              10  FILLER    PIC X(023) VALUE "BABAHIA              05".
              10  FILLER    PIC X(023) VALUE "CECEARA              06".
              10  FILLER    PIC X(023) VALUE "DFDISTRITO FEDERAL   07".
              10  FILLER    PIC X(023) VALUE "ESESPIRITO SANTO     08".
              10  FILLER    PIC X(023) VALUE "GOGOIAS              09".
              10  FILLER    PIC X(023) VALUE "MAMARANHAO           10".
              10  FILLER    PIC X(023) VALUE "MGMINAS GERAIS       11".
              10  FILLER    PIC X(023) VALUE "MSMATO GROSSO DO SUL 12".
              10  FILLER    PIC X(023) VALUE "MTMATO GROSSO        13".
              10  FILLER    PIC X(023) VALUE "PAPARA               14".
              10  FILLER    PIC X(023) VALUE "PBPARAIBA            15".
              10  FILLER    PIC X(023) VALUE "PEPERNAMBUCO         16".
              10  FILLER    PIC X(023) VALUE "PIPIAUI              17".
              10  FILLER    PIC X(023) VALUE "PRPARANA             18".
              10  FILLER    PIC X(023) VALUE "RJRIO DE JANEIRO     19".
              10  FILLER    PIC X(023) VALUE "RNRIO GRANDE DO NORTE20".
              10  FILLER    PIC X(023) VALUE "RORONDONIA           21".
              10  FILLER    PIC X(023) VALUE "RRRORAIAMA           22".
              10  FILLER    PIC X(023) VALUE "RSRIO GRANDE DO SUL  23".
              10  FILLER    PIC X(023) VALUE "SCSANTA CATARINA     24".
              10  FILLER    PIC X(023) VALUE "SESERGIPE            25".
              10  FILLER    PIC X(023) VALUE "SPSAO PAULO          26".
              10  FILLER    PIC X(023) VALUE "TOTOCANTINS          27".
           05 TAB-NOM-ETAT-R   REDEFINES  TAB-NOM-ETAT.                  
              10  WS-ETAT      OCCURS 27 TIMES                          
                               ASCENDING KEY SIGLA-UF 
                               INDEXED BY IX-TAB.                       
                  15  SIGLE-ETAT   PIC X(002).                              
                  15  NOM-ETAT     PIC X(019).                              
                  15  NUMERO-ETAT  PIC 9(002).

       01  WS-AUXILIARES.                                               
           05 NON-TROUVE         PIC 9(003) VALUE ZEROES.       
           05 WS-SIGLE-ETAT      PIC X(002) VALUE SPACES.       
           05 WS-NOM-ETAT        PIC X(019) VALUE SPACES.
           05 WS-NUMERO-ETAT     PIC 9(002) VALUE ZEROES.
           05 WS-VARIABLE        PIC X(019) VALUE SPACES.       

      *----------------------------------------------------
       PROCEDURE DIVISION.                                              
      *----------------------------------------------------

           MOVE ZEROES      TO NON-TROUVE                                
           MOVE "RS"        TO WS-SIGLE-ETAT
           MOVE "AAAAA"     TO WS-NOM-ETAT
           MOVE 03          TO WS-NUMERO-ETAT
           SET IX-TAB TO 1                                              
           SEARCH WS-ETAT                                           
                  AT END                                                
                     MOVE 1 TO NON-TROUVE                           
                WHEN SIGLE-ETAT  (IX-TAB)  EQUAL WS-SIGLE-ETAT                
                     MOVE NOM-ETAT (IX-TAB)     TO WS-VARIABLE                           
                WHEN NOM-ETAT    (IX-TAB)  EQUAL WS-NOM-ETAT                
                     MOVE NOM-ETAT (IX-TAB)     TO WS-VARIABLE               
                WHEN NUMERO-ETAT (IX-TAB)  EQUAL WS-NUMERO-ETAT                
                     MOVE NOM-ETAT (IX-TAB)     TO WS-VARIABLE               
           END-SEARCH                                                   

           IF  NON-TROUVE EQUAL 1
               DISPLAY " Sigle  - " WS-SIGLE-ETAT 
                       " Nom    - " WS-NOM-ETAT 
                       " Numero - " WS-NUMERO-ETAT " NON TROUVE"
           ELSE
               DISPLAY " Sigle  - " WS-SIGLE-ETAT 
                       " Nom    - " WS-VARIABLE 
                       " Numero - " WS-NUMERO-ETAT " TROUVE"
           END-IF 
           STOP RUN.

Tests effectués:

       MOVE "RS"               TO WS-SIGLE-ETAT
       MOVE "AAAAA"            TO WS-NOM-ETAT
       MOVE 03                 TO WS-NUMERO-ETAT -----> pris cette valeur qui est la première du tableau, parmi les valeurs renseignées
       Sigle  - RS Nome   - AMAZONAS            Numero - 03 TROUVE

           
       MOVE "RS"               TO WS-SIGLE-ETAT ------> pris cette valeur qui est la première du tableau, parmi les valeurs renseignées
       MOVE "AAAAA"            TO WS-NOM-ETAT
       MOVE 28                 TO WS-NUMERO-ETAT
       Sigle  - RS Nome   - RIO GRANDE DO SUL   Numero - 28 TROUVE

       MOVE "TO"               TO WS-SIGLE-ETAT
       MOVE "DISTRITO FEDERAL" TO WS-NOM-ETAT -------> pris cette valeur qui est la première du tableau, parmi les valeurs renseignées
       MOVE 25                 TO WS-NUMERO-ETAT
       Sigle  - TO Nome   - DISTRITO FEDERAL    Numero - 25 TROUVE

           
       MOVE "FN"               TO WS-SIGLE-ETAT
       MOVE "DISTRIT FEDERAL"  TO WS-NOM-ETAT
       MOVE 29                 TO WS-NUMERO-ETAT
       Sigle  - FN Nome   - DISTRIT FEDERAL     Numero - 29 NON TROUVE

COBOL Exemple

Exemple – SEARCH ALL

Programme utilisant le SEARCH ALL :

      *----------------------------------------------------
       IDENTIFICATION DIVISION.                                         
      *----------------------------------------------------
       PROGRAM-ID.      SEARCHALL.                                       
       AUTHOR.          LA COMMUNAUTE DU COBOL.                       
      *----------------------------------------------------
       ENVIRONMENT DIVISION.                                            
      *----------------------------------------------------
       CONFIGURATION SECTION.                                           
       SPECIAL-NAMES.                                                   
                        DECIMAL-POINT IS COMMA.                         

      *----------------------------------------------------
       DATA DIVISION.                                                   
      *----------------------------------------------------

       WORKING-STORAGE SECTION.                                         
                                                                        
        01  WS-TABLE-PRODUITS.                                           
           05 TAB-PRODUITS.                                              
              10  FILLER       PIC X(021) VALUE "01RIZ".
              10  FILLER       PIC X(021) VALUE "02FARITAS".
              10  FILLER       PIC X(021) VALUE "03SEL".
              10  FILLER       PIC X(021) VALUE "04PATE".
              10  FILLER       PIC X(021) VALUE "05ASSIETE".
              10  FILLER       PIC X(021) VALUE "06CARNET".
              10  FILLER       PIC X(021) VALUE "07BISCUIT".
              10  FILLER       PIC X(021) VALUE "08CHOCOLAT".
              10  FILLER       PIC X(021) VALUE "09SAVON".
              10  FILLER       PIC X(021) VALUE "10PAPIER".
              10  FILLER       PIC X(021) VALUE "11EAU".
              10  FILLER       PIC X(021) VALUE "12SODA".
              10  FILLER       PIC X(021) VALUE "13LIQUIDE VAISSELLE".
              10  FILLER       PIC X(021) VALUE "14EPONGE".
              10  FILLER       PIC X(021) VALUE "15CAFE".
              10  FILLER       PIC X(021) VALUE "16NESCAFE".
              10  FILLER       PIC X(021) VALUE "17PAIN".
              10  FILLER       PIC X(021) VALUE "18KETCHUP".
              10  FILLER       PIC X(021) VALUE "19FRITE".
              10  FILLER       PIC X(021) VALUE "20LAIT".
              10  FILLER       PIC X(021) VALUE "21BEURRE".
              10  FILLER       PIC X(021) VALUE "22FROMAGE".
              10  FILLER       PIC X(021) VALUE "23THE".
              10  FILLER       PIC X(021) VALUE "24OLIVE".
              10  FILLER       PIC X(021) VALUE "25SHAMPOING".
              10  FILLER       PIC X(021) VALUE "26CREME LAVANTE".
              10  FILLER       PIC X(021) VALUE "27GEL DOUCHE".
           05 TAB-PRODUITS-R    REDEFINES  TAB-PRODUITS.                  
              07  WS-PRODUIT  OCCURS 27 TIMES                          
                               ASCENDING KEY COD-PRODUIT                  
                               INDEXED BY IX-TAB.                       
                  10  COD-PRODUIT   PIC 9(002).                              
                  10  NOM-PRODUIT   PIC X(019).  
                            
       01  WS-AUXILIARES.                                               
           05 NON-TROUVE        PIC 9(003) VALUE ZEROES.       
           05 WS-COD-PRODUIT    PIC 9(002) VALUE ZEROES.       
           05 VARIABLE          PIC X(019) VALUE SPACES. 
           05 WS-X              PIC 9(002) VALUE ZEROES. 

      *----------------------------------------------------
       PROCEDURE DIVISION. 
      *----------------------------------------------------

           MOVE ZEROES TO NON-TROUVE                                
           MOVE 23 TO WS-COD-PRODUIT
           
           SEARCH ALL WS-PRODUIT                                        
                  AT END                                                
                     MOVE 1 TO NON-TROUVE    
                WHEN COD-PRODUIT (IX-TAB) EQUAL WS-COD-PRODUIT 
                     MOVE NOM-PRODUIT (IX-TAB) TO VARIABLE                           
           END-SEARCH                                                   

           IF  NON-TROUVE EQUAL 0
               DISPLAY "TROUVE " WS-COD-PRODUIT " Nom du produit: " VARIABLE
           ELSE
               DISPLAY "NON TROUVE - Code du produit - " WS-COD-PRODUIT
           END-IF. 

	   STOP RUN.

           TROUVE 23 Nom du produit: THE

           MOVE 28 TO WS-COD-PRODUIT
           NON TROUVE - Code du produit - 28
COBOL Exemple

Exemple – SORT dans un programme

L’instruction SORT en cobol est utilisée pour trier les enregistrements par un champ clé que nous indiquons.
On peut choisir plusieurs clés et définir si l’ordre sera croissant ou décroissant.
Pour l’exemple, nous créons un fichier temporaire dans notre programme que nous utiliserons pour générer les informations triées qu’il contient.
En tant qu’enregistrements à trier, nous utiliserons une table interne, nous n’aurons donc à aucun moment besoin d’utiliser des fichiers.
Les informations demandées seront chargées du fichier temporaire dans le registre de sortie, qui peut être utilisé tout au long de l’exécution.

 IDENTIFICATION DIVISION.
 PROGRAM-ID. PRGSORT.

 ENVIRONMENT DIVISION.
 CONFIGURATION SECTION.
 SPECIAL-NAMES.
      DECIMAL-POINT IS COMMA.

 INPUT-OUTPUT SECTION.
 FILE-CONTROL.
     SELECT TABLE-SORT ASSIGN TO DISK "SORTWORK".

 DATA DIVISION.
 FILE SECTION.

 SD TABLE-SORT
 DATA RECORD IS ELEMENT-SORT.

 01  ELEMENT-SORT.
     05 SORT-CLE1              PIC X(01).
     05 SORT-CLE2              PIC X(03).
     05 SORT-CHAMP             PIC X(10).
     05 SORT-INDICATEUR        PIC X(01).

 WORKING-STORAGE SECTION.

 01  VARIABLES.
     05 WA-REGISTRE.
        10 WA-SORT-CLE1        PIC X(01).
        10 WA-SORT-CLE2        PIC X(03).
        10 WA-SORT-CHAMP       PIC X(10).
        10 WA-SORT-INDICATEUR  PIC X(01).

 01  SWITCHES.
     05 SW-FIN-TABLE-SORT      PIC X(01).
        88 SI-FIN-TABLE-SORT             VALUE 'S'.
        88 NO-FIN-TALEA-SORT             VALUE 'N'.
     05 WI-ELEM                PIC 9(02) VALUE ZEROES.   

 01  TABLE.
     05 WT-TBL-LISTE.
        10                     PIC X(15) VALUE 'F216CAMPO02802S'.
        10                     PIC X(15) VALUE 'M144CAMPO17114N'.
        10                     PIC X(15) VALUE 'Q651CAMPO24536S'.
        10                     PIC X(15) VALUE 'F217CAMPO03312N'.
        10                     PIC X(15) VALUE 'T487CAMPO44914S'.
        10                     PIC X(15) VALUE 'O372CAMPO52113N'.
        10                     PIC X(15) VALUE 'F457CAMPO61224N'.
        10                     PIC X(15) VALUE 'L547CAMPO73985N'.
        10                     PIC X(15) VALUE 'L354CAMPO89173N'.
        10                     PIC X(15) VALUE 'W516CAMPO92815N'.
     05 REDEFINES WT-TBL-LISTE.
        10 WT-TBL-ELEMENTE     OCCURS 10 TIMES.
           15 WT-TBL-CLE1       PIC X(01).
           15 WT-TBL-CLE2       PIC X(03).
           15 WT-TBL-CHAMP      PIC X(10).
           15 WT-TBL-INDICATEUR PIC X(01).

 01  WR-ELEMENTE-SORT.
     05 WR-SORT-CLE1           PIC X(01).
     05 WR-SORT-CLE2           PIC X(03).
     05 WR-SORT-CHAMP          PIC X(10).
     05 WR-SORT-INDICATEUR     PIC X(01).

 PROCEDURE DIVISION.

     PERFORM 1000-INIT
     PERFORM 2000-PROCESS
     PERFORM 9000-FINAL
     STOP RUN.
     .

 1000-INIT.
     INITIALIZE VARIABLES
     .

 2000-PROCESS.
     SORT TABLE-SORT
          ON ASCENDING KEY SORT-CLE1
          ON DESCENDING KEY SORT-CLE2
          INPUT PROCEDURE 2100-PROCESS-ENTREE
          OUTPUT PROCEDURE 2200-PROCESS-SORTIE

     IF  SORT-RETURN NOT EQUAL ZEROES
         DISPLAY 'ERROR SUR LE SORT:' SORT-RETURN
     END-IF
     .

 2100-PROCESS-ENTREE.
     PERFORM VARYING WI-ELEM
        FROM 1 BY 1 UNTIL WI-ELEM > 10
        MOVE WT-TBL-CLE1       (WI-ELEM) TO WR-SORT-CLE1
        MOVE WT-TBL-CLE2       (WI-ELEM) TO WR-SORT-CLE2
        MOVE WT-TBL-CHAMP      (WI-ELEM) TO WR-SORT-CHAMP
        MOVE WT-TBL-INDICATEUR (WI-ELEM) TO WR-SORT-INDICATEUR
        RELEASE ELEMENTE-SORT FROM WR-ELEMENTE-SORT
        DISPLAY 'REGISTRE EN ENTREE :' WR-ELEMENTE-SORT
     END-PERFORM
     .

 2200-PROCESS-SORTIE.
     SET NO-FIN-TABLE-SORT TO TRUE
     PERFORM UNTIL SI-FIN-TABLE-SORT
        RETURN TABLE-SORT INTO WR-ELEMENTE-SORT
        AT END
           SET SI-FIN-TABLE-SORT TO TRUE
        NOT AT END
           MOVE WR-SORT-CLE1       TO WA-SORT-CLE1
           MOVE WR-SORT-CLE2       TO WA-SORT-CLE2
           MOVE WR-SORT-CHAMP      TO WA-SORT-CHAMP
           MOVE WR-SORT-INDICATEUR TO WA-SORT-INDICATEUR
           DISPLAY 'REGISTRE EN SORTIE :' WA-REGISTRE
        END-RETURN
     END-PERFORM
     .

 9000-FINAL.
     DISPLAY "FIN DU PROGRAMME DE CLASSIFICATION"
     .

RESULTAT

REGISTRE EN ENTREE :F216CAMPO02802S
                    M144CAMPO17114N
                    Q651CAMPO24536S
                    F217CAMPO03312N
                    T487CAMPO44914S
                    O372CAMPO52113N
                    F457CAMPO61224N
                    L547CAMPO73985N
                    L354CAMPO89173N
                    W516CAMPO92815N

REGISTRE EN SORTIE :F457CAMPO61224N
                    F217CAMPO03312N
                    F216CAMPO02802S
                    L547CAMPO73985N
                    L354CAMPO89173N
                    M144CAMPO17114N
                    O372CAMPO52113N
                    Q651CAMPO24536S
                    T487CAMPO44914S
                    W516CAMPO92815N	

FIN DU PROGRAMME DE CLASSIFICATION
COBOL Exemple

Exemple – SORT/MERGE

Le tri des données dans un fichier ou la fusion de deux fichiers ou plus est un besoin courant dans presque toutes les applications métier.

Le tri est utilisé pour classer les enregistrements dans l’ordre croissant ou décroissant afin qu’un traitement séquentiel puisse être effectué. Deux techniques sont utilisées pour classer les fichiers en COBOL :

  • Le tri externe est utilisé pour trier les fichiers à l’aide de l’utilitaire SORT dans le JCL. Nous en parlons dans le chapitre JCL.
    Désormais, nous nous concentrerons sur le classement interne.
  • Le tri interne est utilisé pour trier les fichiers dans un programme COBOL.
    Le verbe SORT est utilisé pour trier un fichier.

SORT

Trois fichiers sont utilisés dans le processus de classification en COBOL :

  • Le fichier d’entrée est le fichier que nous devons trier par ordre croissant ou décroissant.
  • Le fichier de travail est utilisé pour conserver des enregistrements pendant que le processus de tri est en cours. Les enregistrements du fichier d’entrée sont transférés dans le fichier de travail pour le processus de classification. Ce fichier doit être défini dans la section Fichier de l’entrée SD.
  • Le fichier de sortie est le fichier que nous obtenons après le processus de classification. C’est la sortie finale du verbe Sort.

Syntaxe

Voici la syntaxe pour trier un fichier :

SORT TEST-FIC ON ASCENDING KEY REC-CLE1
    [ON DESCENDING KEY REC-CLE2]
     USING ENTREE-FIC GIVING SORTIE-FIC.

SORT effectue les opérations suivantes :

  • Ouvre le fichier de travail en mode IO, le fichier d’entrée en mode INPUT et le fichier de sortie en mode OUTPUT.

    Transfère les enregistrements présents dans le fichier d’entrée vers le fichier de travail.
  • Trie le FICHIER DE TRI dans l’ordre croissant/décroissant par clé d’enregistrement.
  • Transfère les enregistrements triés du fichier de travail vers le fichier de sortie.
  • Ferme le fichier d’entrée et le fichier de sortie et supprime le fichier de travail.

Exemple

Dans l’exemple suivant, INPUT est le fichier d’entrée qui doit être trié par ordre croissant :

       IDENTIFICATION DIVISION.
       PROGRAM-ID. SORT.

       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.

           SELECT ENTREE   ASSIGN TO IN.
           SELECT SORTIE   ASSIGN TO OUT.
           SELECT TRAVAIL  ASSIGN TO WRK.

       DATA DIVISION.
       FILE SECTION.

       FD  ENTREE.
       01  ENTREE-ETUDIANT.
           05 ETUDIANT-ID-I   PIC 9(05).
           05 ETUDIANT-NAME-I PIC A(25).

       FD  SORTIE.
       01  SORTIE-ETUDIANT.
           05 STUDENT-ID-O   PIC 9(05).
           05 STUDENT-NAME-O PIC A(25).

       SD  TRAVAIL.
       01  TRAVAIL-ETUDIANT.
           05 ETUDIANT-ID-W   PIC 9(05).
           05 ETUDIANT-NOM-W PIC A(25).

       PROCEDURE DIVISION.

           SORT TRAVAIL ON ASCENDING KEY ETUDIANT-ID-O
                USING ENTREE GIVING SORTIE.
                DISPLAY 'Sort Successful'.
       STOP RUN.

JCL pour l’exécution du programme COBOL :

//SAMPLE JOB(TESTJCL,XXXXXX),CLASS = A,MSGCLASS = C
//STEP1 EXEC PGM=CADSORT
//IN DD DSN=ENTREE-NOM-FICHIER,DISP=SHR
//OUT DD DSN=SORTIE-NOM-FICHIER,DISP=SHR
//WRK DD DSN=&&TEMP

Lorsque vous compilez et exécutez le programme ci-dessus, il produit le résultat suivant :

Sort Successful

MERGE

Deux ou plusieurs fichiers séquencés de manière identique sont combinés à l’aide de l’instruction Merge. Fichiers utilisés dans le processus de fusion :

  • Fichiers d’entrée : Entrée-1, Entrée-2
  • Fichier de travail
  • Fichier de sortie

Syntaxe

Voici la syntaxe pour fusionner deux ou plusieurs fichiers :

MERGE TRAVAIL-FIC ON ASCENDING KEY REC-CLE1
     [ON DESCENDING KEY REC-CLE2]
      USING ENTREE-1, ENTREE-2 GIVING SORTIE-FIC.

Fusionner (MERGE) effectue les opérations suivantes :

  • Ouvre le fichier de travail en mode IO, les fichiers d’entrée en mode INPUT et le fichier de sortie en mode OUTPUT.
  • Transfère les enregistrements présents dans les fichiers d’entrée vers le fichier de travail.
  • Trie le SORT-FIC dans l’ordre croissant/décroissant par REC-CLE.
  • Transfère les enregistrements triés du fichier de travail vers le fichier de sortie.
  • Ferme le fichier d’entrée et le fichier de sortie et supprime le fichier de travail.

Exemple

Dans l’exemple suivant, ENTREE1 et ENTREE2 sont les fichiers d’entrée qui doivent être fusionnés dans l’ordre croissant :

       IDENTIFICATION DIVISION.
       PROGRAM-ID. SORT.

       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.

           SELECT ENTREE1  ASSIGN TO IN1.
           SELECT ENTREE2  ASSIGN TO IN2.
           SELECT SORTIE   ASSIGN TO OUT.
           SELECT TRAVAIL  ASSIGN TO WRK.

       DATA DIVISION.
       FILE SECTION.

       FD  ENTREE1.
       01  ENTREE1-ETUDIANT.
           05 ETUDIANT-ID-I1   PIC 9(05).
           05 ETUDIANT-NOM-I1  PIC A(25).

       FD  ENTREE2.
       01  ENTREE2-ETUDIANT.
           05 ETUDIANT-ID-I2   PIC 9(05).
           05 ETUDIANT-NOM-I2  PIC A(25).

       FD  SORTIE.
       01  SORTIE-ETUDIANT.
           05 ETUDIANT-ID-O    PIC 9(05).
           05 ETUDIANT-NOM-O   PIC A(25).

       SD  TRAVAIL.
       01  TRAVAIL-ETUDIANT.
           05 ETUDIANT-ID-W    PIC 9(05).
           05 ETUDIANT-NOM-W   PIC A(25).

       PROCEDURE DIVISION.

           MERGE TRAVIL ON ASCENDING KEY ETUDIANT-ID-O
                 USING ENTREE1, ENTREE2 GIVING SORTIE.
                  DISPLAY 'Merge Successful'.
           STOP RUN.

JCL pour l’exécution du programme COBOL :

//EXEMPLE JOB(TESTJCL,XXXXXX),CLASS = A,MSGCLASS = C
//STEP1 EXEC PGM=SORT
//IN1 DD DSN=ENTREE1-NOM-FICHIER,DISP=SHR
//IN2 DD DSN=ENTREE2-NOM-FICHIER,DISP=SHR
//OUT DD DSN=SORTIE-NOM-FICHIER,DISP=SHR
//WRK DD DSN=&&TEMP

Lorsque vous compilez et exécutez le programme ci-dessus, il produit le résultat suivant :

Merge Successful
COBOL Exemple

Exemple – STRING

Programme utilisant le STRING:

EXEMPLE 1

IDENTIFICATION DIVISION.
PROGRAM-ID.  STRING.
AUTHOR.      LA COMMUNAUTE DU COBOL.

ENVIRONMENT DIVISION.                                            
CONFIGURATION SECTION.                                           
SPECIAL-NAMES.                                                   
    DECIMAL-POINT IS COMMA. 

DATA DIVISION.
WORKING-STORAGE SECTION.

01  WS-AUXILIARES.
    05  WS-DEL           PIC X(001)     VALUE '&'. 
    05  PT1              PIC 9(005)     VALUE 1. 
    05  CHAMP-1          PIC X(006)     VALUE 'AB*CD'. 
    05  CHAMP-2          PIC X(006)     VALUE 'JKL*MN'. 
    05  CHAMP-3          PIC X(006)     VALUE 'S*TUV'. 
    05  CAMPO-123        PIC X(020)     VALUE SPACES.
    05  WS-NOM-01        PIC X(020)     VALUE 'La'.
    05  WS-NOM-02        PIC X(020)     VALUE 'Communaute'.
    05  WS-NOM-03        PIC X(020)     VALUE 'Du'.
    05  WS-NOM-04        PIC X(020)     VALUE 'Cobol'.
    05  WS-NOM-COMPLET   PIC X(080)     VALUE SPACES.

PROCEDURE DIVISION.

001-INIT.

    STRING                                                    
          WS-NOM-01 DELIMITED BY SPACES ' ' DELIMITED BY SIZE 
          WS-NOM-02 DELIMITED BY SPACES ' ' DELIMITED BY SIZE 
          WS-NOM-03 DELIMITED BY SPACES ' ' DELIMITED BY SIZE 
          WS-NOM-04                       
      INTO  
          WS-NOM-COMPLET                                     
    END-STRING
    DISPLAY 'Nom complet: ' WS-NOM-COMPLET

* Resultat du test:

* Nom complet: La Communaute Du Cobol

    STRING CHAMP-1 CHAMP-2 CHAMP-3 
           DELIMITED BY "*" 
      INTO CHAMP-123
    END-STRING
    DISPLAY 'CHAMP-123: ' CHAMP-123

* Resultat du test:

* CHAMP-123: ABJKLS         

    STRING CHAMP-1 CHAMP-2 CHAMP-3 
           DELIMITED BY "*" 
      INTO CHAMP-123 
           POINTER PT1
    END-STRING
    DISPLAY 'CHAMP-123: ' CHAMP-123
    DISPLAY 'PT1      : ' PT1

* Resultat du test:

* CHAMP-123: ABJKLS              
* PT1      : 00007

    STRING CHAMP-1 CHAMP-2 CHAMP-3 
           DELIMITED BY "*" 
      INTO CHAMP-123 
           POINTER PT1
    END-STRING
    DISPLAY 'CHAMP-123: ' CHAMP-123
    DISPLAY 'PT1      : ' PT1

* Resultat du test:

* CHAMP-123: ABJKLSABJKLS                      
* PT1      : 00013

    MOVE SPACES   TO CHAMP-123 
    MOVE 'AB&XYZ' TO CHAMP-1
    MOVE 'LMN&OP' TO CHAMP-2
    MOVE 'ST&V  ' TO CHAMP-3

    STRING CHAMP-1 CHAMP-2 CHAMP-3 
           DELIMITED BY WS-DEL 
      INTO CHAMP-123
    END-STRING
    DISPLAY 'CHAMP-123: ' CHAMP-123

* Resultat du test:
* CHAMP-123: ABLMNST             

    STOP RUN.

EXEMPLE 2

IDENTIFICATION DIVISION.
PROGRAM-ID. STRING.
AUTHOR.     LA COMMUNAUTE DU COBOL.

DATA DIVISION.
FILE SECTION.

WORKING-STORAGE SECTION.

01          WS-DATE-HEURE.
    05      WS-FUNCTION-CURRENT-DATE PIC X(14).

01          WS-DATE-HEURE-FORMAT.
    05      WS-DATE-FORMAT           PIC X(10).
    05      WS-HEURE-FORMAT          PIC X(08).

PROCEDURE DIVISION.

    MOVE FUNCTION CURRENT-DATE TO WS-FUNCTION-CURRENT-DATE
    DISPLAY "WS-DATE-HEURE - " WS-FUNCTION-CURRENT-DATE
	
    STRING
           WS-FUNCTION-CURRENT-DATE (07:2) "/"
           WS-FUNCTION-CURRENT-DATE (05:2) "/"
           WS-FUNCTION-CURRENT-DATE (01:4)
      INTO WS-DATE-FORMAT	
    END-STRING
	     
    STRING
           WS-FUNCTION-CURRENT-DATE (09:2) ":"
           WS-FUNCTION-CURRENT-DATE (11:2) ":"
           WS-FUNCTION-CURRENT-DATE (13:2)
      INTO WS-HORA-FORMATADA
    END-STRING

    DISPLAY "WS-DATE-FORMAT  : " WS-DATE-FORMAT
    DISPLAY "WS-HEURE-FORMAT : " WS-HEURE-FORMAT

    STOP RUN.
Resultat:
WS-DATE-HEURE - 20220302011708
WS-DATE-FORMAT  : 02/03/2022
WS-HEURE-FORMAT : 01:17:08
COBOL Exemple

Exemple – SUBSTRACT

Programme utilisant le SUBSTRACT :

IDENTIFICATION DIVISION.
PROGRAM-ID.  SUBTRACT.
AUTHOR.      LA COMMUNAUTE DU COBOL.

ENVIRONMENT DIVISION.                                            
CONFIGURATION SECTION.                                           
SPECIAL-NAMES.                                                   
    DECIMAL-POINT IS COMMA. 

DATA DIVISION.
WORKING-STORAGE SECTION.

01  WS-AUXILIARES.
    05  VALEUR-1          PIC S9(006)    VALUE ZEROES. 
    05  VALEUR-2          PIC S9(006)    VALUE ZEROES. 
    05  VALEUR-3          PIC S9(006)    VALUE ZEROES. 

PROCEDURE DIVISION.

001-INIT.

    MOVE  8 TO VALEUR-1
    SUBTRACT 3 FROM VALEUR-1	
    DISPLAY 'VALEUR-1: ' VALEUR-1

* Resultat du test:
* VALEUR-1: +000005

    MOVE  3 TO VALEUR-1
    MOVE  8 TO VALEUR-2
    SUBTRACT VALEUR-1 FROM VALEUR-2	
    DISPLAY 'VALEUR-1: ' VALEUR-1
    DISPLAY 'VALEUR-2: ' VALEUR-2

* Resultat du test:
* VALEUR-1: +000003
* VALEUR-2: +000005

    MOVE  6 TO VALEUR-1
    MOVE -7 TO VALEUR-2
    SUBTRACT VALEUR-1 FROM VALEUR-2	
    DISPLAY 'VALEUR-1: ' VALEUR-1
    DISPLAY 'VALEUR-2: ' VALEUR-2

* Resultat du test:
* VALEUR-1: +000006
* VALEUR-2: -000013

    MOVE -6 TO VALEUR-1
    MOVE -7 TO VALEUR-2
    SUBTRACT VALEUR-1 FROM VALEUR-2	
    DISPLAY 'VALEUR-1: ' VALEUR-1
    DISPLAY 'VALEUR-2: ' VALEUR-2

* Resultat du test:
* VALEUR-1: -000006
* VALEUR-2: -000001

    MOVE -6 TO VALEUR-1
    MOVE  7 TO VALEUR-2
    SUBTRACT VALEUR-1 FROM VALEUR-2	
    DISPLAY 'VALEUR-1: ' VALEUR-1
    DISPLAY 'VALEUR-2: ' VALEUR-2

* Resultat du test:
* VALEUR-1: -000006
* VALEUR-2: +000013

    MOVE 30 TO VALEUR-1
    MOVE 20 TO VALEUR-2
    MOVE 40 TO VALEUR-3
    SUBTRACT 60 VALEUR-1 VALEUR-2 FROM VALEUR-3	
    DISPLAY 'VALEUR-1: ' VALEUR-1
    DISPLAY 'VALEUR-2: ' VALEUR-2
    DISPLAY 'VALEUR-3: ' VALEUR-3

* Resultat du test:
* VALEUR-1: +000030
* VALEUR-2: +000020
* VALEUR-3: -000070

    MOVE  2 TO VALEUR-1
    MOVE  6 TO VALEUR-2
    MOVE 39 TO VALEUR-3
    SUBTRACT VALEUR-1 FROM VALEUR-2 GIVING VALEUR-3	
    DISPLAY 'VALEUR-1: ' VALEUR-1
    DISPLAY 'VALEUR-2: ' VALEUR-2
    DISPLAY 'VALEUR-3: ' VALEUR-3

* Resultat du test:
* VALEUR-1: +000002
* VALEUR-2: +000006
* VALEUR-3: +000004

    MOVE 80 TO VALEUR-1
    MOVE 20 TO VALEUR-2
    SUBTRACT 50      FROM VALEUR-1 GIVING VALEUR-2  
    DISPLAY 'VALEUR-1: ' VALEUR-1
    DISPLAY 'VALEUR-2: ' VALEUR-2

* Resultat du test:
* VALEUR-1: +000080
* VALEUR-2: +000030

    STOP RUN.
COBOL Exemple

Exemple – UNSTRING

Programme utilisant le UNSTRING :

IDENTIFICATION DIVISION.
PROGRAM-ID.  UNSTRING.
AUTHOR.      LA COMMUNAUTE DU COBOL.

ENVIRONMENT DIVISION.                                            
CONFIGURATION SECTION.                                           
SPECIAL-NAMES.                                                   
    DECIMAL-POINT IS COMMA. 

DATA DIVISION.
WORKING-STORAGE SECTION.

01  WS-AUXILIARES.
    05  CHAMP-1             PIC X(006)       VALUE SPACES. 
    05  CHAMP-2             PIC X(006)       VALUE SPACES. 
    05  CHAMP-3             PIC X(006)       VALUE SPACES. 
    05  CHAMP-4             PIC X(006)       VALUE SPACES. 
    05  CHAMP-123           PIC X(016)       VALUE SPACES.
    05  CHAMP-ABC           PIC X(011)       VALUE SPACES.
    05  CHAMP-XYZ           PIC X(013)       VALUE SPACES.
    05  COMPTEUR-01         PIC 9(006)       VALUE ZEROES. 
    05  COMPTEUR-1          PIC 9(006)       VALUE ZEROES. 
    05  COMPTEUR-2          PIC 9(006)       VALUE ZEROES. 
    05  COMPTEUR-3          PIC 9(006)       VALUE ZEROES. 
    05  COMPTEUR-4          PIC 9(006)       VALUE ZEROES. 
    05  DELIMITEUR-1        PIC X(001)       VALUE SPACES. 
    05  DELIMITEUR-2        PIC X(001)       VALUE SPACES. 
    05  POINTEUR-1          PIC 9(006)       VALUE 1. 
    05  WS-NOM-01           PIC X(020)       VALUE SPACES.
    05  WS-NOM-02           PIC X(020)       VALUE SPACES.
    05  WS-NOM-03           PIC X(020)       VALUE SPACES.
    05  WS-NOM-04           PIC X(020)       VALUE SPACES.

PROCEDURE DIVISION.

001-INIT.

    MOVE "AB*CDJKL*MNS*TUV" TO CHAMP-123
    UNSTRING CHAMP-123
             DELIMITED BY "*" 
        INTO CHAMP-1 CHAMP-2 CHAMP-3 CHAMP-4
    END-UNSTRING 
    DISPLAY "CHAMP-1: " CHAMP-1 
    DISPLAY "CHAMP-2: " CHAMP-2 
    DISPLAY "CHAMP-3: " CHAMP-3 
    DISPLAY "CHAMP-4: " CHAMP-4 

* Resultado do teste:
* CHAMP-1: AB    
* CHAMP-2: CDJKL 
* CHAMP-3: MNS   
* CHAMP-4: TUV   


    MOVE "AB*CDJKL*MNS*TUV" TO CHAMP-123
    UNSTRING CHAMP-123 
             DELIMITED BY "*" 
        INTO CHAMP-1 COUNT IN COMPTEUR-1 
             CHAMP-2 COUNT IN COMPTEUR-2 
             CHAMP-3 COUNT IN COMPTEUR-3 
             CHAMP-4 COUNT IN COMPTEUR-4
    END-UNSTRING
    DISPLAY "CHAMP-1: " CHAMP-1 "   COMPTEUR-1: " COMPTEUR-1 
    DISPLAY "CHAMP-2: " CHAMP-2 "   COMPTEUR-2: " COMPTEUR-2 
    DISPLAY "CHAMP-3: " CHAMP-3 "   COMPTEUR-3: " COMPTEUR-3 
    DISPLAY "CHAMP-4: " CHAMP-4 "   COMPTEUR-4: " COMPTEUR-4 

* Resultado do teste:
* CHAMP-1: AB       COMPTEUR-1: 000002
* CHAMP-2: CDJKL    COMPTEUR-2: 000005
* CHAMP-3: MNS      COMPTEUR-3: 000003
* CHAMP-4: TUV      COMPTEUR-4: 000003


    MOVE "AB*CDJKL*MNS*TUV" TO CHAMP-123
    UNSTRING CHAMP-123 
             DELIMITED BY "*" 
        INTO CHAMP-1 COUNT IN COMPTEUR-1 
             CHAMP-2 COUNT IN COMPTEUR-2 
             CHAMP-3 COUNT IN COMPTEUR-3 
             CHAMP-4 COUNT IN COMPTEUR-4 
        WITH POINTER POINTEUR-1 
        TALLYING IN COMPTEUR-01
    END-UNSTRING
    DISPLAY "CHAMP-1    : " CHAMP-1 "   COMPTEUR-1: " COMPTEUR-1 
    DISPLAY "CHAMP-2    : " CHAMP-2 "   COMPTEUR-2: " COMPTEUR-2 
    DISPLAY "CHAMP-3    : " CHAMP-3 "   COMPTEUR-3: " COMPTEUR-3 
    DISPLAY "CHAMP-4    : " CHAMP-4 "   COMPTEUR-4: " COMPTEUR-4 
    DISPLAY "POINTEUR-1 : " POINTEUR-1 
    DISPLAY "COMPTEUR-01: " COMPTEUR-01 

* Resultado do teste:
* CHAMP-1    : AB       COMPTEUR-1: 000002
* CHAMP-2    : CDJKL    COMPTEUR-2: 000005
* CHAMP-3    : MNS      COMPTEUR-3: 000003
* CHAMP-4    : TUV      COMPTEUR-4: 000003
* PONTEIRO-1 : 000017
* COMPTEUR-01: 000004

    MOVE "XYZ/ABC*DEF" TO CHAMP-ABC
    UNSTRING CHAMP-ABC
             DELIMITED BY "/" OR "*"
        INTO CHAMP-1 DELIMITER IN DELIMITEUR-1
             CHAMP-2 DELIMITER IN DELIMITEUR-2
    END-UNSTRING
    DISPLAY "CHAMP-1    : " CHAMP-1 "   DELIMITEUR-1: " DELIMITEUR-1 
    DISPLAY "CHAMP-2    : " CHAMP-2 "   DELIMITEUR-2: " DELIMITEUR-2 

* Resultado do teste:
* CHAMP-1    : XYZ      DELIMITEUR-1: /
* CHAMP-2    : ABC      DELIMITEUR-2: *

    UNSTRING CHAMP-ABC 
             DELIMITED BY "/" OR "*" 
        INTO CHAMP-1 
             DELIMITER IN DELIMITEUR-1
    END-UNSTRING
    DISPLAY "CHAMP-1    : " CHAMP-1 "   DELIMITEUR-1: " DELIMITEUR-1 

* Resultado do teste:
* CHAMP-1    : XYZ      DELIMITEUR-1: /

    MOVE "JKLMN****STUV" TO CHAMP-XYZ 
    UNSTRING CHAMP-XYZ
             DELIMITED BY ALL "*" 
        INTO CHAMP-1 CHAMP-2
    END-UNSTRING
    DISPLAY "CHAMP-1: " CHAMP-1 
    DISPLAY "CHAMP-2: " CHAMP-2 

* Resultado do teste:
* CHAMP-1: JKLMN 
* CHAMP-2: STUV  

    STOP RUN.