version 0.73.0
This commit is contained in:
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,674 @@
|
||||
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".
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,8 @@
|
||||
@echo off
|
||||
set INTERBASE=/opt/interbase
|
||||
set ISC_USER=SYSDBA
|
||||
set ISC_PASSWORD=masterkey
|
||||
c:\firebird\bin\gpre -co -d "teste.gdb" %1.ecob
|
||||
move %1.ecob.cbl %1.cob
|
||||
htcobol -vC %1.cob
|
||||
rem gcc -g -o %1 %1.o -L/usr/local/lib -lhtcobol -lm -ldl -lcrypt -L /opt/interbase/lib -lgds
|
||||
@@ -0,0 +1,138 @@
|
||||
Tinycobol+Firebird (EmbeddedSQL)
|
||||
================================
|
||||
|
||||
Fernando Wuthstrack <fernando@infocont.com.br>
|
||||
Danilo Pacheco Martins <danilo@infocont.com.br>
|
||||
Carlucio Lopes <carsanlo@terra.com.br>
|
||||
|
||||
Versao 0.02 - Sábado, 27 de maio de 2006
|
||||
|
||||
|
||||
Resumo
|
||||
------
|
||||
|
||||
Este tutorial tem por objetivo ser uma referencia ao aprendizado no
|
||||
Tinycobol com banco de dados Firebird, utilizando o recurso EmbeddedSQL,
|
||||
em ambiente Windows/Linux. Duvidas, criticas e sugestoes favor postar
|
||||
para lista inycobol em cobol@yahoogrupos.com.br
|
||||
|
||||
O uso do EmbeddedSQL facilita em muito o processo de integracao entre um
|
||||
programa COBOL e o Banco de Dados. O uso do EmbeddedSQL esta disponivel
|
||||
tambem para outros bancos de dados, como o Oracle e o DB2, alem do Firebird.
|
||||
O uso do EmbeddedSQL consiste na digitacao de comandos da linguagem SQL
|
||||
entre os marcadores EXEC SQL e END-EXEC, no proprio fonte COBOL.
|
||||
|
||||
Nota de Copyright
|
||||
-----------------
|
||||
|
||||
Copyleft (C) 2003 - InfoCont Sistemas Integrados Ltda.
|
||||
|
||||
Permission is granted to copy, distribute and/or modify this document
|
||||
under the terms of the GNU Free Documentation License, Version 1.1 or
|
||||
any later version published by the Free Software Foundation; A copy of
|
||||
the license is included in the section entitled "GNU Free
|
||||
Documentation License".
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
Conteudo
|
||||
--------
|
||||
1 - Instalando o Firebird.
|
||||
2 - Compilando programa cad01f.cob exemplo.
|
||||
3 - Duvidas e Sugestoes.
|
||||
4 - Apendice
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
1 - Instalando o Firebird
|
||||
|
||||
1.1 Fazendo download.
|
||||
Baixe a versao para Windows do Firebird atraves do site
|
||||
http://firebird.sourceforge.net ou www.firebird.com.br secao Download
|
||||
|
||||
1.2 Instale o arquivo baixado, seguindo todas as orientações trazidas na tela.
|
||||
|
||||
3 - Compilando programa cad01f.ecob exemplo.
|
||||
Este programa cad01f.ecob eh uma tela para cadastro de filiais.
|
||||
O processo de compilacao de um programa escrito com EmbeddebSQL envolve
|
||||
duas etapas, sendo que a primeira delas eh o pre-processamento pelo aplicativo
|
||||
GPRE, que converte todos os dialogos SQL para chamadas (CALLs) as APIS do
|
||||
Firebird.
|
||||
Para facilitar o processo de compilacao utilize o shell compilabd.
|
||||
Abaixo uma explicacao detalhada do shell script:
|
||||
|
||||
SET INTERBASE=/opt/interbase
|
||||
SET ISC_USER=SYSDBA
|
||||
SET ISC_PASSWORD=masterkey
|
||||
#=> As linhas acima setam parametros necessarios a execucao de aplicativos
|
||||
# escritos utilizando o Firebird
|
||||
C:\Arquiv~1\firebird\firebird_1_5\bin\gpre -co -d "teste.gdb" %1.ecob
|
||||
#=> A linha acima executa o pre-processamento (substituicao das instrucoes
|
||||
# SQL por comandos COBOL). A opcao -co identifica que sera pre-processado
|
||||
# um fonte COBOL e a opcao -d "teste.gdb" informa ao GPRE qual o banco
|
||||
# que sera acessado pelo programa. Isto se faz necessario para que o
|
||||
# mesmo possa recuperar a estrutura das tabelas que serao utilizadas no
|
||||
# programa.
|
||||
mv %1.ecob.cbl %1.cob
|
||||
#=> Como o GRPE gera um novo arquivo denominado nomefone.ecob.cbl, eh
|
||||
# necessario renomea-lo para permitir a compilacao pelo TinyCobol
|
||||
htcobol -vCX %1.cob
|
||||
#=> Compilacao e linkedicao normal do TinyCobol.
|
||||
|
||||
3.1 entre no diretorio /usr/local/tc_firebird digite:
|
||||
#cd /usr/local/tc_firebird
|
||||
|
||||
3.2 Usando script 'compilabd'
|
||||
existe o shell script 'compilabd' que esta no diretorio tc_firebird que fara todo o
|
||||
procedimento de compilacao automaticamente.
|
||||
|
||||
3.5.1 Use comando abaixo para mudar a permissao para execucao
|
||||
#chmod 755 compilabd
|
||||
|
||||
3.5.2 Executando o script 'compilabd'
|
||||
#./compilabd cad01f
|
||||
|
||||
3.6 Para verificamos erros de compilacao devemos abrir o arquivo cad01f.lis, que constara
|
||||
os status da compilacao, este arquivo eh gerado visto que colocamos opcao -P para compilarmos.
|
||||
|
||||
3.7 Pronto voce tem um programa em Tinycobol+Firebird com EmbeddedSQL.
|
||||
Para executa-lo, digite:
|
||||
#./cad01f
|
||||
|
||||
3.8 O Firebird possui uma ferramenta para interpretacao de dialogos SQL com
|
||||
interacao direta com o Banco de Dados, para isto, acesse o programa ISQL:
|
||||
# /opt/interbase/bin/isql
|
||||
Com esta ferramenta voce podera utilizar todos os comandos da linguagem
|
||||
SQL.
|
||||
|
||||
4 - Duvidas e Sugestoes.
|
||||
Poste suas duvidas e ou sugestoes para a lista abaixo, sendo que o topico devera ser
|
||||
enviado para lista adequada.
|
||||
|
||||
4.1 Tinycobol.
|
||||
lista cobol-br@listas.cipsga.org.br
|
||||
|
||||
4.2 Linux comandos e outros.
|
||||
lista linuxall@yahoo.com.br
|
||||
|
||||
4.3 Firebird
|
||||
lista firebird-br@yahoogrupos.com.br
|
||||
|
||||
5 - Apendice
|
||||
|
||||
5.1 Agradecimentos
|
||||
|
||||
- A DEUS que nos proporcionou o mais complexa CPU(Celebro Humano).
|
||||
- Rildo Pragana<rpragana@acm.org> pela iniciativa no desenvolvimento do compilador
|
||||
free Tinycobol.
|
||||
- Hudson Reis<hudsonreis@gmx.net> pela empenho de tornar esta ferramenta produtiva.
|
||||
- Ao Carlucio Lopes, que nos autorizou a adaptar o modelo original do
|
||||
PostgreSQL para o Firebird.
|
||||
- Ao Andrew Cameron, que iniciou os testes e constatou que eh possivel o
|
||||
uso do TinyCobol com o Firebird.
|
||||
|
||||
5.2 Colaboradores
|
||||
- Fernando Wuthstrack
|
||||
- Danilo Pacheco Martins
|
||||
- Carlucio Lopes
|
||||
- Rildo Pragana
|
||||
- Hudson Reis
|
||||
@@ -0,0 +1,25 @@
|
||||
*> acerto numero em alfanumerico
|
||||
num-x-9.
|
||||
perform numero-int thru numero-int3.
|
||||
numero-int.
|
||||
move spaces to numeronu.
|
||||
move 15 to seq-7
|
||||
move 15 to seq-77.
|
||||
numero-int1.
|
||||
if seq-77 = zeros go to numero-int2.
|
||||
if numeropos (seq-77) not numeric
|
||||
compute seq-77 = seq-77 - 1
|
||||
go to numero-int1.
|
||||
move numeropos (seq-77) to numeronupos (seq-7)
|
||||
compute seq-7 = seq-7 - 1
|
||||
compute seq-77 = seq-77 - 1.
|
||||
go to numero-int1.
|
||||
numero-int2.
|
||||
if seq-7 = zeros go to numero-int3.
|
||||
if numeronupos (seq-7) not numeric
|
||||
move zeros to numeronupos (seq-7)
|
||||
compute seq-7 = seq-7 - 1
|
||||
go to numero-int2.
|
||||
numero-int3.
|
||||
exit.
|
||||
|
||||
Binary file not shown.
@@ -0,0 +1,13 @@
|
||||
*> Variaveis para acerto do numero em caracter
|
||||
01 seq-geral.
|
||||
02 seq-77 pic 99 value zeros.
|
||||
02 seq-7 pic 99 value zeros.
|
||||
|
||||
01 numeroch pic x(15) value spaces.
|
||||
01 numerord redefines numeroch.
|
||||
03 numeropos occurs 15 times pic x.
|
||||
01 numeronu pic x(15) value spaces.
|
||||
01 numerorn redefines numeronu.
|
||||
03 numeronupos occurs 15 times pic x.
|
||||
|
||||
|
||||
Reference in New Issue
Block a user