Usando o ROWSET do DB2 - Programa exemplo 004 - www.cadcobol.com.br
Desenvolvido por DORNELLES Carlos Alberto - Analista de Sistemas - Brasília DF. - cad_cobol@hotmail.com
Usando o ROWSET do DB2 - Programa exemplo 004
1 2 3 4 5 6 7 8 12345678901234567890123456789012345678901234567890123456789012345678901234567890 *----------------------------------------------------------------- IDENTIFICATION DIVISION. *----------------------------------------------------------------- PROGRAM-ID. CADPO004. AUTHOR . DORNELLES CARLOS ALBERTO *----------------------------------------------------------------- * SISTEMA : SICAD * PROGRAMA : CADPO004 * OBJETIVO : MANTEM RELOGIO E OBJETOS * : CONSULTA DA TABELA CADTBA30 - EST. CONSERVACAO * ANALISTA : DORNELLES CARLOS ALBERTO * DATA : 19/NOVEMBRO/2012 *----------------------------------------------------------------- * MANUTENCAO *----------------------------------------------------------------- * VRS DD.MM.AAAA AUTOR DESCRICAO * 001 19.11.2012 DORNELLES CRIACAO *----------------------------------------------------------------- * 002 *----------------------------------------------------------------- *----------------------------------------------------------------- ENVIRONMENT DIVISION. *----------------------------------------------------------------- CONFIGURATION SECTION. SPECIAL-NAMES. DECIMAL-POINT IS COMMA. *----------------------------------------------------------------- DATA DIVISION. *----------------------------------------------------------------- *----------------------------------------------------------------- WORKING-STORAGE SECTION. *----------------------------------------------------------------- 01 WS-AUXILIARES. 05 TAM-GETMAIN PIC S9(008) BINARY. 05 WS-NU-TAMANHO PIC S9(008) COMP VALUE ZEROES. 05 WS-TAMANHO PIC S9(04) COMP VALUE ZEROES. 05 WS-PALAVRA PIC X(020) VALUE SPACES. 05 WS-SQLCODE PIC -Z.ZZ9 VALUE ZEROES. 05 WS-PARAGRAFO PIC X(080) VALUE SPACES. 05 WS-POSCURSOR PIC S9(004) COMP VALUE ZEROES. 05 WS-IND PIC 9(004) VALUE ZEROES. 05 WS-IC-EXCLUIDO-I PIC X(001) VALUE SPACES. 05 WS-IC-EXCLUIDO-F PIC X(001) VALUE SPACES. 05 WS-SAIDA-JAVA. 10 WS-TOTREG PIC 9(005). 10 WS-TOTREG-RETORNO PIC 9(005). 10 WS-ARRAY-SAIDA OCCURS 32700 TIMES. 15 WS-NU-EST-CONSERV PIC 9(0009). 15 WS-NO-EST-CONSERV PIC X(0020). 15 WS-IC-EXCLUIDO PIC X(0001). 01 WS495-REGISTRO. 05 WS495-TOTREG PIC 9(005). 05 WS495-TOTREG-RETORNO PIC 9(005). 05 WS495-NO-EST-CONSERV-JAVA PIC X(020). 05 WS495-IC-EXCLUIDO-JAVA PIC X(001). * Esta definicao esta correta - para armazenar os dados usando o * ROWSET tem que ser assim mesmo - valido para o DB2 a partir da versao 8 05 WS495-ARRAY. 10 WS495-NU-EST-CONSERV PIC S9(009) USAGE COMP OCCURS 32700 TIMES. 10 WS495-NO-EST-CONSERV PIC X(0020) OCCURS 32700 TIMES. 10 WS495-IC-EXCLUIDO PIC X(0001) OCCURS 32700 TIMES. *----------------------------------------------------------------- LOCAL-STORAGE SECTION. *----------------------------------------------------------------- *----------------------------------------------------------------- * DEFINICAO DE TABELAS E AREAS NA DCLGEN *----------------------------------------------------------------- EXEC SQL INCLUDE SQLCA END-EXEC. EXEC SQL INCLUDE CADTBA30 END-EXEC. EXEC SQL DECLARE CURSOR01 SCROLL CURSOR WITH ROWSET POSITIONING FOR SELECT NU_ESTADO_CONSERVACAO , NO_ESTADO_CONSERVACAO , IC_EXCLUIDO FROM CAD.CADTBA30_ESTADO_CONSERVACAO WHERE IC_EXCLUIDO BETWEEN :WS-IC-EXCLUIDO-I AND :WS-IC-EXCLUIDO-F AND NO_ESTADO_CONSERVACAO LIKE :WS-PALAVRA ORDER BY NO_ESTADO_CONSERVACAO END-EXEC. *----------------------------------------------------------------- * LINKAGE SECTION *----------------------------------------------------------------- LINKAGE SECTION. 01 DFHCOMMAREA. COPY CADB0001. *----------------------------------------------------------------- * CONTEUDO DO BOOK - CADB0001 *----------------------------------------------------------------- * 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 . *----------------------------------------------------------------- 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 WS495-REGISTRO MOVE ZEROES TO STREAM-IO-ERRO-CICS STREAM-IO-NU-MENSAGEM IF WS495-TOTREG-RETORNO EQUAL ZEROES MOVE 1 TO WS-POSCURSOR ELSE COMPUTE WS-POSCURSOR = WS495-TOTREG-RETORNO + 1 END-IF EVALUATE WS495-IC-EXCLUIDO-JAVA WHEN '1' MOVE '1' TO WS-IC-EXCLUIDO-I MOVE '1' TO WS-IC-EXCLUIDO-F WHEN '2' MOVE '2' TO WS-IC-EXCLUIDO-I MOVE '2' TO WS-IC-EXCLUIDO-F WHEN OTHER MOVE '1' TO WS-IC-EXCLUIDO-I MOVE '2' TO WS-IC-EXCLUIDO-F END-EVALUATE * Prepara a descrição para pesquisa MOVE WS495-NO-EST-CONSERV-JAVA TO WS-PALAVRA INSPECT WS-PALAVRA REPLACING ALL '%' BY ' ' STRING '%' WS-PALAVRA DELIMITED BY SPACES INTO WS-PALAVRA END-STRING EXEC SQL SELECT LENGTH(STRIP(:WS-PALAVRA)) INTO :WS-TAMANHO FROM SYSIBM.SYSDUMMY1 END-EXEC ADD 1 TO WS-TAMANHO PERFORM UNTIL WS-TAMANHO GREATER THAN 20 MOVE '%' TO WS-PALAVRA(WS-TAMANHO:1) ADD 1 TO WS-TAMANHO END-PERFORM . P0001-FIM. EXIT. *----------------------------------------------------------------- P1000-PROCEDIMENTOS-PRINCIPAIS. *----------------------------------------------------------------- MOVE 'P1000-PROCEDIMENTOS-PRINCIPAIS' TO WS-PARAGRAFO PERFORM P3000-ABRE-CURSOR IF SQLCODE NOT EQUAL +000 AND +100 PERFORM P8000-TRATA-SQLCODE END-IF PERFORM P4000-LER-CURSOR IF SQLCODE NOT EQUAL +000 AND +100 PERFORM P8000-TRATA-SQLCODE END-IF IF SQLERRD(3) EQUAL ZEROES AND WS495-TOTREG-RETORNO EQUAL ZEROES MOVE +9999 TO SQLCODE PERFORM P8000-TRATA-SQLCODE END-IF MOVE WS495-TOTREG-RETORNO TO WS-TOTREG-RETORNO MOVE WS495-TOTREG TO WS-TOTREG MOVE 1 TO WS-IND PERFORM UNTIL WS-IND GREATER THAN SQLERRD (3) MOVE WS495-NU-EST-CONSERV (WS-IND) TO WS-NU-EST-CONSERV (WS-IND) MOVE WS495-NO-EST-CONSERV (WS-IND) TO WS-NO-EST-CONSERV (WS-IND) MOVE WS495-IC-EXCLUIDO (WS-IND) TO WS-IC-EXCLUIDO (WS-IND) ADD 1 TO WS-IND 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 ROWSET STARTING AT ABSOLUTE :WS-POSCURSOR CURSOR01 FOR 32700 ROWS INTO :WS495-NU-EST-CONSERV , :WS495-NO-EST-CONSERV , :WS495-IC-EXCLUIDO END-EXEC *----------------------------------------------------------------- * * SQLCODE = +000 o FETCH trouxe 32700 registros * * SQLCODE = +100 e SQLERRD(3) = 0 * o FETCH não trouxe mais nenhum registro * * SQLCODE= +100 e SQLERRD(3) > 0 * o FETCH trouxe tantos registros quanto o valor que * consta em SQLERRD(3) * *----------------------------------------------------------------- COMPUTE WS495-TOTREG-RETORNO = (WS-POSCURSOR + SQLERRD (3)) - 1 EVALUATE SQLCODE WHEN +000 MOVE SQLERRD (3) TO WS495-TOTREG WHEN +100 IF SQLERRD (3) EQUAL +0 MOVE ZEROES TO WS495-TOTREG ELSE MOVE SQLERRD (3) TO WS495-TOTREG END-IF WHEN OTHER PERFORM P8000-TRATA-SQLCODE END-EVALUATE . 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 EVALUATE SQLCODE WHEN +000 WHEN +100 CONTINUE WHEN +9999 MOVE 'Nenhum registro encontrado.' TO STREAM-IO-NO-MENSAGEM WHEN OTHER MOVE 'Erro de acesso ao banco de dados.' TO STREAM-IO-NO-MENSAGEM END-EVALUATE . P8000-FIM. EXIT. *----------------------------------------------------------------- P9000-PROCEDIMENTOS-FINAIS. *----------------------------------------------------------------- * CALCULA O TAMANHO DA AREA ENVIADA PARA O JAVA * --------------------------------------------- IF WS-IND GREATER THAN ZEROES COMPUTE WS-NU-TAMANHO = (WS495-TOTREG * 30) + 10 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-SAIDA-JAVA TO STREAM-IO-DADOS. EXEC CICS RETURN END-EXEC . P9000-FIM. EXIT.
