Consulta todas as sequencias de objeto no DB2 - www.cadcobol.com


Volta a página anterior

Volta ao Menu Principal


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


Consulta de todas as sequencias de objeto no DB2
  • Este programa é chamado para realizar a consulta de todas as sequencias de objeto no DB2.

Código

          1         2         3         4         5         6         7         8
 12345678901234567890123456789012345678901234567890123456789012345678901234567890

       *-----------------------------------------------------------------
        IDENTIFICATION DIVISION.                                         
       *-----------------------------------------------------------------
        PROGRAM-ID.      PROGRA04.                                       
        AUTHOR    .      DORNELLES CARLOS ALBERTO.                       
       *-----------------------------------------------------------------
       * SISTEMA       : SICAD                                           
       * PROGRAMA      : PROGRA04                                        
       * OBJETIVO      : MANTEM IMAGENS                        
       *               : CONSULTA QUANTAS IMAGENS TEM POR CADA SEQUENCIAL
       * ANALISTA      : CARLOS ALBERTO DORNELLES                                           
       * DATA          : 11/DEZEMBRO/2012                                
       *-----------------------------------------------------------------
                                                                         
       *-----------------------------------------------------------------
        ENVIRONMENT DIVISION.                                            
       *-----------------------------------------------------------------
        CONFIGURATION SECTION.                                           
        SPECIAL-NAMES.                                                   
                         DECIMAL-POINT IS COMMA.                         
                                                                         
       *-----------------------------------------------------------------
        DATA DIVISION.                                                   
       *-----------------------------------------------------------------
                                                                         
       *-----------------------------------------------------------------
        WORKING-STORAGE SECTION.                                         
       *-----------------------------------------------------------------
                                                                         
        01 WS-AUXILIARES.                                                
           05 WS-IMAGEM-REAL          USAGE IS SQL TYPE IS BLOB (50M).   
           05 WS-DE-IMAGEM            PIC  X(50000000)     VALUE SPACES. 
           05 WS-SQLCODE                 PIC -Z.ZZ9        VALUE ZEROES. 
           05 WS-SQLCODE-FETCH           PIC S9(009)  COMP VALUE ZEROES. 
           05 WS-PARAGRAFO               PIC  X(080)       VALUE SPACES. 
           05 WS-NU-TAMANHO              PIC S9(04)   COMP VALUE ZEROES. 
           05 WS-IND                     PIC  9(002)       VALUE ZEROES. 
           05 WS-TAMANHO-I               PIC S9(004) COMP  VALUE ZEROES. 
           05 WS-CAMPO-JAVA-ENTRA.                                       
              10 WS-NU-SEQUENCIA-JAVA-E  PIC  9(009)       VALUE ZEROES. 
           05 WS-CAMPO-JAVA-SAIDA.                                       
              10 WS-CAMPO-JAVA-SAIDC        OCCURS 10 TIMES.             
                 15 WS-NU-SEQUENCIA-JAVA PIC  9(009).                    
                 15 WS-NU-IMAGEM-JAVA    PIC  9(009).                    
                                                                         
       *-----------------------------------------------------------------
        LOCAL-STORAGE SECTION.                                           
       *-----------------------------------------------------------------
                                                                         
       *    DEFINICAO DE TABELAS E AREAS NA DCLGEN                
                                                                         
            EXEC SQL INCLUDE SQLCA       END-EXEC.                       
            EXEC SQL INCLUDE TABELA02    END-EXEC.                       
            EXEC SQL INCLUDE TABELA32    END-EXEC.                       
            EXEC SQL INCLUDE TABELA59    END-EXEC.                       
            EXEC SQL INCLUDE TABELA61    END-EXEC.                       
                                                                         
            EXEC SQL                                                     
                 DECLARE CURSOR01 CURSOR FOR                             
                    SELECT TBA32.NU_IMAGEM                               
                    ,      TBA59.NU_SEQUENCIAL_MODELO                    
                    ,      BLOB(DE_IMAGEM)                               
                    FROM   CAD.TABELA32_IMAGEM              TBA32        
                    ,      CAD.TABELA59_IMAGEM_CRCTA_OBJETO TBA59        
                    ,      CAD.TABELA61_CRCTA_MODELO_OBJETO TBA61        
                    WHERE  TBA32.NU_IMAGEM = TBA59.NU_IMAGEM             
                    AND    TBA59.NU_SEQUENCIAL_MODELO =                  
                           TBA61.NU_SEQUENCIAL_MODELO                    
                    AND    TBA59.NU_SEQUENCIAL_MODELO =                  
                          :TABELA59.NU-SEQUENCIAL-MODELO                 
                    AND    IC_SITUACAO          = '1'                    
                 AND    TBA59.TS_CARACTERISTICA = TBA61.TS_CARACTERISTICA
                    ORDER BY TBA32.NU_IMAGEM                             
            END-EXEC.                                                    

       *-----------------------------------------------------------------
        LINKAGE SECTION.                                                 
       *-----------------------------------------------------------------
                                                                         
        01  DFHCOMMAREA.                                                 
            COPY COPY0001.                                               
       *-----------------------------------------------------------------
       * CONTEUDO DO BOOK - COPY0001                                     
       *-----------------------------------------------------------------
       *    02 STREAM.                                                   
       *       03 STREAM-IO-EXCECAO.                                     
       *          05 STREAM-IO-ERRO-CICS          PIC 9(003).            
       *          05 STREAM-IO-NU-MENSAGEM        PIC 9(004).            
       *          05 STREAM-IO-NO-MENSAGEM        PIC X(078).            
       *          05 STREAM-IO-NU-SQLCODE         PIC -9(03).            
       *          05 FILLER                       PIC X(018).            
       *       03 STREAM-IO-ENTRADA.                                     
       *          05 STREAM-IO-CONTEUDO-TAM       PIC 9(005).            
       *          05 STREAM-IO-CONTEUDO-ENT.                             
       *             07 STREAM-ENT-DADOS          PIC X(2000).           
       *       03 STREAM-IO-ENTRADA1 REDEFINES STREAM-IO-ENTRADA.        
       *          05 STREAM-IO-POINTER-MEM        POINTER.               
       *          05 STREAM-IO-CONTEUDO           PIC X(2001).           
       *01  MEMAREA.                                                     
       *       03 STREAM-IO-TAM-MEM               PIC 9(006).            
       *       03 STREAM-IO-DADOS.                                       
       *          05 STREAM-BA-DADOS OCCURS 1 TO 1000000                 
       *                          DECADDING ON STREAM-IO-TAM-MEM.        
       *             09 FILLER                    PIC X(001).            
       *                                                                 
       *-----------------------------------------------------------------
                                                                         
       *-----------------------------------------------------------------
        PROCEDURE DIVISION USING DFHCOMMAREA.                            
       *-----------------------------------------------------------------
                                                                         
            PERFORM P0001-PROCEDIMENTOS-INICIAIS                         
            PERFORM P1000-PROCEDIMENTOS-PRINCIPAIS                       
            PERFORM P9000-PROCEDIMENTOS-FINAIS                           
            .                                                            
       *-----------------------------------------------------------------
       *         PROCEDIMENTOS INICIAIS                                  
       *-----------------------------------------------------------------

        P0001-PROCEDIMENTOS-INICIAIS.                                    
                                                                         
            MOVE 'P0001-PROCEDIMENTOS-INICIAIS'    TO WS-PARAGRAFO       
            MOVE LENGTH OF STREAM-IO-CONTEUDO TO STREAM-IO-CONTEUDO-TAM  
            MOVE STREAM-ENT-DADOS  (1:STREAM-IO-CONTEUDO-TAM)            
                                             TO WS-CAMPO-JAVA-ENTRA      
            MOVE ZEROES                      TO STREAM-IO-ERRO-CICS      
                                     STREAM-IO-NU-MENSAGEM               
            MOVE WS-NU-SEQUENCIA-JAVA-E  TO                              
                    NU-SEQUENCIAL-MODELO OF TABELA59                     
            .                                                            
        P0001-FIM.                                                       
            EXIT.                                                        
                                                                         
       *-----------------------------------------------------------------
        P1000-PROCEDIMENTOS-PRINCIPAIS.                                  
       *-----------------------------------------------------------------
                                                                         
            MOVE 'P1000-PROCEDIMENTOS-PRINCIPAIS' TO WS-PARAGRAFO        
                                                                         
            PERFORM P3000-ABRE-CURSOR                                    
            IF SQLCODE NOT EQUAL +000                                    
               PERFORM P8000-TRATA-SQLCODE                               
            END-IF                                                       
                                                                         
            PERFORM P4000-LER-CURSOR                                     
            IF SQLCODE NOT EQUAL +000                                    
               PERFORM P8000-TRATA-SQLCODE                               
            END-IF                                                       
                                                                         
            MOVE 1                    TO WS-IND                          
            PERFORM UNTIL WS-SQLCODE-FETCH EQUAL +100                    
                    MOVE NU-IMAGEM OF TABELA59 TO                        
                                           WS-NU-IMAGEM-JAVA    (WS-IND) 
                    MOVE NU-SEQUENCIAL-MODELO OF TABELA59 TO             
                                           WS-NU-SEQUENCIA-JAVA (WS-IND) 
                    ADD 1 TO WS-IND                                      
                    PERFORM P4000-LER-CURSOR                             
            END-PERFORM                                                  
                                                                         
            PERFORM P5000-FECHA-CURSOR                                   
            IF SQLCODE NOT EQUAL +000                                    
               PERFORM P8000-TRATA-SQLCODE                               
            END-IF                                                       
            .                                                            
        P1000-FIM.                                                       
            EXIT.                                                        
                                                                         
       *-----------------------------------------------------------------
        P3000-ABRE-CURSOR.                                               
       *-----------------------------------------------------------------
                                                                         
            EXEC SQL                                                     
                 OCAD CURSOR01                                           
            END-EXEC                                                     
            .                                                            
        P3000-FIM. EXIT.                                                 
                                                                         
       *-----------------------------------------------------------------
        P4000-LER-CURSOR.                                                
       *-----------------------------------------------------------------
                                                                         
            EXEC SQL                                                     
                 FETCH CURSOR01                                          
                       INTO :TABELA59.NU-IMAGEM                          
                       ,    :TABELA59.NU-SEQUENCIAL-MODELO               
                       ,    :WS-IMAGEM-REAL                              
            END-EXEC                                                     
            MOVE SQLCODE TO WS-SQLCODE-FETCH                             
            .                                                            
        P4000-FIM.                                                       
            EXIT.                                                        
                                                                         
       *-----------------------------------------------------------------
        P5000-FECHA-CURSOR.                                              
       *-----------------------------------------------------------------
                                                                         
            EXEC SQL                                                     
                 CLOSE CURSOR01                                          
            END-EXEC                                                     
            .                                                            
        P5000-FIM.                                                       
            EXIT.                                                        
                                                                         
       *-----------------------------------------------------------------
        P8000-TRATA-SQLCODE.                                             
       *-----------------------------------------------------------------
                                                                         
            MOVE ZEROES  TO STREAM-IO-ERRO-CICS                          
            MOVE SQLCODE TO STREAM-IO-NU-MENSAGEM                        
                            STREAM-IO-NU-SQLCODE                         
            MOVE ZEROES  TO STREAM-IO-ERRO-CICS                          
            MOVE SQLCODE TO STREAM-IO-NU-MENSAGEM                        
                            STREAM-IO-NU-SQLCODE                         
            EVALUATE SQLCODE                                             
                WHEN +000                                                
                     CONTINUE                                            
                WHEN +100                                                
                     MOVE 'MN00014' TO CO-MENSAGEM OF TABELA02           
                     PERFORM P8999-OBTER-MENSAGEM THRU P8999-FIM         
                WHEN OTHER                                               
                   MOVE 'Erro de acesso ao banco de dados.'  TO          
                                                    STREAM-IO-NO-MENSAGEM
            END-EVALUATE                                                 
            .                                                            
        P8000-FIM.                                                       
            EXIT.                                                        
                                                                         
       *-----------------------------------------------------------------
        P8500-TRATA-SQLCODE.                                             
       *-----------------------------------------------------------------
                                                                         
            MOVE ZEROES  TO STREAM-IO-ERRO-CICS                          
            MOVE SQLCODE TO STREAM-IO-NU-MENSAGEM                        
                            STREAM-IO-NU-SQLCODE                         
            GOBACK                                                       
            .                                                            
        P8500-FIM.                                                       
            EXIT.                                                        
                                                                         
       *----------------------------------------------------------------*
        P8999-OBTER-MENSAGEM.                                            
       *----------------------------------------------------------------*
                                                                         
            EXEC SQL                                                     
                 SELECT DE_MENSAGEM                                        
                 INTO  :TABELA02.DE-MENSAGEM                               
                 FROM   CAD.TABELA02_MENSAGEM_APOIO                        
                 WHERE  CO_MENSAGEM = :TABELA02.CO-MENSAGEM                
                 AND    DT_FIM_VIGENCIA = '31.12.9999'                     
                 WITH UR                                                   
            END-EXEC                                                     
                                                                         
            MOVE ZEROES                 TO STREAM-IO-NU-MENSAGEM         
            IF SQLCODE EQUAL +000                                        
               STRING CO-MENSAGEM ' - '                                  
                    DE-MENSAGEM-TEXT (1:DE-MENSAGEM-LEN)                 
                    DELIMITED BY SIZE INTO STREAM-IO-NO-MENSAGEM         
               END-STRING                                                
            ELSE                                                         
               STRING CO-MENSAGEM ' - '                                  
                    'Mensagem nao cadastrada'                            
                    DELIMITED BY SIZE INTO STREAM-IO-NO-MENSAGEM         
               END-STRING                                                
            END-IF                                                       
            .                                                            
        P8999-FIM.                                                       
            EXIT.                                                        
                                                                         
       *-----------------------------------------------------------------
        P9000-PROCEDIMENTOS-FINAIS.                                      
       *-----------------------------------------------------------------
                                                                         
            COMPUTE WS-IND = WS-IND - 1                                  
                                                                         
            IF WS-IND GREATER THAN ZEROES                                
               COMPUTE WS-NU-TAMANHO = (WS-IND * 18)                     
            ELSE                                                         
               MOVE 1 TO WS-NU-TAMANHO                                   
            END-IF                                                       
                                                                         
            EXEC CICS GETMAIN SET(STREAM-IO-POINTER-MEM)                 
                      FLENGTH(WS-NU-TAMANHO)                             
            END-EXEC                                                     
                                                                         
            SET ADDRESS OF MEMAREA           TO STREAM-IO-POINTER-MEM.   
            MOVE WS-NU-TAMANHO               TO STREAM-IO-TAM-MEM.       
            MOVE WS-CAMPO-JAVA-SAIDA         TO STREAM-IO-DADOS.         
            EXEC CICS RETURN END-EXEC                                    
            .                                                            
        P9000-FIM.                                                       
            EXIT.