COBOL - Verifica o dígito da agência e conta corrente do Banco do Brasil


Volta ao Menu Principal


Desenvolvido por DORNELLES Carlos Alberto - Analista de Sistemas - Brasília DF. - cad_cobol@hotmail.com

Metodologia para cálculo do dígito verificador - DV da agência e conta corrente
  • Cada algarismo que compõe o número é multiplicado pelo respectivo multiplicador (peso)
    • Os multiplicadores (pesos) variam de 9 a 2, da direita para a esquerda
    • O primeiro dígito da direita para a esquerda deverá ser multiplicado por 9, o segundo por 8 e assim sucessivamente
  • Os resultados das multiplicacoes são somados
  • O total da soma é dívido por onze
    • se o resto for menor que 10 (dez) o DV será igual ao resto
    • se o resto for igual a 10 (dez) o DV sera igual a X
    • se o resto for igual a 0 (zero) o DV sera igual a 0

Compativel com todos os compiladores e versões
         1         2         3         4         5         6         7         8
12345678901234567890123456789012345678901234567890123456789012345678901234567890

      *-----------------------------------------------------------------
       IDENTIFICATION DIVISION.                                         
      *-----------------------------------------------------------------
       PROGRAM-ID.       CADCABB.                                       
       AUTHOR.           CARLOS ALBERTO DORNELLES.                      
      *-----------------------------------------------------------------
      *  PROGRAMA      : CADCABB                                        
      *  OBJETIVO      : Verifica o digito c/c do Banco do Brasil       
      *  ANALISTA      : CARLOS ALBERTO DORNELLES                       
      *  LINGUAGEM     : COBOL                                          
      *  MODO OPERACAO : BATCH                                          
      *  COMO USAR     : LKS-CODAGE-I ....: Codigo da agencia com digito
      *                : LKS-NUMCTA-I ....: Numero da conta com digito  
      *-----------------------------------------------------------------
      *  VERSAO DD.MM.AAAA  HISTORICO/AUTOR                             
      *  ------ ----------  ---------------                             
      *    001  16.11.2011  PROGRAMA INICIAL                            
      *-----------------------------------------------------------------
                                                                        
      *-----------------------------------------------------------------
       ENVIRONMENT DIVISION.                                            
      *-----------------------------------------------------------------
       CONFIGURATION SECTION.                                           
       SPECIAL-NAMES.    DECIMAL-POINT IS COMMA.                        
       INPUT-OUTPUT SECTION.                                            
       FILE-CONTROL.                                                    
                                                                        
      *-----------------------------------------------------------------
       DATA DIVISION.                                                   
      *-----------------------------------------------------------------
       FILE SECTION.                                                    
                                                                        
      *-----------------------------------------------------------------
       WORKING-STORAGE SECTION.                                         
      *-----------------------------------------------------------------
                                                                        
       01  WS-AUXILIARES.                                               
           05 WSS-IND-N                  PIC 9(002)  VALUE ZEROES.      
           05 WSS-IND-O                  PIC 9(002)  VALUE ZEROES.      
           05 WSS-IND-P                  PIC 9(002)  VALUE ZEROES.      
           05 WSS-SOMA                   PIC 9(008)  VALUE ZEROES.      
           05 WSS-CODAGE                 PIC X(005)  VALUE ZEROES.      
           05 WSS-CODAGE-R               REDEFINES WSS-CODAGE.          
              10  WSS-CODAGE-T           PIC 9(001)  OCCURS 05 TIMES.   
           05 WSS-NUMCTA                 PIC X(007)  VALUE ZEROES.      
           05 WSS-NUMCTA-R               REDEFINES WSS-NUMCTA.          
              10  WSS-NUMCTA-T           PIC 9(001)  OCCURS 07 TIMES.   
           05 WSS-PESOS                  PIC X(012)  VALUE SPACES.      
           05 WSS-PESOS-R                REDEFINES WSS-PESOS.           
              10  WSS-PESOS-T            PIC 9(002)  OCCURS 06 TIMES.   
           05 WSS-QUOCI                  PIC 9(008)  VALUE ZEROES.      
           05 WSS-RESTO                  PIC 9(008)  VALUE ZEROES.      
           05 WSS-MENSAGEM               PIC X(078)  VALUE SPACES.      
           05 WSS-PESOS-CTA              PIC X(012)  VALUE              
                                         '040506070809'.                
                                                                        
      *-----------------------------------------------------------------
       LINKAGE SECTION.                                                 
      *-----------------------------------------------------------------
                                                                        
       01  LKS-PARAMETRO.                                               
           05 COMPRIMENTO                PIC S9(04) COMP.               
           05 LKS-CODAGE-I               PIC X(005).                    
           05 FILLER                     PIC X(001).                    
           05 LKS-NUMCTA-I               PIC X(007).                    
           05 FILLER                     PIC X(001).                    
           05 LKS-RETORNO                PIC 9(001).                    
                                                                        
      *-----------------------------------------------------------------
      * LKS-CODAGE-I     = Numero da agencia com o digito               
      * LKS-NUMCTA-I     = Numero da conta   com o digito               
      * LKS-RETORNO      = 0 - Codigo verificado esta correto           
      *                  = 1 - Codigo da agencia com erro               
      *                  = 2 - Codigo da conta   com erro               
      *                  = 3 - Codigo da agencia e conta com erro       
      *-----------------------------------------------------------------
                                                                        
      *-----------------------------------------------------------------
       PROCEDURE DIVISION USING LKS-PARAMETRO.                          
      *-----------------------------------------------------------------
                                                                        
           PERFORM P1000-INICIAL   THRU P1000-FIM                       
           PERFORM P2000-PRINCIPAL THRU P2000-FIM                       
           PERFORM P9500-FINAL     THRU P9500-FIM                       
           GOBACK.                                                      
                                                                        
      *-----------------------------------------------------------------
       P1000-INICIAL.                                                   
      *-----------------------------------------------------------------
                                                                        
           MOVE LKS-CODAGE-I TO WSS-CODAGE                              
           MOVE LKS-NUMCTA-I TO WSS-NUMCTA                              
           .                                                            
       P1000-FIM.                                                       
           EXIT.                                                        
                                                                        
      *-----------------------------------------------------------------
       P2000-PRINCIPAL.                                                 
      *-----------------------------------------------------------------
                                                                        
           MOVE WSS-PESOS-CTA TO WSS-PESOS                              
           MOVE 01            TO WSS-IND-N                              
           MOVE 03            TO WSS-IND-P                              
           MOVE 04            TO WSS-IND-O                              
           MOVE ZEROES        TO WSS-SOMA                               
           PERFORM P7000-CALC-CODAGE THRU P7000-FIM                     
                                                                        
           MOVE WSS-PESOS-CTA TO WSS-PESOS                              
           MOVE 01            TO WSS-IND-N                              
           MOVE 01            TO WSS-IND-P                              
           MOVE 06            TO WSS-IND-O                              
           MOVE ZEROES        TO WSS-SOMA                               
           PERFORM P8000-CALC-NUMCTA THRU P8000-FIM.                    
                                                                        
       P2000-FIM.                                                       
           EXIT.                                                        
                                                                        
      *-----------------------------------------------------------------
       P7000-CALC-CODAGE.                                               
      *-----------------------------------------------------------------
                                                                        
           MOVE ZEROES TO WSS-SOMA                                      
           PERFORM UNTIL WSS-IND-N GREATER WSS-IND-O                    
                   COMPUTE WSS-SOMA = WSS-SOMA +                        
                                     (WSS-CODAGE-T (WSS-IND-N) *        
                                      WSS-PESOS-T  (WSS-IND-P))         
                   ADD 1 TO WSS-IND-N                                   
                            WSS-IND-P                                   
           END-PERFORM                                                  
           DIVIDE WSS-SOMA BY 11 GIVING WSS-QUOCI REMAINDER WSS-RESTO   
           EVALUATE WSS-RESTO                                           
               WHEN 10                                                  
                    MOVE 'X'       TO WSS-CODAGE   (05:01)              
               WHEN 0                                                   
                    MOVE  0        TO WSS-CODAGE-T (05)                 
               WHEN OTHER                                               
                    MOVE WSS-RESTO TO WSS-CODAGE-T (05)                 
           END-EVALUATE.                                                
                                                                        
       P7000-FIM.                                                       
           EXIT.                                                        
                                                                        
      *-----------------------------------------------------------------
       P8000-CALC-NUMCTA.                                               
      *-----------------------------------------------------------------
                                                                        
           MOVE ZEROES TO WSS-SOMA                                      
           PERFORM UNTIL WSS-IND-N GREATER WSS-IND-O                    
                   COMPUTE WSS-SOMA = WSS-SOMA +                        
                                     (WSS-NUMCTA-T (WSS-IND-N) *        
                                      WSS-PESOS-T  (WSS-IND-P))         
                   ADD 1 TO WSS-IND-N                                   
                            WSS-IND-P                                   
           END-PERFORM                                                  
           DIVIDE WSS-SOMA BY 11 GIVING WSS-QUOCI REMAINDER WSS-RESTO   
           EVALUATE WSS-RESTO                                           
               WHEN 10                                                  
                    MOVE 'X'       TO WSS-NUMCTA   (07:01)              
               WHEN 0                                                   
                    MOVE  0        TO WSS-NUMCTA-T (07)                 
               WHEN OTHER                                               
                    MOVE WSS-RESTO TO WSS-NUMCTA-T (07)                 
           END-EVALUATE.                                                
                                                                        
       P8000-FIM.                                                       
           EXIT.                                                        
                                                                        
      *-----------------------------------------------------------------
       P9500-FINAL.                                                     
      *-----------------------------------------------------------------
                                                                        
           EVALUATE LKS-CODAGE-I = WSS-CODAGE ALSO                      
                    LKS-NUMCTA-I = WSS-NUMCTA                           
               WHEN TRUE  ALSO TRUE                                     
                    MOVE  0 TO LKS-RETORNO                              
               WHEN FALSE ALSO TRUE                                     
                    MOVE  1 TO LKS-RETORNO                              
               WHEN TRUE  ALSO FALSE                                    
                    MOVE  2 TO LKS-RETORNO                              
               WHEN FALSE ALSO FALSE                                    
                    MOVE  3 TO LKS-RETORNO                              
           END-EVALUATE.                                                
                                                                        
       P9500-FIM.                                                       
           EXIT.                                                        


Exemplos
Agencia Conta Agencia Conta Agencia Conta Agencia Conta Agencia Conta Agencia Conta
6510-2 003655-2 6507-2 024601-8 7009-2 022810-9 6746-6 006373-8 6605-2 461462-3 6845-4 100140-X