tinycobol/tutorials/PostgreSQL/cad01.cob

476 lines
18 KiB
COBOL

IDENTIFICATION DIVISION.
PROGRAM-ID. cad01.
AUTHOR. Carlucio Lopes.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES.
DECIMAL-POINT IS COMMA
CRT STATUS IS wx-escape.
*> INPUT-OUTPUT SECTION.
*> FILE-CONTROL.
DATA DIVISION.
FILE SECTION.
WORKING-STORAGE SECTION.
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.
77 DATABASE-NAME PIC X(80).
77 SQL-QUERY PIC X(1000).
77 DB-HANDLE PIC 9(12) COMP.
77 QRY-HANDLE PIC 9(12) COMP.
77 NTUPLE PIC 9(12) COMP.
77 NFIELD PIC 9(12) COMP.
77 MAX-TUPLE PIC 9(12) COMP.
77 MAX-FIELD PIC 9(12) COMP.
77 COLUMN-VALUE pic X(80) VALUE SPACES.
77 NEW-DB-NAME PIC X(40) value "postgres".
77 CMD pic 9.
77 ed-num pic zzzz9.
77 DB-STATUS pic 9(12) COMP.
77 DB-MESSAGE pic X(200).
77 traco pic x(80) value all "-".
77 wfi-codigo pic x(05).
77 wfi-end-num pic x(05).
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-FON-ddd-num.
03 fi-fone-ddd PIC X(04).
03 fi-fone-num PIC X(08).
02 fi-fax-ddd-num.
03 fi-fax-ddd PIC X(04).
03 fi-fax-num PIC X(08).
02 fi-cgc PIC X(18).
02 fi-inscest PIC X(20).
02 fi-contato PIC X(40).
copy "wkglobal.cpy".
LINKAGE SECTION.
77 chamando pic x(40).
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.
*> PROCEDURE DIVISION USING CHAMANDO.
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 33
if wx-opcao = "SAI" or "sai"
*> exit program.
stop run.
LOOP-INCLUSAO.
display tela.
PERFORM LOOP-ZERA.
perform loop-tela.
if wx-opcao = "INC" or "inc"
display wx-opcao line 2 position 33
perform loop-accept thru loop-accept-exit
if fi-codigo = zeros go to LOOP-CLEAR
else
string "insert into filial"
"( codigo, nome, nome_fantasia,"
"endereco, numero, setor, cidade, uf, cep, "
"foneddd, fonenum, faxddd, faxnum,"
" cgc, insest, contato) "
" values (" 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-inscest
"','"fi-contato "');;"
into SQL-QUERY
display "GRAVA S/N=" line 24 position 1
accept wx-pare line 24 position 10
if wx-pare = "S" or "s"
perform 090-DO-QUERY
perform 200-CHECK-STATUS
call "sql_clear_query" using QRY-HANDLE
go to LOOP-INCLUSAO
else 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 33
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 MAX-TUPLE = zeros
display "Item nao encontrado Tecle enter" line 24 position 1
accept wx-pare
go to LOOP-CONSULTA
else
perform LOOP-MOSTRA
accept wx-pare
call "sql_clear_query" using QRY-HANDLE
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 33
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 MAX-TUPLE = zeros
display "Item nao encontrado Tecle enter" line 24 position 1
accept wx-pare
go to LOOP-ALTERACAO
else
perform LOOP-MOSTRA
perform loop-accept-fi-nome thru loop-accept-exit
string "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-inscest "'"
",contato = '" fi-contato "'"
" where codigo =" fi-codigo ";;"
into SQL-QUERY
display "Altera S/N=" line 24 position 1
accept wx-pare line 24 position 10
if wx-pare = "S" or "s"
perform 090-DO-QUERY
perform 200-CHECK-STATUS
call "sql_clear_query" using QRY-HANDLE
go to LOOP-ALTERACAO
else
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 33
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 MAX-TUPLE = zeros
display "Item nao encontrado Tecle enter" line 24 position 1
accept wx-pare
go to LOOP-EXCLUSAO
else
perform LOOP-MOSTRA
string "delete from filial"
" where codigo =" fi-codigo ";;"
into SQL-QUERY
display "Delete S/N=" line 24 position 1
accept wx-pare line 24 position 10
if wx-pare = "S" or "s"
perform 090-DO-QUERY
perform 200-CHECK-STATUS
call "sql_clear_query" using QRY-HANDLE
go to LOOP-EXCLUSAO
else
go to LOOP-EXCLUSAO.
GO TO LOOP-CLEAR.
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-inscest.
move spaces to fi-fantasia.
move spaces to fi-contato.
loop-tela.
display traco line 1 position 1
display "Opcao /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.
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-accept-exit.
perform LOOP-SQL-CON.
if MAX-TUPLE not = zeros
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 go to loop-accept.
loop-accept-fi-fantasia.
accept fi-fantasia with update line 6 position 15
if wx-escape = wx-key-ac 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 go to loop-accept-fi-fantasia.
loop-accept-fi-end-num.
accept wfi-end-num line 7 position 71
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
if wx-escape = wx-key-ac go to loop-accept-fi-endereco.
loop-accept-fi-end-setor.
accept fi-end-setor with update line 8 position 15.
if fi-end-setor = spaces go to loop-accept-fi-end-num.
if wx-escape = wx-key-ac 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 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 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 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 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 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 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 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 go to loop-accept-fi-fax-num.
loop-accept-fi-inscest.
accept fi-inscest with update line 14 position 15.
if wx-escape = wx-key-ac 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 go to loop-accept-fi-inscest.
loop-accept-exit. exit.
LOOP-SQL-CON.
string "select * from filial where codigo = " fi-codigo ";;"
into SQL-QUERY
perform 090-DO-QUERY
call "sql_max_tuple" using QRY-HANDLE MAX-TUPLE
call "sql_max_field" using QRY-HANDLE MAX-FIELD.
LOOP-MOSTRA.
move zeros to NTUPLE NFIELD
call "sql_get_value" using QRY-HANDLE NTUPLE NFIELD wfi-codigo
move wfi-codigo to numeroch perform num-x-9
move numeronu to fi-codigo ed-num
display " " line 4 position 15
display fi-codigo line 4 position 17
move zeros to NTUPLE move 1 to NFIELD
call "sql_get_value" using QRY-HANDLE NTUPLE NFIELD fi-nome
display fi-nome line 5 position 15
move zeros to NTUPLE move 2 to NFIELD
call "sql_get_value" using QRY-HANDLE NTUPLE NFIELD fi-fantasia
display fi-fantasia line 6 position 15
move zeros to NTUPLE move 3 to NFIELD
call "sql_get_value" using QRY-HANDLE NTUPLE NFIELD fi-endereco
display fi-endereco line 7 position 15
move zeros to NTUPLE move 4 to NFIELD
call "sql_get_value" using QRY-HANDLE NTUPLE NFIELD wfi-end-num
move wfi-end-num to numeroch perform num-x-9
move numeronu to fi-end-num ed-num
display fi-end-num line 7 position 71
move zeros to NTUPLE move 5 to NFIELD
call "sql_get_value" using QRY-HANDLE NTUPLE NFIELD fi-end-setor
display fi-end-setor line 8 position 15
move zeros to NTUPLE move 6 to NFIELD
call "sql_get_value" using QRY-HANDLE NTUPLE NFIELD fi-cidade
display fi-cidade line 9 position 15
move zeros to NTUPLE move 7 to NFIELD
call "sql_get_value" using QRY-HANDLE NTUPLE NFIELD fi-uf
display fi-uf line 10 position 15
move zeros to NTUPLE move 8 to NFIELD
call "sql_get_value" using QRY-HANDLE NTUPLE NFIELD fi-cep
display fi-cep line 10 position 35
move zeros to NTUPLE move 9 to NFIELD
call "sql_get_value" using QRY-HANDLE NTUPLE NFIELD fi-fone-ddd
display fi-fone-ddd line 11 position 15
move zeros to NTUPLE move 10 to NFIELD
call "sql_get_value" using QRY-HANDLE NTUPLE NFIELD fi-fone-num
display fi-fone-num line 11 position 35
move zeros to NTUPLE move 11 to NFIELD
call "sql_get_value" using QRY-HANDLE NTUPLE NFIELD fi-fax-ddd
display fi-fax-ddd line 12 position 15
move zeros to NTUPLE move 12 to NFIELD
call "sql_get_value" using QRY-HANDLE NTUPLE NFIELD fi-fax-num
display fi-fax-num line 12 position 35
move zeros to NTUPLE move 13 to NFIELD
call "sql_get_value" using QRY-HANDLE NTUPLE NFIELD fi-cgc
display fi-cgc line 13 position 15
move zeros to NTUPLE move 14 to NFIELD
call "sql_get_value" using QRY-HANDLE NTUPLE NFIELD fi-inscest
display fi-inscest line 14 position 15
move zeros to NTUPLE move 15 to NFIELD
call "sql_get_value" using QRY-HANDLE NTUPLE NFIELD fi-contato
display fi-contato line 15 position 15.
LOOP-FIM.
stop run.
050-DISCONECTAR.
call "sql_disconnect_db" using DB-HANDLE.
070-CONECTAR-TEMPLATE.
move "template1" to DATABASE-NAME.
call "sql_connect_db" using DATABASE-NAME DB-HANDLE DB-STATUS.
if DB-STATUS not = zeros
display "Erro na coneccao do banco de dados!" line 23 position 1
stop run.
080-CONNECT-MYDB.
move "postgres" to DATABASE-NAME.
call "sql_connect_db" using DATABASE-NAME DB-HANDLE DB-STATUS.
if DB-STATUS not = zeros
display "Erro na coneccao do banco de dado!"
line 24 position 01
stop run.
090-DO-QUERY.
call "sql_exec_query" using DB-HANDLE SQL-QUERY QRY-HANDLE DB-STATUS.
200-CHECK-STATUS.
*> display "DB-STATUS = " DB-STATUS.
if (DB-STATUS not = 1 and DB-STATUS not = 2)
move spaces to DB-MESSAGE
call "sql_status_message" using DB-HANDLE DB-MESSAGE
display DB-MESSAGE line 24 position 01
accept wx-pare.
copy "pcglobal.cpy".