IDENTIFICATION DIVISION. PROGRAM-ID. cad01f. AUTHOR. InfoCont Sistemas Integrados Ltda. * Responsaveis: Danilo Pacheco Martins / Fernando Wuthstrack * Baseado no modelo CAD01 (PostgreSQL) disponibilizado por Carlucio Lopes ENVIRONMENT DIVISION. CONFIGURATION SECTION. SPECIAL-NAMES. DECIMAL-POINT IS COMMA CRT STATUS IS wx-escape. DATA DIVISION. WORKING-STORAGE SECTION. exec sql include "sqlca" end-exec 77 wx-status01 PIC XX VALUE "00". 77 wx-opcao PIC xxx value spaces. 77 wx-escape PIC 9999 VALUE 0. 77 wx-key-esc PIC 9999 VALUE 27. 77 wx-key-f2 PIC 99 VALUE 02. 77 wx-key-ac PIC 9999 VALUE 259. 77 wx-dec PIC 99 VALUE 0. 77 wx-pare PIC X VALUE SPACE. 77 wx-mensagem PIC X(61) VALUE SPACE. 01 codigo-sql PIC 9(9)- value zeros. 01 isc-1db REDEFINES isc_1db PIC X(8). 01 w01-cursor. 03 w03-linha pic 99 value 1. 03 w03-coluna pic 99 value 1. exec sql begin declare section end-exec 01 reg-filial. 02 chave-filial. 03 fi_codigo pic 9(03). 02 fi_nome pic x(50). 02 fi_fantasia pic x(40). 02 fi_endereco pic x(40). 02 fi_end_num pic 9(05). 02 fi_end_setor pic x(20). 02 fi_cidade pic x(25). 02 fi_uf pic x(02). 02 fi_cep pic 9(08). 02 fi_fone_ddd pic x(04). 02 fi_fone_num pic x(08). 02 fi_fax_ddd pic x(04). 02 fi_fax_num pic x(08). 02 fi_cgc pic x(18). 02 fi_insest pic x(20). 02 fi_contato pic x(40). 01 v_nome pic x(50). 01 v_fantasia pic x(40). 01 v_setor pic x(20). exec sql end declare section end-exec 77 wfi_codigo pic x(05). 77 traco pic x(80) value all "-". 77 wfi_end_num pic x(05). 77 ed_num pic zzzz9. 01 lixo pic x. 01 tipo pic x. copy "wkglobal.cpy". screen section. 01 tela. 03 filler pic x(1920) blank screen line 4 column 1 foreground-color 7 background-color 1 value spaces. PROCEDURE DIVISION. loop-conectar-ao-banco-de-dado. perform 080-CONNECT-MYDB. LOOP-CLEAR. display tela. PERFORM LOOP-ZERA. perform loop-tela accept wx-opcao line 2 position 36 if wx-opcao = "SAI" or "sai" stop run. LOOP-INCLUSAO. display tela. PERFORM LOOP-ZERA. perform loop-tela. if wx-opcao = "INC" or "inc" display wx-opcao line 2 position 36 perform loop-accept thru loop-accept-exit if fi_codigo = zeros go to LOOP-CLEAR else exec sql insert into filial (codigo, nome, nome_fantasia, endereco, numero, setor, cidade, uf, cep, foneddd, fonenum, faxddd, faxnum, cgc, insest, contato) values (:fi_codigo, upper(:fi_nome), :fi_fantasia, :fi_endereco, :fi_end_num, :fi_end_setor, :fi_cidade, :fi_uf, :fi_cep, :fi_fone_ddd, :fi_fone_num, :fi_fax_ddd, :fi_fax_num, :fi_cgc, :fi_insest, :fi_contato) end-exec if sqlcode not equal zeros move sqlcode to codigo-sql display 'erro ao inserir os dados ' codigo-sql at 3301 accept lixo stop run end-if display "GRAVA S/N=" line 24 position 1 accept wx-pare line 24 position 12 if wx-pare = "S" or "s" exec sql commit end-exec if sqlcode not equal zeros move sqlcode to codigo-sql display 'erro ao confirmar a insercao de dados ' codigo-sql at 3301 accept lixo stop run end-if go to LOOP-INCLUSAO else exec sql rollback end-exec if sqlcode not equal zeros move sqlcode to codigo-sql display 'erro ao cancelar a insercao de dados ' codigo-sql at 3301 accept lixo stop run end-if go to LOOP-INCLUSAO. LOOP-CONSULTA. if wx-opcao = "CON" or "con" display tela PERFORM LOOP-ZERA perform loop-tela display wx-opcao line 2 position 36 accept wfi_codigo line 4 position 15 move wfi_codigo to numeroch perform num-x-9 move numeronu to fi_codigo ed_num display ed_num line 4 position 15 if fi_codigo = zeros go to LOOP-CLEAR else perform LOOP-SQL-CON if lixo = 'n' display "Item nao encontrado Tecle enter" line 24 position 2 accept wx-pare go to LOOP-CONSULTA else perform LOOP-MOSTRA display "Tecle enter para uma nova busca" line 24 position 2 accept wx-pare go to LOOP-CONSULTA. LOOP-ALTERACAO. if wx-opcao = "ALT" or "alt" display tela PERFORM LOOP-ZERA perform loop-tela display wx-opcao line 2 position 36 accept wfi_codigo line 4 position 15 move wfi_codigo to numeroch perform num-x-9 move numeronu to fi_codigo ed_num display fi_codigo line 4 position 17 if fi_codigo = zeros go to LOOP-CLEAR else perform LOOP-SQL-CON if LIXO = 'N' display "Item nao encontrado Tecle enter" line 24 position 2 accept wx-pare go to LOOP-ALTERACAO else perform LOOP-MOSTRA perform loop-accept-fi-nome thru loop-accept-exit exec sql update filial set nome = :fi_nome, nome_fantasia = :fi_fantasia, endereco = :fi_endereco, numero = :fi_end_num, setor = :fi_end_setor, cidade = :fi_cidade, uf = :fi_uf, cep = :fi_cep, foneddd = :fi_fone_ddd, fonenum = :fi_fone_num, faxddd = :fi_fax_ddd, faxnum = :fi_fax_num, cgc = :fi_cgc, insest = :fi_insest, contato = :fi_contato where codigo = :fi_codigo end-exec if sqlcode not equal zeros move sqlcode to codigo-sql display 'erro ao alterar os dados ' codigo-sql at 3301 accept lixo stop run end-if display "Altera S/N=" line 24 position 1 accept wx-pare line 24 position 13 if wx-pare = "S" or "s" exec sql commit end-exec if sqlcode not equal zeros move sqlcode to codigo-sql display 'erro ao confirmar a alteracao ' codigo-sql at 3301 accept lixo stop run end-if go to LOOP-ALTERACAO else exec sql rollback end-exec if sqlcode not equal zeros move sqlcode to codigo-sql display 'erro ao confirmar a alteracao ' codigo-sql at 3301 accept lixo stop run end-if go to LOOP-ALTERACAO. LOOP-EXCLUSAO. if wx-opcao = "EXC" or "exc" display tela PERFORM LOOP-ZERA perform loop-tela display wx-opcao line 2 position 36 accept wfi_codigo line 4 position 15 move wfi_codigo to numeroch perform num-x-9 move numeronu to fi_codigo ed_num display fi_codigo line 4 position 15 if fi_codigo = zeros go to LOOP-CLEAR else perform LOOP-SQL-CON if lixo = 'n' display "Item nao encontrado Tecle enter" line 24 position 2 accept wx-pare go to LOOP-EXCLUSAO else perform LOOP-MOSTRA exec sql delete from filial where codigo = :fi_codigo end-exec if sqlcode not equal zeros move sqlcode to codigo-sql display 'erro ao deletar os dados ' codigo-sql at 3301 accept lixo stop run end-if display "Delete S/N=" line 24 position 1 accept wx-pare line 24 position 13 if wx-pare = "S" or "s" exec sql commit end-exec if sqlcode not equal zeros move sqlcode to codigo-sql display 'erro ao confirmar a exclusao ' codigo-sql at 3301 accept lixo stop run end-if go to LOOP-EXCLUSAO else go to LOOP-EXCLUSAO end-if GO TO LOOP-CLEAR. LOOP-PERSONALIZADA. if wx-opcao equal "pes" or "PES" display wx-opcao at 0236 go to LOOP-CONSULTA-PERSONALIZADA. LOOP-OPCAO-ERRADA. GO TO LOOP-CLEAR. LOOP-CONSULTA-PERSONALIZADA. perform ZERA-TELA. LOOP-CONSULTA-NOME. move spaces to tipo. initialize fi_codigo, fi_nome, fi_fantasia, fi_endereco, fi_end_num, fi_end_setor, fi_cidade, fi_uf, fi_cep, fi_fone_ddd, fi_fone_num, fi_fax_ddd, fi_fax_num, fi_cgc, fi_insest, fi_contato. display 'Por ordem de (N)ome ou (C)odigo? ' at 0502 accept tipo at 0535 display ' ' at 0502 if tipo equal 'C' or tipo equal 'c' go to DECLARA-CONSULTAC. if tipo equal 'N' or tipo equal 'n' go to DECLARA-CONSULTAN. DECLARA-CONSULTAC. exec sql declare consultac cursor for select codigo, nome, nome_fantasia, endereco, numero, setor, cidade, uf, cep, foneddd, fonenum, faxddd, faxnum, cgc, insest, contato from filial order by codigo end-exec if sqlcode not equal zeros move sqlcode to codigo-sql display 'erro ao criar consultac' at 3302 accept lixo stop run. go to LOOP-ABRIR-CODIGO. DECLARA-CONSULTAN. exec sql declare consultan cursor for select codigo, nome, nome_fantasia, endereco, numero, setor, cidade, uf, cep, foneddd, fonenum, faxddd, faxnum, cgc, insest, contato from filial order by nome end-exec if sqlcode not equal zeros move sqlcode to codigo-sql display 'erro ao criar lista de consultan ' codigo-sql at 2901 accept lixo stop run. go to LOOP-ABRIR-NOME. LOOP-ABRIR-NOME. exec sql open consultan end-exec if sqlcode not equal zeros move sqlcode to codigo-sql display 'erro ao abrir lista de consultan ' codigo-sql at 3301 accept lixo stop run. go to LOOP-PROXIMO-NOME. LOOP-ABRIR-CODIGO. exec sql open consultac end-exec if sqlcode not equal zeros move sqlcode to codigo-sql display 'erro ao abrir lista de consultac ' codigo-sql at 3301 accept lixo stop run. go to LOOP-PROXIMO-CODIGO. LOOP-PROXIMO-NOME. move 4 to w03-linha move 2 to w03-coluna perform until sqlcode not equal zeros exec sql fetch consultan into :fi_codigo, :fi_nome, :fi_fantasia,:fi_endereco, :fi_end_num, :fi_end_setor, :fi_cidade, :fi_uf, :fi_cep, :fi_fone_ddd, :fi_fone_num, :fi_fax_ddd, :fi_fax_num, :fi_cgc, :fi_insest, :fi_contato end-exec if sqlcode equal 100 display 'Fim de consultan, tecle ENTER ' at 2402 accept lixo at 2432 display ' ' at 2402 end-if if sqlcode not equal zeros and 100 move sqlcode to codigo-sql display 'erro ao fazer a consulta ' codigo-sql at 3301 else move 2 to w03-coluna display fi_codigo at w01-cursor move 6 to w03-coluna display fi_nome at w01-cursor add 1 to w03-linha if w03-linha = 24 display 'Tecle ENTER para mais registros ' at 2402 accept lixo at 2434 perform ZERA-TELA move 4 to w03-linha move 2 to w03-coluna end-if end-if end-perform exec sql close consultan end-exec go to LOOP-CLEAR. LOOP-PROXIMO-CODIGO. move 4 to w03-linha move 2 to w03-coluna perform until sqlcode not equal zeros exec sql fetch consultac into :fi_codigo, :fi_nome, :fi_fantasia,:fi_endereco, :fi_end_num, :fi_end_setor, :fi_cidade, :fi_uf, :fi_cep, :fi_fone_ddd, :fi_fone_num, :fi_fax_ddd, :fi_fax_num, :fi_cgc, :fi_insest, :fi_contato end-exec if sqlcode equal 100 display 'Fim de consultac, tecle ENTER ' at 2402 accept lixo at 2432 display ' ' at 2402 end-if if sqlcode not equal zeros and 100 move sqlcode to codigo-sql display 'erro ao fazer a consulta ' codigo-sql at 3301 else move 2 to w03-coluna display fi_codigo at w01-cursor move 6 to w03-coluna display fi_nome at w01-cursor add 1 to w03-linha if w03-linha = 24 display 'Tecle ENTER para mais registros ' at 2402 accept lixo at 2434 perform ZERA-TELA move 4 to w03-linha move 2 to w03-coluna end-if end-if end-perform exec sql close consultac end-exec go to LOOP-CLEAR. ZERA-TELA. MOVE 4 TO W03-LINHA. MOVE 1 TO W03-COLUNA. perform until w03-linha >24 display ' ' at w01-cursor add 1 to w03-linha end-perform. LOOP00. LOOP-CODIGO. LOOP-ZERA. MOVE ZEROS TO REG-FILIAL. MOVE ZEROS TO fi_codigo. MOVE SPACE TO fi_nome. MOVE SPACE TO fi_endereco. MOVE ZEROS TO fi_end_num. MOVE SPACES TO fi_end_setor. MOVE SPACES TO fi_cidade. MOVE SPACES TO fi_uf. MOVE spaces TO fi_cep. MOVE SPACES TO fi_fone_ddd. MOVE SPACES TO fi_fone_num. MOVE SPACES TO fi_fax_ddd. MOVE SPACES TO fi_fax_num. MOVE SPACES TO fi_cgc. MOVE SPACES TO fi_insest. move spaces to fi_fantasia. move spaces to fi_contato. loop-tela. display traco line 1 position 1 display "Opcao PES/INC/ALT/CON/EXC/SAI=>>" line 2 position 2 display traco line 3 position 1 display "Codigo....:" line 4 position 2 display "Nome......:" line 5 position 2 display "Nome Fant.:" line 6 position 2 display "Endereco..:" line 7 position 2 display "Numero....:" line 7 position 60 display "Setor.....:" line 8 position 2. display "Cidade....:" line 9 position 2 display "Estado....:" line 10 position 2 display "cep.......:" line 10 position 20 display "Fone ddd..:" line 11 position 2 display "Fone num..:" line 11 position 20. display "Fax ddd...:" line 12 position 2 display "Fax num...:" line 12 position 20 display "c.g.c.....:" line 13 position 2 display "Insc.Est..:" line 14 position 2 display "Contato...:" line 15 position 2. loop-accept. if wx-opcao = "ALT" or "alt" go to loop-accept-exit end-if accept wfi_codigo line 4 position 15 if wx-escape = wx-key-ac or wx-key-esc go to LOOP-CLEAR. move wfi_codigo to numeroch perform num-x-9 move numeronu to fi_codigo ed_num display ed_num line 4 position 15 if wfi_codigo = zeros go to loop-accept-exit. perform LOOP-SQL-CON. if lixo not = 'n' display "Item ja cadastrado " line 24 position 01 accept wx-pare go to loop-accept. loop-accept-fi-nome. accept fi_nome with update line 5 position 15 if wx-escape = wx-key-ac or wx-key-esc go to loop-accept. loop-accept-fi-fantasia. accept fi_fantasia with update line 6 position 15 if wx-escape = wx-key-ac or wx-key-esc go to loop-accept-fi-nome. loop-accept-fi-endereco. accept fi_endereco with update line 7 position 15 if wx-escape = wx-key-ac or wx-key-esc go to loop-accept-fi-fantasia. loop-accept-fi-end-num. accept wfi_end_num line 7 position 71 if wx-escape = wx-key-ac or wx-key-esc go to loop-accept-fi-endereco. move wfi_end_num to numeroch perform num-x-9 move numeronu to fi_end_num ed_num display ed_num line 7 position 71. loop-accept-fi-end-setor. accept fi_end_setor with update line 8 position 15. if wx-escape = wx-key-ac or wx-key-esc go to loop-accept-fi-end-num. if fi_end_setor = spaces go to loop-accept-fi-end-num. loop-accept-fi-cidade. accept fi_cidade with update line 9 position 15 if fi_cidade = spaces go to loop-accept-fi-end-setor. if wx-escape = wx-key-ac or wx-key-esc go to loop-accept-fi-end-setor. loop-accept-fi-uf. accept fi_uf with update line 10 position 15 if fi_uf = spaces go to loop-accept-fi-cidade. if wx-escape = wx-key-ac or wx-key-esc go to loop-accept-fi-cidade. loop-accept-fi-cep. accept fi_cep with update line 10 position 35 if wx-escape = wx-key-ac or wx-key-esc go to loop-accept-fi-uf. loop-accept-fi-fone-ddd. accept fi_fone_ddd with update line 11 position 15 if wx-escape = wx-key-ac or wx-key-esc go to loop-accept-fi-cep. loop-accept-fi-fone-num. accept fi_fone_num with update line 11 position 35 if wx-escape = wx-key-ac or wx-key-esc go to loop-accept-fi-fone-ddd. loop-accept-fi-fax-ddd. accept fi_fax_ddd with update line 12 position 15 if wx-escape = wx-key-ac or wx-key-esc go to loop-accept-fi-fone-num. loop-accept-fi-fax-num. accept fi_fax_num with update line 12 position 35 if wx-escape = wx-key-ac or wx-key-esc go to loop-accept-fi-fax-ddd. loop-accept-fi-cgc. accept fi_cgc with update line 13 position 15 if wx-escape = wx-key-ac or wx-key-esc go to loop-accept-fi-fax-num. loop-accept-fi-inscest. accept fi_insest with update line 14 position 15 if wx-escape = wx-key-ac or wx-key-esc go to loop-accept-fi-cgc. loop-accept-fi-contato. accept fi_contato with update line 15 position 15 if wx-escape = wx-key-ac or wx-key-esc go to loop-accept-fi-inscest. loop-accept-exit. exit. LOOP-SQL-CON. exec sql select codigo, nome, nome_fantasia, endereco, numero, setor, cidade, uf, cep, foneddd, fonenum, faxddd, faxnum, cgc, insest, contato into :fi_codigo, :fi_nome, :fi_fantasia, :fi_endereco, :fi_end_num, :fi_end_setor, :fi_cidade, :fi_uf, :fi_cep, :fi_fone_ddd, :fi_fone_num, :fi_fax_ddd, :fi_fax_num, :fi_cgc, :fi_insest, :fi_contato from filial where codigo = :fi_codigo end-exec if sqlcode not equal 0 display 'ERRO AO PROCURAR O ARQUIVO: ' at 3301 move sqlcode to codigo-sql display codigo-sql at 3329 move 'n' to lixo else move 's' to lixo. LOOP-MOSTRA. display fi_codigo line 4 position 17 display fi_nome line 5 position 15 display fi_fantasia line 6 position 15 display fi_endereco line 7 position 15 display fi_end_num line 7 position 71 display fi_end_setor line 8 position 15 display fi_cidade line 9 position 15 display fi_uf line 10 position 15 display fi_cep line 10 position 35 display fi_fone_ddd line 11 position 15 display fi_fone_num line 11 position 35 display fi_fax_ddd line 12 position 15 display fi_fax_num line 12 position 35 display fi_cgc line 13 position 15 display fi_insest line 14 position 15 display fi_contato line 15 position 15. LOOP-FIM. stop run. 050-DISCONECTAR. exec sql disconnect all end-exec if sqlcode not equal zeros move sqlcode to codigo-sql display 'erro ao disconectar o banco de dados ' codigo-sql at 3301 accept lixo stop run. 080-CONNECT-MYDB. exec sql connect 'teste.gdb' end-exec if sqlcode not equal zeros move sqlcode to codigo-sql display 'erro ao conectar o banco de dados ' codigo-sql at 3301 accept lixo perform 400-create-database-tabela. 400-create-database-tabela section. exec sql create database "teste.gdb" end-exec if sqlcode not equal zeros move sqlcode to codigo-sql display 'erro ao criar o banco de dados ' codigo-sql at 3301 accept lixo stop run. exec sql create table filial ( codigo integer not null primary key, nome varchar(50), nome_fantasia varchar(40), endereco varchar(40), numero integer, setor varchar(25), cidade varchar(25), uf varchar(02), cep varchar(08), foneddd varchar(04), fonenum varchar(08), faxddd varchar(04), faxnum varchar(08), cgc varchar(18), insest varchar(20), contato varchar(40) ) end-exec if sqlcode not equal zeros display 'erro ao criar a tabela ' at 3301 move sqlcode to codigo-sql display codigo-sql at 3324 accept lixo stop run. 400-EXIT. EXIT. accept wx-pare. copy "pcglobal.cpy".