Tester No de Sirete

Présentation
Permet de tester un No de Sirete par l'algorithme de Luhn
Paramètres d'Entrée No de Sirete, et indicateur d'erreur
En sortie indicateur d'erreur = 1 si le Sirete n'est pas bon, à 0 si le Sirete est bon
Il marche sur tout type de compilateur cobol , aucune spécificité d'un quelconque constructeur étant employé
Nos ressources disponibles
IDENTIFICATION DIVISION.
PROGRAM-ID. TSTSIR.
*
* Ce programme sert à tester qu'un no de sirete est correct
*
DATA DIVISION.
WORKING-STORAGE SECTION.
01 W-TOTAL PIC 9(3) value 0.
01 w-tot10 pic 999.
01 w-rest pic 99 value 0.
01 w-i pic 99 value 0.
01 w-elesir2 pic 99.
01 w-toggle pic 9 value 0.
88 toggle value is 0.
LINKAGE SECTION.
01 L-sirete.
02 l-elesir pic 9 occurs 14 times.
01 w-erreur pic 9.
PROCEDURE DIVISION using l-sirete , w-erreur.
DEBUT.
move 1 to w-erreur.
if l-sirete is not numeric
exit program.
move 0 to w-total w-toggle.
PERFORM VARYING W-i from 1 by 1 until w-i > 14
if toggle
compute w-elesir2 = l-elesir(w-i) * 2
if w-elesir2 > 9
subtract 9 from w-elesir2
end-if
add w-elesir2 to w-total
move 1 to w-toggle
else
add l-elesir(w-i) to w-total
move 0 to w-toggle
end-if
end-perform.
compute w-tot10 = w-total / 10
compute w-rest = w-total - (w-tot10 * 10)
if w-rest = 0 move 0 to w-erreur.
exit program.
Téléchargement
0  0 
Téléchargé 5 fois Voir les 2 commentaires
Détails
Catégories : Codes sources Cobol
Avatar de marc.bichara
Membre régulier
Voir tous les téléchargements de l'auteur
Licence : Autre
Date de mise en ligne : 14 août 2015




Avatar de marc.bichara marc.bichara - Membre régulier https://www.developpez.com
le 14/08/2015 à 16:23
Notez que les indentations n'y sont pas.
Toutes les lignes ayant été cadrés à gauche par l'interprétateur du site, mais cela sauf cas de débutant vous vous en etes rendu compte.
Avatar de escartefigue escartefigue - Expert éminent https://www.developpez.com
le 21/10/2015 à 14:26
Bonjour,

Merci pour ce petit utilitaire qui peut rendre service.

Quelques remarques :

- C'est dommage de ne positionner qu'un code erreur unique, ici "1" alors que 2 types d'erreur sont possibles : SIRET non numérique (testé au début) et reste de la division différent de zéro (testé à la fin)
tout sous programme doit effectuer un diagnostic fin, avec donc un code erreur par type d'erreur, ici, on aurait pu avoir par exemple 1 et 2. Faute de quoi le traitement en amont ne peut pas savoir ce qu'il en est

- Un filler balise en début et en fin de working est toujours le bienvenu, ca permet, en cas de dump, de retrouver plus facilement le contenu de la WSS
Code : Sélectionner tout
 01  FILLER PIC X(32) VALUE '*** DEBUT WSS TSTSIR ***'.
- C'est dommage de déclarer des variables de petite taille en utilisant des level "01" qui vont aligner les éléments sur 16 octets, il est préférable de créer une zone groupe "01 FILLER" dans laquelle on déclare autant de niveaux 02 qu'il y a de petites variable à déclarer, par exemple :
Code : Sélectionner tout
1
2
3
4
5
6
7
8
01  FILLER. 
    02  W-TOTAL PIC 9(3) value 0. 
    02  w-tot10 pic 999. 
    02  w-rest pic 99 value 0. 
    02  w-i pic 99 value 0. 
    02  w-elesir2 pic 99. 
    02  w-toggle pic 9 value 0. 
        88 toggle value is 0.
Ca peut sembler un détail, mais si on appelle un grand nombre de sous-programmes tous construits ainsi, on charge inutilement la région.

- il faut savoir qu'en COBOL, les variables faisant l'objet de calculs sont plus performantes si elles sont déclarées en packé signé.
si le code source demande un calcul sur une zone déclarée en étendu non signé (PIC 9(nn)) alors le calcul sera fait de la façon suivante :
ajout du signe
pack
calcul
unpack
suppression du signe
restitution du résultat ! (ouf)
Tout ceci n'est évidemment pas neutre en temps de traitement (jusqu'à 8 fois plus pour un calcul)
Developpez.com décline toute responsabilité quant à l'utilisation des différents éléments téléchargés.
Contacter le responsable de la rubrique Accueil