tinycobol/tutorials/Firebird/cad01f.ecob

675 lines
24 KiB
Plaintext

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".