version 0.73.0
This commit is contained in:
@@ -0,0 +1,339 @@
|
||||
GNU GENERAL PUBLIC LICENSE
|
||||
Version 2, June 1991
|
||||
|
||||
Copyright (C) 1989, 1991 Free Software Foundation, Inc.
|
||||
675 Mass Ave, Cambridge, MA 02139, USA
|
||||
Everyone is permitted to copy and distribute verbatim copies
|
||||
of this license document, but changing it is not allowed.
|
||||
|
||||
Preamble
|
||||
|
||||
The licenses for most software are designed to take away your
|
||||
freedom to share and change it. By contrast, the GNU General Public
|
||||
License is intended to guarantee your freedom to share and change free
|
||||
software--to make sure the software is free for all its users. This
|
||||
General Public License applies to most of the Free Software
|
||||
Foundation's software and to any other program whose authors commit to
|
||||
using it. (Some other Free Software Foundation software is covered by
|
||||
the GNU Library General Public License instead.) You can apply it to
|
||||
your programs, too.
|
||||
|
||||
When we speak of free software, we are referring to freedom, not
|
||||
price. Our General Public Licenses are designed to make sure that you
|
||||
have the freedom to distribute copies of free software (and charge for
|
||||
this service if you wish), that you receive source code or can get it
|
||||
if you want it, that you can change the software or use pieces of it
|
||||
in new free programs; and that you know you can do these things.
|
||||
|
||||
To protect your rights, we need to make restrictions that forbid
|
||||
anyone to deny you these rights or to ask you to surrender the rights.
|
||||
These restrictions translate to certain responsibilities for you if you
|
||||
distribute copies of the software, or if you modify it.
|
||||
|
||||
For example, if you distribute copies of such a program, whether
|
||||
gratis or for a fee, you must give the recipients all the rights that
|
||||
you have. You must make sure that they, too, receive or can get the
|
||||
source code. And you must show them these terms so they know their
|
||||
rights.
|
||||
|
||||
We protect your rights with two steps: (1) copyright the software, and
|
||||
(2) offer you this license which gives you legal permission to copy,
|
||||
distribute and/or modify the software.
|
||||
|
||||
Also, for each author's protection and ours, we want to make certain
|
||||
that everyone understands that there is no warranty for this free
|
||||
software. If the software is modified by someone else and passed on, we
|
||||
want its recipients to know that what they have is not the original, so
|
||||
that any problems introduced by others will not reflect on the original
|
||||
authors' reputations.
|
||||
|
||||
Finally, any free program is threatened constantly by software
|
||||
patents. We wish to avoid the danger that redistributors of a free
|
||||
program will individually obtain patent licenses, in effect making the
|
||||
program proprietary. To prevent this, we have made it clear that any
|
||||
patent must be licensed for everyone's free use or not licensed at all.
|
||||
|
||||
The precise terms and conditions for copying, distribution and
|
||||
modification follow.
|
||||
|
||||
GNU GENERAL PUBLIC LICENSE
|
||||
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
|
||||
|
||||
0. This License applies to any program or other work which contains
|
||||
a notice placed by the copyright holder saying it may be distributed
|
||||
under the terms of this General Public License. The "Program", below,
|
||||
refers to any such program or work, and a "work based on the Program"
|
||||
means either the Program or any derivative work under copyright law:
|
||||
that is to say, a work containing the Program or a portion of it,
|
||||
either verbatim or with modifications and/or translated into another
|
||||
language. (Hereinafter, translation is included without limitation in
|
||||
the term "modification".) Each licensee is addressed as "you".
|
||||
|
||||
Activities other than copying, distribution and modification are not
|
||||
covered by this License; they are outside its scope. The act of
|
||||
running the Program is not restricted, and the output from the Program
|
||||
is covered only if its contents constitute a work based on the
|
||||
Program (independent of having been made by running the Program).
|
||||
Whether that is true depends on what the Program does.
|
||||
|
||||
1. You may copy and distribute verbatim copies of the Program's
|
||||
source code as you receive it, in any medium, provided that you
|
||||
conspicuously and appropriately publish on each copy an appropriate
|
||||
copyright notice and disclaimer of warranty; keep intact all the
|
||||
notices that refer to this License and to the absence of any warranty;
|
||||
and give any other recipients of the Program a copy of this License
|
||||
along with the Program.
|
||||
|
||||
You may charge a fee for the physical act of transferring a copy, and
|
||||
you may at your option offer warranty protection in exchange for a fee.
|
||||
|
||||
2. You may modify your copy or copies of the Program or any portion
|
||||
of it, thus forming a work based on the Program, and copy and
|
||||
distribute such modifications or work under the terms of Section 1
|
||||
above, provided that you also meet all of these conditions:
|
||||
|
||||
a) You must cause the modified files to carry prominent notices
|
||||
stating that you changed the files and the date of any change.
|
||||
|
||||
b) You must cause any work that you distribute or publish, that in
|
||||
whole or in part contains or is derived from the Program or any
|
||||
part thereof, to be licensed as a whole at no charge to all third
|
||||
parties under the terms of this License.
|
||||
|
||||
c) If the modified program normally reads commands interactively
|
||||
when run, you must cause it, when started running for such
|
||||
interactive use in the most ordinary way, to print or display an
|
||||
announcement including an appropriate copyright notice and a
|
||||
notice that there is no warranty (or else, saying that you provide
|
||||
a warranty) and that users may redistribute the program under
|
||||
these conditions, and telling the user how to view a copy of this
|
||||
License. (Exception: if the Program itself is interactive but
|
||||
does not normally print such an announcement, your work based on
|
||||
the Program is not required to print an announcement.)
|
||||
|
||||
These requirements apply to the modified work as a whole. If
|
||||
identifiable sections of that work are not derived from the Program,
|
||||
and can be reasonably considered independent and separate works in
|
||||
themselves, then this License, and its terms, do not apply to those
|
||||
sections when you distribute them as separate works. But when you
|
||||
distribute the same sections as part of a whole which is a work based
|
||||
on the Program, the distribution of the whole must be on the terms of
|
||||
this License, whose permissions for other licensees extend to the
|
||||
entire whole, and thus to each and every part regardless of who wrote it.
|
||||
|
||||
Thus, it is not the intent of this section to claim rights or contest
|
||||
your rights to work written entirely by you; rather, the intent is to
|
||||
exercise the right to control the distribution of derivative or
|
||||
collective works based on the Program.
|
||||
|
||||
In addition, mere aggregation of another work not based on the Program
|
||||
with the Program (or with a work based on the Program) on a volume of
|
||||
a storage or distribution medium does not bring the other work under
|
||||
the scope of this License.
|
||||
|
||||
3. You may copy and distribute the Program (or a work based on it,
|
||||
under Section 2) in object code or executable form under the terms of
|
||||
Sections 1 and 2 above provided that you also do one of the following:
|
||||
|
||||
a) Accompany it with the complete corresponding machine-readable
|
||||
source code, which must be distributed under the terms of Sections
|
||||
1 and 2 above on a medium customarily used for software interchange; or,
|
||||
|
||||
b) Accompany it with a written offer, valid for at least three
|
||||
years, to give any third party, for a charge no more than your
|
||||
cost of physically performing source distribution, a complete
|
||||
machine-readable copy of the corresponding source code, to be
|
||||
distributed under the terms of Sections 1 and 2 above on a medium
|
||||
customarily used for software interchange; or,
|
||||
|
||||
c) Accompany it with the information you received as to the offer
|
||||
to distribute corresponding source code. (This alternative is
|
||||
allowed only for noncommercial distribution and only if you
|
||||
received the program in object code or executable form with such
|
||||
an offer, in accord with Subsection b above.)
|
||||
|
||||
The source code for a work means the preferred form of the work for
|
||||
making modifications to it. For an executable work, complete source
|
||||
code means all the source code for all modules it contains, plus any
|
||||
associated interface definition files, plus the scripts used to
|
||||
control compilation and installation of the executable. However, as a
|
||||
special exception, the source code distributed need not include
|
||||
anything that is normally distributed (in either source or binary
|
||||
form) with the major components (compiler, kernel, and so on) of the
|
||||
operating system on which the executable runs, unless that component
|
||||
itself accompanies the executable.
|
||||
|
||||
If distribution of executable or object code is made by offering
|
||||
access to copy from a designated place, then offering equivalent
|
||||
access to copy the source code from the same place counts as
|
||||
distribution of the source code, even though third parties are not
|
||||
compelled to copy the source along with the object code.
|
||||
|
||||
4. You may not copy, modify, sublicense, or distribute the Program
|
||||
except as expressly provided under this License. Any attempt
|
||||
otherwise to copy, modify, sublicense or distribute the Program is
|
||||
void, and will automatically terminate your rights under this License.
|
||||
However, parties who have received copies, or rights, from you under
|
||||
this License will not have their licenses terminated so long as such
|
||||
parties remain in full compliance.
|
||||
|
||||
5. You are not required to accept this License, since you have not
|
||||
signed it. However, nothing else grants you permission to modify or
|
||||
distribute the Program or its derivative works. These actions are
|
||||
prohibited by law if you do not accept this License. Therefore, by
|
||||
modifying or distributing the Program (or any work based on the
|
||||
Program), you indicate your acceptance of this License to do so, and
|
||||
all its terms and conditions for copying, distributing or modifying
|
||||
the Program or works based on it.
|
||||
|
||||
6. Each time you redistribute the Program (or any work based on the
|
||||
Program), the recipient automatically receives a license from the
|
||||
original licensor to copy, distribute or modify the Program subject to
|
||||
these terms and conditions. You may not impose any further
|
||||
restrictions on the recipients' exercise of the rights granted herein.
|
||||
You are not responsible for enforcing compliance by third parties to
|
||||
this License.
|
||||
|
||||
7. If, as a consequence of a court judgment or allegation of patent
|
||||
infringement or for any other reason (not limited to patent issues),
|
||||
conditions are imposed on you (whether by court order, agreement or
|
||||
otherwise) that contradict the conditions of this License, they do not
|
||||
excuse you from the conditions of this License. If you cannot
|
||||
distribute so as to satisfy simultaneously your obligations under this
|
||||
License and any other pertinent obligations, then as a consequence you
|
||||
may not distribute the Program at all. For example, if a patent
|
||||
license would not permit royalty-free redistribution of the Program by
|
||||
all those who receive copies directly or indirectly through you, then
|
||||
the only way you could satisfy both it and this License would be to
|
||||
refrain entirely from distribution of the Program.
|
||||
|
||||
If any portion of this section is held invalid or unenforceable under
|
||||
any particular circumstance, the balance of the section is intended to
|
||||
apply and the section as a whole is intended to apply in other
|
||||
circumstances.
|
||||
|
||||
It is not the purpose of this section to induce you to infringe any
|
||||
patents or other property right claims or to contest validity of any
|
||||
such claims; this section has the sole purpose of protecting the
|
||||
integrity of the free software distribution system, which is
|
||||
implemented by public license practices. Many people have made
|
||||
generous contributions to the wide range of software distributed
|
||||
through that system in reliance on consistent application of that
|
||||
system; it is up to the author/donor to decide if he or she is willing
|
||||
to distribute software through any other system and a licensee cannot
|
||||
impose that choice.
|
||||
|
||||
This section is intended to make thoroughly clear what is believed to
|
||||
be a consequence of the rest of this License.
|
||||
|
||||
8. If the distribution and/or use of the Program is restricted in
|
||||
certain countries either by patents or by copyrighted interfaces, the
|
||||
original copyright holder who places the Program under this License
|
||||
may add an explicit geographical distribution limitation excluding
|
||||
those countries, so that distribution is permitted only in or among
|
||||
countries not thus excluded. In such case, this License incorporates
|
||||
the limitation as if written in the body of this License.
|
||||
|
||||
9. The Free Software Foundation may publish revised and/or new versions
|
||||
of the General Public License from time to time. Such new versions will
|
||||
be similar in spirit to the present version, but may differ in detail to
|
||||
address new problems or concerns.
|
||||
|
||||
Each version is given a distinguishing version number. If the Program
|
||||
specifies a version number of this License which applies to it and "any
|
||||
later version", you have the option of following the terms and conditions
|
||||
either of that version or of any later version published by the Free
|
||||
Software Foundation. If the Program does not specify a version number of
|
||||
this License, you may choose any version ever published by the Free Software
|
||||
Foundation.
|
||||
|
||||
10. If you wish to incorporate parts of the Program into other free
|
||||
programs whose distribution conditions are different, write to the author
|
||||
to ask for permission. For software which is copyrighted by the Free
|
||||
Software Foundation, write to the Free Software Foundation; we sometimes
|
||||
make exceptions for this. Our decision will be guided by the two goals
|
||||
of preserving the free status of all derivatives of our free software and
|
||||
of promoting the sharing and reuse of software generally.
|
||||
|
||||
NO WARRANTY
|
||||
|
||||
11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
|
||||
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
|
||||
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
|
||||
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
|
||||
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
|
||||
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
|
||||
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
|
||||
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
|
||||
REPAIR OR CORRECTION.
|
||||
|
||||
12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
|
||||
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
|
||||
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
|
||||
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
|
||||
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
|
||||
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
|
||||
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
|
||||
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
|
||||
POSSIBILITY OF SUCH DAMAGES.
|
||||
|
||||
END OF TERMS AND CONDITIONS
|
||||
|
||||
Appendix: How to Apply These Terms to Your New Programs
|
||||
|
||||
If you develop a new program, and you want it to be of the greatest
|
||||
possible use to the public, the best way to achieve this is to make it
|
||||
free software which everyone can redistribute and change under these terms.
|
||||
|
||||
To do so, attach the following notices to the program. It is safest
|
||||
to attach them to the start of each source file to most effectively
|
||||
convey the exclusion of warranty; and each file should have at least
|
||||
the "copyright" line and a pointer to where the full notice is found.
|
||||
|
||||
<one line to give the program's name and a brief idea of what it does.>
|
||||
Copyright (C) 19yy <name of author>
|
||||
|
||||
This program is free software; you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation; either version 2 of the License, or
|
||||
(at your option) any later version.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program; if not, write to the Free Software
|
||||
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
||||
|
||||
Also add information on how to contact you by electronic and paper mail.
|
||||
|
||||
If the program is interactive, make it output a short notice like this
|
||||
when it starts in an interactive mode:
|
||||
|
||||
Gnomovision version 69, Copyright (C) 19yy name of author
|
||||
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
|
||||
This is free software, and you are welcome to redistribute it
|
||||
under certain conditions; type `show c' for details.
|
||||
|
||||
The hypothetical commands `show w' and `show c' should show the appropriate
|
||||
parts of the General Public License. Of course, the commands you use may
|
||||
be called something other than `show w' and `show c'; they could even be
|
||||
mouse-clicks or menu items--whatever suits your program.
|
||||
|
||||
You should also get your employer (if you work as a programmer) or your
|
||||
school, if any, to sign a "copyright disclaimer" for the program, if
|
||||
necessary. Here is a sample; alter the names:
|
||||
|
||||
Yoyodyne, Inc., hereby disclaims all copyright interest in the program
|
||||
`Gnomovision' (which makes passes at compilers) written by James Hacker.
|
||||
|
||||
<signature of Ty Coon>, 1 April 1989
|
||||
Ty Coon, President of Vice
|
||||
|
||||
This General Public License does not permit incorporating your program into
|
||||
proprietary programs. If your program is a subroutine library, you may
|
||||
consider it more useful to permit linking proprietary applications with the
|
||||
library. If this is what you want to do, use the GNU Library General
|
||||
Public License instead of this License.
|
||||
@@ -0,0 +1,49 @@
|
||||
#
|
||||
# Makefile para compilar programas.
|
||||
|
||||
COB := htcobol
|
||||
CCX := gcc
|
||||
RM := rm -f
|
||||
INSTALL := install -m 755
|
||||
|
||||
COBFLAGS := -c -F -T 8
|
||||
CCXFLAGS := -g -o
|
||||
|
||||
COPYBOOKS := -I.
|
||||
LIBS := -lhtcobol
|
||||
BINDIR := /usr/local/bin
|
||||
|
||||
SRC1 := cbl2cob.cob
|
||||
SRC2 := mfparser.cob
|
||||
SRC3 := mbparser.cob
|
||||
|
||||
OBJ1 := $(SRC1:.cob=.o)
|
||||
OBJ2 := $(SRC2:.cob=.o)
|
||||
OBJ3 := $(SRC3:.cob=.o)
|
||||
|
||||
PROG1 := $(SRC1:.cob= )
|
||||
|
||||
OBJS1 := $(OBJ1) $(OBJ2) $(OBJ3)
|
||||
OBJS := $(OBJ1) $(OBJ2) $(OBJ3)
|
||||
#OBJS1 := $(OBJ1) $(OBJ2)
|
||||
#OBJS := $(OBJ1) $(OBJ2)
|
||||
PROGS := $(PROG1)
|
||||
|
||||
all: $(OBJS) $(PROGS)
|
||||
|
||||
$(PROG1): $(OBJS1)
|
||||
$(CCX) $(CCXFLAGS) $(PROG1) $(OBJS1) $(LIBS)
|
||||
|
||||
# Rules to compile COBOL programs to assembly object code.
|
||||
%.o: %.cob
|
||||
$(COB) $(COBFLAGS) $<
|
||||
|
||||
# Rules to generate binary programs from object code.
|
||||
%: %.o
|
||||
$(CCX) $(CCXFLAGS) $@ $< $(LIBS)
|
||||
|
||||
clean:
|
||||
$(RM) $(OBJS) $(PROGS) *.i *.s
|
||||
|
||||
install:
|
||||
$(INSTALL) $(PROG1) $(BINDIR)
|
||||
@@ -0,0 +1,59 @@
|
||||
STATUS:
|
||||
-------
|
||||
- Temos suporte para dois compiladores, MF e MB.
|
||||
- Para usar o cbl2cob e converter para o microbase, use a opção "-d mb".
|
||||
- Para executar os exemplos de conversão, vá até o diretório samples e
|
||||
digite "Make -f Makefile.Mb".
|
||||
|
||||
Até o presente momento o cbl2cob faz as seguintes ações:
|
||||
|
||||
- Adiciona IDENTIFICATION DIVISION se preciso.
|
||||
- Adiciona PROGRAM-ID se preciso.
|
||||
- Converte conteúdo da PROGRAM-ID em minúsculo.
|
||||
- Retira clausulas LOCK MODE.
|
||||
- Retira clausulas DATA RECORD.
|
||||
- Retira cláusulas VALUE OF FILE-ID.
|
||||
- Acerta caracteres de continuacao de linha(simples ou duplos),
|
||||
modificando-os de estarem na coluna 9 para a coluna 12.
|
||||
- DISPLAY.
|
||||
- Substituir clausula DISPLAY AT LINE .. COLUMN .. por DISPLAY AT ....
|
||||
- Retirar clausulas BACKGROUND-COLOR, FOREGROUND-COLOR, BELL e PROMPT
|
||||
- Substituir parametro AUTO-SKIP por AUTO.
|
||||
- ACCEPT.
|
||||
- Substituir clausula DISPLAY AT LINE .. COLUMN .. por DISPLAY AT ....
|
||||
- Retirar clausulas BACKGROUND-COLOR, FOREGROUND-COLOR e PROMPT
|
||||
- Substituir parametro AUTO-SKIP por AUTO.
|
||||
- Remover clausula ACCEPT FROM ESCAPE KEY.
|
||||
- Insere CRT STATUS IS <VARIAVEL-TECLA>.
|
||||
- CALL e CANCEL
|
||||
- Transforma o conteúdo entre aspas em lowercase
|
||||
- Remove funcoes X"AF".
|
||||
- Remove funcoes X"91".
|
||||
- SELECT.
|
||||
- Substitui ASSIGN TO <nome-arquivo> para ASSIGN TO EXTERNAL <nome-arquivo>
|
||||
- Substitui ASSIGN TO DISK por ASSIGN TO EXTERNAL <nome-arquivo>
|
||||
- Substitui ASSIGN TO PRINTER por ASSIGN TO EXTERNAL printer
|
||||
- Substitui "\" por "/" nas strings.
|
||||
- MOVE.
|
||||
- Retirar "$" nas strings.
|
||||
- Substituir "\" por "/" nas strings.
|
||||
- DELETE.
|
||||
- Remove a cláusula FILE, se usada junto com o DELETE.
|
||||
- Pre-processa(abre/fecha) fontes, com o verbo COPY.
|
||||
|
||||
Futuramente, será implementado as seguintes ações:
|
||||
|
||||
- Inserir inteligencia no parser para indentar as linhas de continuacao
|
||||
corretamente.
|
||||
- Inserir inteligencia no parser para remover instrucoes que tenham mais
|
||||
de uma linha.
|
||||
- Inserir inteligencia no parser para usar diversas variaveis de arquivo.
|
||||
- Substituir assign to PRINTER por assign to <nome-arquivo>
|
||||
Inserir chamada SYSTEM.
|
||||
- Substituir rotinas x"91" por rotina "cbl_call_system"
|
||||
- Substituir rotinas x"AF" por rotina "cbl_read_kbd_char"
|
||||
- Substituir rotinas x"B8" por rotina ...
|
||||
- Substituir rotinas PC_PRINTER por rotina ...
|
||||
- Substituir CBL_READ_SCR_CHATTRS por rotina cbl_read_scr_chattrs
|
||||
- Substituir CBL_WRITE_SCR_CHATTRS por rotina cbl_write_scr_chattrs
|
||||
|
||||
@@ -0,0 +1,561 @@
|
||||
*
|
||||
* Copyright (C) 2003, Hudson Reis,
|
||||
* Infocont Sistemas Integrados Ltda.
|
||||
*
|
||||
* This program is free software; you can redistribute it and/or
|
||||
* modify it under the terms of the GNU General Public License as
|
||||
* published by the Free Software Foundation; either version 2,
|
||||
* or (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public
|
||||
* License along with this software; see the file COPYING.
|
||||
* If not, write to the Free Software Foundation, Inc., 59 Temple
|
||||
* Place, Suite 330, Boston, MA 02111-1307 USA
|
||||
*
|
||||
identification division.
|
||||
program-id. cbl2cob.
|
||||
author. Hudson Reis.
|
||||
date-written. 03/05/2003.
|
||||
*
|
||||
* Front-end para pré-processar o fonte de entrada e chamar o
|
||||
* parser selecionado, mediante a escolha do usuário.
|
||||
*
|
||||
environment division.
|
||||
configuration section.
|
||||
input-output section.
|
||||
file-control.
|
||||
copy "entrada.sl".
|
||||
copy "intermed.sl".
|
||||
copy "saida.sl".
|
||||
|
||||
data division.
|
||||
file section.
|
||||
copy "entrada.fd".
|
||||
copy "intermed.fd".
|
||||
copy "saida.fd".
|
||||
|
||||
working-storage section.
|
||||
copy "globals.ws".
|
||||
copy "globals.ls".
|
||||
77 filler pic x(001) value spaces.
|
||||
* Linha de comando para pegar a string digitada pelo usuario.
|
||||
77 ws77-linha-comando pic x(512) value spaces.
|
||||
* Variáveis que serão usadas para quebrar a frase
|
||||
* passada na linha de comando, pelo usuário.
|
||||
* O número máximo argumentos supotados é 8.
|
||||
01 ws01-args.
|
||||
02 ws02-arg-a pic x(256) value spaces.
|
||||
02 ws02-arg-b pic x(256) value spaces.
|
||||
02 ws02-arg-c pic x(256) value spaces.
|
||||
02 ws02-arg-d pic x(256) value spaces.
|
||||
02 ws02-arg-e pic x(256) value spaces.
|
||||
02 ws02-arg-f pic x(256) value spaces.
|
||||
02 ws02-arg-g pic x(256) value spaces.
|
||||
02 ws02-arg-h pic x(256) value spaces.
|
||||
* Lugar temporário para a switch do dialeto selecionado.
|
||||
77 ws77-dialeto-selecionado pic x(256) value spaces.
|
||||
* Variáveis para os dialetos.
|
||||
77 ws77-dialeto-entrada pic x(003) value spaces.
|
||||
88 ws88-microbase value "mb".
|
||||
88 ws88-microfocus value "mf".
|
||||
88 ws88-rm value "rm".
|
||||
* Variável para determinar se o dado a ser tratado é um valor
|
||||
* ou uma switch.
|
||||
77 ws77-dado pic 9(001) value zeros.
|
||||
88 ws88-switch value 0.
|
||||
88 ws88-valor value 1.
|
||||
* Opções do pre-processador.
|
||||
77 ws77-opcoes-pp pic 9(001) value zeros.
|
||||
88 ws88-abrir-copybooks value 0.
|
||||
88 ws88-fechar-copybooks value 1.
|
||||
* Variáveis que vão armazenar o basename de cada arquivo, caso
|
||||
* o usuário indique um diretório externo ao diretório corrente
|
||||
77 ws77-basename-entrada pic x(256) value spaces.
|
||||
77 ws77-basename-saida pic x(256) value spaces.
|
||||
* Variáveis com o valor das switches selecionadas.
|
||||
77 ws77-escolher-dialeto pic x(002) value "-d".
|
||||
77 ws77-mostrar-ajuda pic x(002) value "-h".
|
||||
77 ws77-fonte-entrada pic x(002) value "-i".
|
||||
77 ws77-fonte-saida pic x(002) value "-o".
|
||||
77 ws77-modo-verboso pic x(002) value "-v".
|
||||
77 ws77-exibir-versao pic x(002) value "-V".
|
||||
* A otimizar.
|
||||
77 ws77-linha-para-parsing pic x(256) value spaces.
|
||||
01 ws01-case.
|
||||
02 ws02-maiusculo pic x(26)
|
||||
value "ABCDEFGHIJKLMNOPQRSTUVXYWZ".
|
||||
02 ws02-minusculo pic x(26)
|
||||
value "abcdefghijklmnopqrstuvxywz".
|
||||
|
||||
procedure division.
|
||||
perform ler-linha-de-comando
|
||||
set ws88-abrir-copybooks to true
|
||||
perform pre-processar-fonte
|
||||
evaluate true
|
||||
when ws88-microfocus
|
||||
call "mfparser" using ws77-arquivo-entrada
|
||||
ws77-arquivo-saida
|
||||
ws77-processo
|
||||
end-call
|
||||
when ws88-microbase
|
||||
call "mbparser" using ws77-arquivo-entrada
|
||||
ws77-arquivo-saida
|
||||
ws77-processo
|
||||
end-call
|
||||
end-evaluate
|
||||
* set ws88-fechar-copybooks to true
|
||||
* perform pre-processar-fonte
|
||||
perform finalizar
|
||||
.
|
||||
*****************************************************************
|
||||
* Rotinas principais *
|
||||
*****************************************************************
|
||||
ler-linha-de-comando.
|
||||
* 1a. Etapa: Lendo as opções da linha de comando.
|
||||
accept ws77-linha-comando from command-line
|
||||
if return-code not equal zeros
|
||||
display "Tamanho da linha de comando truncada!"
|
||||
perform finalizar
|
||||
end-if
|
||||
if ws88-processo-verboso
|
||||
display "Linha de comando: " ws77-linha-comando
|
||||
end-if
|
||||
unstring ws77-linha-comando delimited by ' ' into
|
||||
ws02-arg-a
|
||||
ws02-arg-b
|
||||
ws02-arg-c
|
||||
ws02-arg-d
|
||||
ws02-arg-e
|
||||
ws02-arg-f
|
||||
ws02-arg-g
|
||||
ws02-arg-h
|
||||
end-unstring
|
||||
if ws88-processo-verboso
|
||||
perform varying ws02-i from 256 by -1
|
||||
until ws02-arg-a(ws02-i:1)
|
||||
not equal spaces or ws02-i equal zeros
|
||||
continue
|
||||
end-perform
|
||||
add 1 to ws02-i
|
||||
display "Argumento a: " ws02-arg-a(1:ws02-i)
|
||||
|
||||
perform varying ws02-i from 256 by -1
|
||||
until ws02-arg-b(ws02-i:1)
|
||||
not equal spaces or ws02-i equal zeros
|
||||
continue
|
||||
end-perform
|
||||
add 1 to ws02-i
|
||||
display "Argumento b: " ws02-arg-b(1:ws02-i)
|
||||
|
||||
perform varying ws02-i from 256 by -1
|
||||
until ws02-arg-c(ws02-i:1)
|
||||
not equal spaces or ws02-i equal zeros
|
||||
continue
|
||||
end-perform
|
||||
add 1 to ws02-i
|
||||
display "Argumento c: " ws02-arg-c(1:ws02-i)
|
||||
|
||||
perform varying ws02-i from 256 by -1
|
||||
until ws02-arg-d(ws02-i:1)
|
||||
not equal spaces or ws02-i equal zeros
|
||||
continue
|
||||
end-perform
|
||||
add 1 to ws02-i
|
||||
display "Argumento d: " ws02-arg-d(1:ws02-i)
|
||||
|
||||
perform varying ws02-i from 256 by -1
|
||||
until ws02-arg-e(ws02-i:1)
|
||||
not equal spaces or ws02-i equal zeros
|
||||
continue
|
||||
end-perform
|
||||
add 1 to ws02-i
|
||||
display "Argumento e: " ws02-arg-e(1:ws02-i)
|
||||
|
||||
perform varying ws02-i from 256 by -1
|
||||
until ws02-arg-f(ws02-i:1)
|
||||
not equal spaces or ws02-i equal zeros
|
||||
continue
|
||||
end-perform
|
||||
add 1 to ws02-i
|
||||
display "Argumento f: " ws02-arg-f(1:ws02-i)
|
||||
|
||||
perform varying ws02-i from 256 by -1
|
||||
until ws02-arg-g(ws02-i:1)
|
||||
not equal spaces or ws02-i equal zeros
|
||||
continue
|
||||
end-perform
|
||||
add 1 to ws02-i
|
||||
display "Argumento g: " ws02-arg-g(1:ws02-i)
|
||||
|
||||
perform varying ws02-i from 256 by -1
|
||||
until ws02-arg-h(ws02-i:1)
|
||||
not equal spaces or ws02-i equal zeros
|
||||
continue
|
||||
end-perform
|
||||
add 1 to ws02-i
|
||||
display "Argumento h: " ws02-arg-h(1:ws02-i)
|
||||
end-if
|
||||
if ws88-switch
|
||||
evaluate ws02-arg-b
|
||||
when ws77-escolher-dialeto
|
||||
move ws02-arg-c to ws77-dialeto-selecionado
|
||||
perform escolher-dialeto
|
||||
when ws77-mostrar-ajuda
|
||||
perform exibir-ajuda
|
||||
when ws77-fonte-entrada
|
||||
move ws02-arg-c to ws77-arquivo-entrada
|
||||
perform verificar-arquivo-entrada
|
||||
when ws77-modo-verboso
|
||||
set ws88-processo-verboso to true
|
||||
when ws77-exibir-versao
|
||||
perform exibir-versao
|
||||
when other
|
||||
perform exibir-ajuda
|
||||
end-evaluate
|
||||
else
|
||||
set ws88-valor to true
|
||||
end-if
|
||||
if ws88-switch
|
||||
evaluate ws02-arg-c
|
||||
when ws77-escolher-dialeto
|
||||
move ws02-arg-d to ws77-dialeto-selecionado
|
||||
perform escolher-dialeto
|
||||
when ws77-fonte-entrada
|
||||
move ws02-arg-d to ws77-arquivo-entrada
|
||||
perform verificar-arquivo-entrada
|
||||
when ws77-modo-verboso
|
||||
set ws88-processo-verboso to true
|
||||
when other
|
||||
perform exibir-ajuda
|
||||
end-evaluate
|
||||
else
|
||||
set ws88-switch to true
|
||||
end-if
|
||||
if ws88-continua-parsing
|
||||
if ws88-switch
|
||||
evaluate ws02-arg-d
|
||||
when ws77-modo-verboso
|
||||
set ws88-processo-verboso to true
|
||||
when ws77-fonte-entrada
|
||||
move ws02-arg-e to ws77-arquivo-entrada
|
||||
perform verificar-arquivo-entrada
|
||||
when ws77-fonte-saida
|
||||
move ws02-arg-e to ws77-arquivo-saida
|
||||
perform verificar-arquivo-saida
|
||||
when other
|
||||
perform exibir-ajuda
|
||||
end-evaluate
|
||||
else
|
||||
set ws88-switch to true
|
||||
end-if
|
||||
end-if
|
||||
if ws88-continua-parsing
|
||||
if ws88-switch
|
||||
evaluate ws02-arg-e
|
||||
when ws77-fonte-entrada
|
||||
move ws02-arg-f to ws77-arquivo-entrada
|
||||
perform verificar-arquivo-entrada
|
||||
when ws77-fonte-saida
|
||||
move ws02-arg-f to ws77-arquivo-saida
|
||||
perform verificar-arquivo-saida
|
||||
when other
|
||||
perform exibir-ajuda
|
||||
end-evaluate
|
||||
else
|
||||
set ws88-switch to true
|
||||
end-if
|
||||
end-if
|
||||
if ws88-continua-parsing
|
||||
if ws88-switch
|
||||
evaluate ws02-arg-f
|
||||
when ws77-fonte-entrada
|
||||
move ws02-arg-g to ws77-arquivo-entrada
|
||||
perform verificar-arquivo-entrada
|
||||
when ws77-fonte-saida
|
||||
move ws02-arg-g to ws77-arquivo-saida
|
||||
perform verificar-arquivo-saida
|
||||
when other
|
||||
perform exibir-ajuda
|
||||
end-evaluate
|
||||
else
|
||||
set ws88-switch to true
|
||||
end-if
|
||||
end-if
|
||||
if ws88-continua-parsing
|
||||
if ws88-switch
|
||||
evaluate ws02-arg-g
|
||||
when ws77-fonte-saida
|
||||
move ws02-arg-h to ws77-arquivo-saida
|
||||
perform verificar-arquivo-saida
|
||||
when other
|
||||
perform exibir-ajuda
|
||||
end-evaluate
|
||||
else
|
||||
set ws88-switch to true
|
||||
end-if
|
||||
end-if
|
||||
if ws77-dialeto-entrada equal spaces
|
||||
display "Erro na escolha do dialeto"
|
||||
perform finalizar
|
||||
else
|
||||
if ws88-processo-verboso
|
||||
evaluate true
|
||||
when ws88-microbase
|
||||
display "dialeto: Microbase COBOL"
|
||||
when ws88-microfocus
|
||||
display "dialeto: Microfocus COBOL"
|
||||
when ws88-rm
|
||||
display "dialeto: RM COBOL"
|
||||
when other
|
||||
display "Erro na escolha do dialeto"
|
||||
perform finalizar
|
||||
end-evaluate
|
||||
end-if
|
||||
end-if
|
||||
if ws77-arquivo-entrada equal spaces
|
||||
display "Não foi informado arquivo de entrada"
|
||||
perform finalizar
|
||||
else
|
||||
if ws88-processo-verboso
|
||||
move zeros to ws02-m
|
||||
perform varying ws02-m from 256 by -1 until
|
||||
ws77-arquivo-entrada(ws02-m:1) not equal spaces
|
||||
continue
|
||||
end-perform
|
||||
display "input: " ws77-arquivo-entrada(1:ws02-m)
|
||||
end-if
|
||||
end-if
|
||||
if ws77-arquivo-saida equal spaces
|
||||
display "Nao foi informado arquivo de saida"
|
||||
perform finalizar
|
||||
else
|
||||
if ws88-processo-verboso
|
||||
move zeros to ws02-m
|
||||
perform varying ws02-m from 256 by -1 until
|
||||
ws77-arquivo-saida(ws02-m:1) not equal spaces
|
||||
continue
|
||||
end-perform
|
||||
display "output: " ws77-arquivo-saida(1:ws02-m)
|
||||
end-if
|
||||
end-if
|
||||
.
|
||||
pre-processar-fonte.
|
||||
move ws77-arquivo-entrada
|
||||
to ws77-arquivo-intermediario
|
||||
perform varying ws02-i from 256 by -1
|
||||
until ws77-arquivo-intermediario(ws02-i:1)
|
||||
not equal spaces
|
||||
continue
|
||||
end-perform
|
||||
add 1 to ws02-i
|
||||
compute ws02-j = 256 - ws02-i
|
||||
move ".pre" to ws77-arquivo-intermediario(ws02-i:ws02-j)
|
||||
if ws88-processo-verboso
|
||||
add 4 to ws02-i
|
||||
display "Arquivo intermediario: "
|
||||
ws77-arquivo-intermediario(1:ws02-i)
|
||||
end-if
|
||||
open input arquivo-entrada
|
||||
if not ws88-ok
|
||||
perform testar-file-status
|
||||
end-if
|
||||
open output arquivo-intermediario
|
||||
perform until ws88-fim-arquivo
|
||||
read arquivo-entrada
|
||||
if not ws88-fim-arquivo
|
||||
move reg-arquivo-entrada
|
||||
to ws77-linha-para-parsing
|
||||
inspect ws77-linha-para-parsing
|
||||
converting ws02-minusculo
|
||||
to ws02-maiusculo
|
||||
move zeros to ws02-i
|
||||
inspect ws77-linha-para-parsing
|
||||
tallying ws02-i for all " COPY "
|
||||
if ws02-i > 0
|
||||
perform testes-copy
|
||||
else
|
||||
write reg-arquivo-intermediario
|
||||
from reg-arquivo-entrada
|
||||
end-if
|
||||
end-if
|
||||
end-perform
|
||||
close arquivo-entrada arquivo-intermediario
|
||||
move ws77-arquivo-intermediario to ws77-arquivo-entrada
|
||||
.
|
||||
finalizar.
|
||||
stop run
|
||||
.
|
||||
*****************************************************************
|
||||
* Procedures secundárias *
|
||||
*****************************************************************
|
||||
verificar-arquivo-entrada.
|
||||
set ws88-continua-parsing to true
|
||||
set ws88-valor to true
|
||||
open input arquivo-entrada
|
||||
if not ws88-ok
|
||||
perform testar-file-status
|
||||
end-if
|
||||
close arquivo-entrada
|
||||
.
|
||||
verificar-arquivo-saida.
|
||||
* Pegar o basename do fonte de entrada.
|
||||
perform varying ws02-i from 256 by -1
|
||||
until ws77-arquivo-entrada(ws02-i:1)
|
||||
not equal spaces
|
||||
continue
|
||||
end-perform
|
||||
* Descobrir o início da string(que pode estar terminado com
|
||||
* "/")
|
||||
perform varying ws02-j from ws02-i by -1
|
||||
until ws77-arquivo-entrada(ws02-j:1)
|
||||
equal "/" or ws02-j equal zeros
|
||||
continue
|
||||
end-perform
|
||||
if ws77-arquivo-entrada(ws02-j:1) equal "/"
|
||||
add 1 to ws02-j
|
||||
compute ws02-k = ws02-i - ws02-j
|
||||
add 1 to ws02-k
|
||||
move ws77-arquivo-entrada(ws02-j:ws02-k)
|
||||
to ws77-basename-entrada
|
||||
if ws88-processo-verboso
|
||||
display "input a: "
|
||||
ws77-arquivo-entrada(ws02-j:ws02-k)
|
||||
end-if
|
||||
else
|
||||
if ws88-processo-verboso
|
||||
perform varying ws02-i from 256 by -1
|
||||
until ws77-arquivo-entrada(ws02-i:1)
|
||||
not equal spaces or ws02-i equal zeros
|
||||
continue
|
||||
end-perform
|
||||
add 1 to ws02-i
|
||||
display "input b: " ws77-arquivo-entrada(1:ws02-i)
|
||||
end-if
|
||||
move ws77-arquivo-entrada to ws77-basename-entrada
|
||||
end-if
|
||||
|
||||
if ws77-arquivo-saida equal spaces
|
||||
display "Arquivo de saída não informado"
|
||||
perform finalizar
|
||||
end-if
|
||||
|
||||
* Pegar o basename do fonte de saída.
|
||||
perform varying ws02-l from 256 by -1
|
||||
until ws77-arquivo-saida(ws02-l:1)
|
||||
not equal spaces
|
||||
continue
|
||||
end-perform
|
||||
if ws88-processo-verboso
|
||||
display "ws02-l: " ws02-l
|
||||
end-if
|
||||
* Descobrir o início da string(que pode estar terminado com
|
||||
* "/")
|
||||
perform varying ws02-m from ws02-l by -1
|
||||
until ws77-arquivo-saida(ws02-m:1)
|
||||
equal "/" or ws02-m equal zeros
|
||||
continue
|
||||
end-perform
|
||||
if ws88-processo-verboso
|
||||
display "ws02-m: " ws02-m
|
||||
end-if
|
||||
if ws77-arquivo-saida(ws02-m:1) equal "/"
|
||||
add 1 to ws02-m
|
||||
compute ws02-n = ws02-l - ws02-m
|
||||
add 1 to ws02-n
|
||||
move ws77-arquivo-saida(ws02-m:ws02-n)
|
||||
to ws77-basename-saida
|
||||
if ws88-processo-verboso
|
||||
display "output a: "
|
||||
ws77-arquivo-saida(ws02-m:ws02-n)
|
||||
end-if
|
||||
else
|
||||
if ws88-processo-verboso
|
||||
perform varying ws02-i from 256 by -1
|
||||
until ws77-arquivo-saida(ws02-i:1)
|
||||
not equal spaces or ws02-i equal zeros
|
||||
continue
|
||||
end-perform
|
||||
add 1 to ws02-i
|
||||
display "output b: " ws77-arquivo-saida(1:ws02-i)
|
||||
end-if
|
||||
move ws77-arquivo-saida to ws77-basename-saida
|
||||
end-if
|
||||
|
||||
set ws88-finaliza-parsing to true
|
||||
set ws88-valor to true
|
||||
if ws77-basename-entrada equal ws77-basename-saida
|
||||
display "Arquivo de saída igual ao arquivo de entrada"
|
||||
perform finalizar
|
||||
end-if
|
||||
.
|
||||
escolher-dialeto.
|
||||
set ws88-valor to true
|
||||
evaluate ws77-dialeto-selecionado
|
||||
when "mb "
|
||||
set ws88-microbase to true
|
||||
when "mf "
|
||||
set ws88-microfocus to true
|
||||
when "rm "
|
||||
set ws88-rm to true
|
||||
when other
|
||||
display "Erro na escolha do dialeto"
|
||||
perform finalizar
|
||||
end-evaluate
|
||||
.
|
||||
testes-copy.
|
||||
move zeros to ws02-i
|
||||
inspect ws77-linha-para-parsing
|
||||
tallying ws02-i for characters
|
||||
before ' "'
|
||||
add 3 to ws02-i
|
||||
perform varying ws02-j from 256 by -1
|
||||
until ws77-linha-para-parsing(ws02-j:1)
|
||||
not equal spaces and "."
|
||||
continue
|
||||
end-perform
|
||||
compute ws02-k = ws02-j - ws02-i
|
||||
move "*" to reg-arquivo-entrada(7:1)
|
||||
write reg-arquivo-intermediario
|
||||
from reg-arquivo-entrada
|
||||
if ws88-processo-verboso
|
||||
display "Copybook: " reg-arquivo-entrada(ws02-i:ws02-k)
|
||||
end-if
|
||||
move reg-arquivo-entrada(ws02-i:ws02-k)
|
||||
to ws77-arquivo-intermediario2
|
||||
open input arquivo-intermediario2
|
||||
if not ws88-ok
|
||||
perform testar-file-status
|
||||
end-if
|
||||
perform until ws88-fim-arquivo
|
||||
read arquivo-intermediario2
|
||||
if not ws88-fim-arquivo
|
||||
write reg-arquivo-intermediario
|
||||
from reg-arquivo-intermediario2
|
||||
end-if
|
||||
end-perform
|
||||
close arquivo-intermediario2
|
||||
.
|
||||
exibir-versao.
|
||||
display "Conversor de fontes CBL2COB - alpha 0.0.2 (lançado e
|
||||
- "m 06/10/2003)"
|
||||
display "Copyright (C) 2003 Hudson Reis"
|
||||
perform finalizar
|
||||
.
|
||||
exibir-ajuda.
|
||||
display "Uso: cbl2cob <opcoes> <arquivo-entrada> [-o <arquiv
|
||||
- "o-saida>]"
|
||||
display "opções:"
|
||||
display " -d <mf/mb/rm> Escolhe dialeto"
|
||||
display " -h Mostra ajuda"
|
||||
display " -i <arquivo-entrada> Escolhe arquivo de entrada"
|
||||
display " -o <arquivo-saida> Escolhe arquivo de saida"
|
||||
display " -v Modo verboso"
|
||||
display " -V Mostra versão"
|
||||
perform finalizar
|
||||
.
|
||||
copy "globals.pd".
|
||||
@@ -0,0 +1,4 @@
|
||||
fd arquivo-entrada
|
||||
value of file-id is ws77-arquivo-entrada.
|
||||
01 reg-arquivo-entrada pic x(256).
|
||||
|
||||
@@ -0,0 +1,5 @@
|
||||
select arquivo-entrada assign to disk
|
||||
organization is line sequential
|
||||
access mode is sequential
|
||||
file status is ws77-file-status.
|
||||
|
||||
@@ -0,0 +1,10 @@
|
||||
* Arquivos de entrada e saída
|
||||
77 ws77-arquivo-entrada pic x(256) value spaces.
|
||||
77 ws77-arquivo-saida pic x(256) value spaces.
|
||||
77 ws77-arquivo-intermediario pic x(256) value spaces.
|
||||
77 ws77-arquivo-intermediario2 pic x(256) value spaces.
|
||||
* Variáveis para verificar se deve mostrar ou não alguma coisa.
|
||||
77 ws77-processo pic 9(001) value zeros.
|
||||
88 ws88-processo-nao-verboso value 0.
|
||||
88 ws88-processo-verboso value 1.
|
||||
|
||||
@@ -0,0 +1,12 @@
|
||||
testar-file-status.
|
||||
evaluate true
|
||||
when ws88-arquivo-inexistente
|
||||
display "Arquivo inexistente"
|
||||
when ws88-diretorio-inexistente
|
||||
display "Diretorio inexistente"
|
||||
when other
|
||||
display "Erro sem report: " ws77-file-status
|
||||
end-evaluate
|
||||
close arquivo-entrada arquivo-saida
|
||||
perform finalizar
|
||||
.
|
||||
@@ -0,0 +1,33 @@
|
||||
* Teste de file status.
|
||||
77 ws77-file-status pic x(002) value spaces.
|
||||
88 ws88-ok values are "00" "02" "04".
|
||||
88 ws88-diretorio-inexistente value "05".
|
||||
88 ws88-fim-arquivo value "10".
|
||||
88 ws88-inexiste-registro value "22".
|
||||
88 ws88-disco-cheio value "24".
|
||||
88 ws88-arquivo-inexistente value "35".
|
||||
88 ws88-layout-diferente value "39".
|
||||
88 ws88-arquivo-ja-aberto value "41".
|
||||
88 ws88-arquivo-nao-aberto values are "42" "47".
|
||||
88 ws88-arquivo-bloqueado value "9A".
|
||||
88 ws88-registro-bloqueado value "9D".
|
||||
88 ws88-indice-corrompido values are "9$" "9)" "9(".
|
||||
* Variáveis para serem usadas como contadores.
|
||||
01 ws01-contadores.
|
||||
02 ws02-i pic 9(003) value zeros.
|
||||
02 ws02-j pic 9(003) value zeros.
|
||||
02 ws02-k pic 9(003) value zeros.
|
||||
02 ws02-l pic 9(003) value zeros.
|
||||
02 ws02-m pic 9(003) value zeros.
|
||||
02 ws02-n pic 9(003) value zeros.
|
||||
02 ws02-o pic 9(003) value zeros.
|
||||
02 ws02-p pic 9(003) value zeros.
|
||||
02 ws02-q pic 9(003) value zeros.
|
||||
02 ws02-r pic 9(003) value zeros.
|
||||
02 ws02-s pic 9(003) value zeros.
|
||||
* Variável para determinar se continua ou não o parsing da
|
||||
* instrucao ou linha de comando.
|
||||
77 ws77-parsing pic 9(001) value zeros.
|
||||
88 ws88-continua-parsing value 0.
|
||||
88 ws88-finaliza-parsing value 1.
|
||||
|
||||
@@ -0,0 +1,8 @@
|
||||
fd arquivo-intermediario
|
||||
value of file-id is ws77-arquivo-intermediario.
|
||||
01 reg-arquivo-intermediario pic x(256).
|
||||
|
||||
fd arquivo-intermediario2
|
||||
value of file-id is ws77-arquivo-intermediario2.
|
||||
01 reg-arquivo-intermediario2 pic x(256).
|
||||
|
||||
@@ -0,0 +1,10 @@
|
||||
select arquivo-intermediario assign to disk
|
||||
organization is line sequential
|
||||
access mode is sequential
|
||||
file status is ws77-file-status.
|
||||
|
||||
select arquivo-intermediario2 assign to disk
|
||||
organization is line sequential
|
||||
access mode is sequential
|
||||
file status is ws77-file-status.
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,4 @@
|
||||
fd arquivo-saida
|
||||
value of file-id is ws77-arquivo-saida.
|
||||
01 reg-arquivo-saida pic x(256).
|
||||
|
||||
@@ -0,0 +1,5 @@
|
||||
select arquivo-saida assign to disk
|
||||
organization is line sequential
|
||||
access mode is sequential
|
||||
file status is ws77-file-status.
|
||||
|
||||
@@ -0,0 +1,222 @@
|
||||
# Projeto Infocont
|
||||
==================
|
||||
# Legenda deste TODO file
|
||||
-------------------------
|
||||
#: Tópico finalizado.
|
||||
o: Tópico em aberto p/ discussão.
|
||||
-: Tópico em desenvolvimento.
|
||||
|
||||
1. Se um tópico inicial tiver o sustenido(#), ele está finalizado para mim,
|
||||
Hudson, entretanto, aberto para opiniões de outras pessoas.
|
||||
|
||||
# cbl2cob.cob
|
||||
-------------
|
||||
- Estudar como fazer o parsing da linha de comando.
|
||||
- Usar verbo "unstring" ou "inspect" para fazer o parsing dos verbos
|
||||
com o inspect, mais trabalho de vetores, porém mais testes(embora
|
||||
generalizados). Com o unstring, menos trabalho de vetores, porém
|
||||
menos testes generalizados e mais código. Sugestão por ora é usar
|
||||
unstring.
|
||||
- Como converter um fonte?
|
||||
- Como quebrar as frases?
|
||||
- Unstring de uma variável indexando esta variável a uma matriz.
|
||||
ex: unstring ws77-var delimited by ' '
|
||||
into ws02-index(1) ws02-index(2) ws02-index(3)...
|
||||
end-unstring
|
||||
- O limite de indices é 65(Conforme desenvolvido pelo Daniel
|
||||
Mengarda - InfoCont Sistemas Integrados Ltda).
|
||||
- Como determinar o que modificar, vai ser apenas gerador, ou
|
||||
vai ser conversor?
|
||||
- Conversor: Converte(Modifica) frases já existentes.
|
||||
- Gerador: Gera novas frases a partir de frases existentes.
|
||||
- Acho que o cbl2cob terá as duas partes.
|
||||
- como traduzir uma frase?
|
||||
- Inspecionar a frase, para verificar se é necessário conversão
|
||||
ou geração, a partir de testes condicionais(verbo inspect).
|
||||
- Quebrar a frase, indexando os "pedaços" desta frase, para que
|
||||
possa ser lida ao ser feito um laço de repetição.
|
||||
(verbo unstring)
|
||||
- aonde pegar possíveis extensões do cobol?
|
||||
- qual verbo usar? inspect ou unstring, e quando?
|
||||
Inspect: Inspeção de frases.
|
||||
Unstring: Quebra de frases.
|
||||
- há mais verbos interessantes do que estes?
|
||||
Até o momento, não.
|
||||
- Distribuição.
|
||||
- Apenas um binário com várias bibliotecas embutidas dentro do binário.
|
||||
- Verificação dos arquivos
|
||||
- se existe arquivo de entrada ou não.
|
||||
- se pode criar arquivo de saída ou não.
|
||||
- Por último: Re-escrever o fonte.
|
||||
- comentar os itens.
|
||||
- otimizar os fontes, com procedures definidas.
|
||||
- definir ainda. É tudo imperativo, infinitivo ou o que?
|
||||
o Características do front-end.
|
||||
o Verifica se há switches erradas.
|
||||
o Verificação se há duplicação de arquivos(entrada e saída).
|
||||
o Verificação se há arquivo de entrada.
|
||||
o Pega variáveis com caminho absoluto ou caminho relativo
|
||||
o Tem a característica de separar o nome do arquivo do diretório
|
||||
(basename e path), sofistificação no front-end
|
||||
o As variáveis podem ser em qualquer tabulação
|
||||
o Tem características fixas:
|
||||
cbl2cob [opcoes] [-i arquivo de entrada] [-o arquivo de saida]
|
||||
o Switches de uso:
|
||||
o d: dialeto.
|
||||
o i: arquivo de entrada.
|
||||
o o: arquivo de saida.
|
||||
o v: saída verbosa.
|
||||
o V: versão.
|
||||
o h: ajuda.
|
||||
o Prepara switches para chamar o pré-processador.
|
||||
o Chama o pré-processador via call "system".
|
||||
o É chamado via call "system" para que o usuário possa escolher
|
||||
entre usar o pré-processador ou usar o front-end(que irá
|
||||
chamá-lo do mesmo jeito).
|
||||
o Há duas chamadas, uma para abrir os copybooks e outra para fechar os copy
|
||||
books.
|
||||
- Chama um scanner mediante o dialeto escolhido(dialeto+scanner.cob).
|
||||
(ex: mfscanner.cob) (Não implementado).
|
||||
- Chama um parser mediante o dialeto escolhido(dialeto+parser.cob)
|
||||
(ex: mfparser.cob) (Não implementado).
|
||||
|
||||
# cbl2cobpp.cob
|
||||
---------------
|
||||
- Pré-processador para processar os fontes.
|
||||
- Motivo: O verbo COPY permite que você insira um arquivo externo dentro
|
||||
de um programa fonte COBOL. Então, qual seria a melhor maneira
|
||||
de se converter um fonte desta maneira?
|
||||
- Idéias:
|
||||
Atualmente as possíveis idéias que me vieram, foram as seguintes:
|
||||
- Processar os copybooks individualmente, ou seja, o usuário
|
||||
os pré-processaria manualmente. Então quando o parser
|
||||
encontrasse uma linha com o verbo COPY, ele iria pular essa
|
||||
linha.
|
||||
- Quando o parser encontrasse uma linha com o verbo COPY, ele
|
||||
chamava um pré-processador, que abria o fonte, lia e o convertia.
|
||||
Seria chamada uma programa que faria isso, só iria ler e
|
||||
processar dados, mas seria um subprograma, então os dados
|
||||
iriam ser passados via linkage.
|
||||
- Seria criado um programa específico que iria criar um
|
||||
novo arquivo fonte COBOL, a partir de um arquivo fonte COBOL
|
||||
já existente, com algumas opções determinadas, como abertura
|
||||
ou fechamento de copybooks.
|
||||
Este programa seria separado e poderia ser chamado, ou via
|
||||
linha de comando ou pelo programa principal, através de
|
||||
uma chamada de sistema(Ou seja, os dados não seriam passados
|
||||
via linkage, mas por arquivos). A medida que fosse lendo
|
||||
o arquivo de entrada, ele iria gravando um arquivo de saída.
|
||||
Para os copybooks pré-processados, poderiam ser criados
|
||||
copybooks com o nome modificado, derivado do nome original.
|
||||
Acho esta a melhor decisão.
|
||||
- Poderia ser criado o programa fonte e seus copybooks, com um
|
||||
sufixo semelhante ao dialeto selecionado.
|
||||
ex: # fonte (arquivo de entrada e saida diferente)
|
||||
teste.cbl -> entrada
|
||||
teste.cob.mf -> intermediário
|
||||
teste.cob -> Saida
|
||||
|
||||
# copybook (mesmo arquivo de entrada e saída)
|
||||
header.cpy -> entrada
|
||||
header.cpy.mf -> intermediario
|
||||
header.cpy -> saida
|
||||
- Particularidades do COPY.
|
||||
- Armazenamentos
|
||||
- Diretório local/remoto e/ou diretório de variável de ambiente.
|
||||
- Características.
|
||||
- entre aspas: COPY "workfile.cpy". (Suporta apenas este por enquanto)
|
||||
- sem aspas: COPY workfile.cpy.
|
||||
- sem extensão: COPY workfile.
|
||||
- Pré-processamento.
|
||||
- Como processar os fontes, traduzir o código sempre para minusculo ou
|
||||
dar a oportunidade do usuário escolher?
|
||||
- Não haverá escolha de case. O programa fonte será modificado apenas
|
||||
aonde houver geração ou conversão de frases.
|
||||
- Ao encontrar um verbo COPY.
|
||||
- Descobrir que tipo de característica e armazenamento ele tem.
|
||||
- No arquivo de saída, criar uma linha comentada, desta maneira:
|
||||
(7)* Copybook <arquivo> - Abertura.
|
||||
(7)* Copybook <arquivo> - Fechamento.
|
||||
- Onde:
|
||||
(7). Col 7.
|
||||
<arquivo>. Nome do arquivo. Deve ser mantidos as características.
|
||||
Nesta etapa, o objetivo é só pré-processar mesmo.
|
||||
- Novos Copybooks. (Não suportado ainda, talvez não seja necessário).
|
||||
- Devem ter um sufixo que diga que o arquivo é convertido, talvez
|
||||
seja até interessante usar uma extensão. Ou então eles poderiam
|
||||
ter o mesmo nome do copybook inicial, mas apenas com uma letra
|
||||
ou item diferenciando.
|
||||
|
||||
# cblm2m
|
||||
--------
|
||||
o Conversor de case.
|
||||
o Motivo: Esta rotina, poderia ser um pequeno programa apenas. Entretanto,
|
||||
se um usuário quiser apenas mudar a case do seus fontes, ele teria que
|
||||
re-adaptar o programa. Então achei melhor criar um pequeno programa,
|
||||
com um pequeno front-end, que facilite a vida do usuário. Isso não
|
||||
mudaria em nada o conversor, uma vez que eu poderia chamar o programa
|
||||
via call "system" e o usuário nem notaria que isso aconteceu.
|
||||
o Idéias: Estava pensando nas seguintes idéias:
|
||||
o O conversor não deve mudar o valor da cláusula PROGRAM-ID ou
|
||||
END-PROGRAM.
|
||||
o O conversor não deve mudar os ítens entre aspas.
|
||||
o Conclusão: Após ter desenvolvido o aplicativo, concluí que a melhor maneira
|
||||
para se mudar a case de um arquivo seria, durante o processo de
|
||||
pré-processamento, criar uma variável intermediária, e nesta variável
|
||||
intermediária, mudá-la para uma case(maiúscula, por exemplo) a
|
||||
a nível de testes de condição.
|
||||
Se houver tempo, talvez melhore este conversor, entretanto não
|
||||
será minha prioridade por agora.
|
||||
|
||||
# Disclaimer
|
||||
o Criar disclaimer para o COBOL traduzido para o português.
|
||||
o Pegar no site da FSF ou conectiva o COPIA.pt_BR(COPYING) e a licença
|
||||
traduzida.
|
||||
o Seguir recomendações de Jorge Godoy e usar o disclaimer e o COPYING
|
||||
em inglês, devido a FSF não ter direitos legais no Brasil.
|
||||
|
||||
# Padronização
|
||||
# Identification division.
|
||||
o Não vou colocar date-compiled, installation e security pois não vejo
|
||||
necessidade. Seria interessante o uso do remarks, porém ele não faz
|
||||
parte do COBOL 85. Então irei colocar um comentário sobre isso depois
|
||||
do date-written.
|
||||
o Achei viável a criação do nome cob2tc. Pensei primeiro em mf2tc, mas
|
||||
achei melhor generalizar, pois assim poderíamos criar uma switch para
|
||||
determinar qual tipo de dialeto será o arquivo de entrada. (t=[ARG]).
|
||||
Depois pensei em cob2tc, o COB seria para o fonte COBOL de qualquer
|
||||
dialeto e o TC, seria para o TC. Inicialmente soa como se fosse só
|
||||
do TC, mas como o TC seguiria os standards, provavelmente não haveria
|
||||
problema em colocá-lo. Também poderiámos colocar o nome como cbl2cob,
|
||||
pois assim seria bem genérico. O CBL representaria o fonte COBOL em
|
||||
diversos dialetos e o COB representaria o fonte COBOL regido pelo
|
||||
standard. Entretanto isso seria apenas para colocar um nome intuitivo,
|
||||
mas o usuário poderá colocar o fonte com qualquer extensão. Acho melhor
|
||||
o cbl2cob.
|
||||
o O fonte será desenvolvido em formato fixo, pois quero que ele fique
|
||||
bem intuitivo. Então, irei usar comentários fixos (*) na coluna 7
|
||||
e comentários inline(*>) nas colunas posteriores a coluna 7. Será
|
||||
necessário então o uso da switch "-F" ao compilá-lo.
|
||||
# File section.
|
||||
o O tamanho do registro será de 256 posições. Estou seguindo como
|
||||
base a partir do gscreen e do scanner do TC(scan.c). Ou seria melhor
|
||||
colocar isso como uma switch do conversor? (s=[ARG]). Não concordo
|
||||
com a criação de uma switch, pois isso acarretaria a criação de uma
|
||||
série de perform's para fazer a leitura byte a byte do registro e
|
||||
poderia aumentar o tempo de conversão.
|
||||
# Prefixo para variáveis.
|
||||
o Prefixo inicial,
|
||||
o ws: working-storage section.
|
||||
o ss: screen section.
|
||||
o ls: linkage section.
|
||||
o Prefixo adicional,
|
||||
o Nivel da variável.
|
||||
o Nivel da variável,
|
||||
o Consecutivo: 01, 02, 03...
|
||||
# Verbos.
|
||||
o Indentação de 3 posicoes no perform.
|
||||
o Indentação de 4(ou 2) posicoes no evaluate.
|
||||
o Indentacao de 6 posicoes no when.
|
||||
o Indentacao de 2 posicoes no if.
|
||||
|
||||
|
||||
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.
|
||||
|
||||
|
||||
@@ -0,0 +1,475 @@
|
||||
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".
|
||||
@@ -0,0 +1,19 @@
|
||||
create table filial (
|
||||
codigo decimal(3,0),
|
||||
nome char(50),
|
||||
nome_fantasia char(40),
|
||||
endereco char(40),
|
||||
numero decimal(5,0),
|
||||
setor char(25),
|
||||
cidade char(25),
|
||||
uf char(02),
|
||||
cep char(08),
|
||||
foneddd char(04),
|
||||
fonenum char(08),
|
||||
faxddd char(04),
|
||||
faxnum char(08),
|
||||
cgc char(18),
|
||||
insest char(20),
|
||||
contato char(40)
|
||||
);
|
||||
|
||||
@@ -0,0 +1,215 @@
|
||||
Guia Tinycobol (Gnu) + PostgreSQL
|
||||
=====================================
|
||||
|
||||
Carlucio Lopes <carsanlo@terra.com.br>
|
||||
Goiania - Goias - Brasil
|
||||
InfoCont Sistemas Integrados - Adaptação para Windows
|
||||
Joinville - Santa Catarina - Brasil
|
||||
Versao 1.04 - Terca, 04 de Abril de 2006
|
||||
|
||||
|
||||
Resumo
|
||||
------
|
||||
|
||||
Este tutorial tem por objetivo ser uma referencia ao aprendizado no
|
||||
Tinycobol em ambiente Windows, utilizando PostgreSQL.
|
||||
Duvidas, criticas e sugestoes favor postar para grupo lista
|
||||
Clube Cobol em cobol@yahoogrupos.com.br.
|
||||
|
||||
Nota de Copyright
|
||||
-----------------
|
||||
|
||||
Copyleft (C) 2003 - Carlucio Lopes.
|
||||
|
||||
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 - O que e' o Tinycobol(TC)
|
||||
1.1 - Como compilar no Tinycobol
|
||||
2 - Instalando o Postgresql.
|
||||
3 - Compilando programa cad01.cob exemplo(TC+Postgresql)
|
||||
4 - Duvidas e Sugestoes.
|
||||
5 - Apendice
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
1 - O que e' o Tinycobol.
|
||||
|
||||
O TinyCOBOL e' um compilador COBOL free, criado por um brasileiro
|
||||
chamado Rildo Pragana e atualmente esta sendo desenvolvido por uma equipe de
|
||||
diversas partes do mundo (Europa/EUA). Por ser um compilador livre, nao e'
|
||||
necessario pagar para obter suas versoess. Para garantir a sua liberdade,
|
||||
o TinyCOBOL e' licenciado dentro dos termos da GNU ? General Public Licence,
|
||||
o que significa que seu codigo fonte e' livremente distribuido e disponivel em
|
||||
dominio publico. Suporta padrao ANSI 85.
|
||||
|
||||
1.1 - Como compilar no Tinycobol.
|
||||
|
||||
Apos a criacao do arquivo com o programa fonte, com extencao .cob, usa
|
||||
o comando htcobol que executa o compilador.
|
||||
|
||||
Usando: htcobol [opcoes] programa_fonte
|
||||
|
||||
Opcoes especificas do Compilador:
|
||||
-h Mostra ajuda
|
||||
-a Cria biblioteca estatica; pre-processa, compila, assembla e arquiva
|
||||
-B <modo> modo especifico para aglutinacao (estatica/dinamica)
|
||||
-c Compilacao para um modulo de objeto estaticamente linkado
|
||||
-E Saida do preprocessador para saida padrao apenas; nao compila,
|
||||
assembla ou linka
|
||||
-g Gera saida de debug de compilacao
|
||||
-l <arquivo> Adiciona biblioteca na linkedicao
|
||||
-L <diretorio> Adiciona diretorio ao caminho de procura de bibliotecas
|
||||
-m <arquivo> Cria biblioteca dinamica; pre-processa, compila, assembla e li
|
||||
-m <arquivo> Cria biblioteca dinamica; pre-processa, compila, assembla e linka
|
||||
-n Na~o executa nenhum comando, deve mostrar a compilacao
|
||||
-o <arquivo> Especifica nome do executavel (padrao de entrada x extensao)
|
||||
-S Preprocessa, compila(gera codigo assembler) somente; nao assembla ou
|
||||
linka
|
||||
-v Gera saida do compilador verbosa
|
||||
-V Mostra informacoes da versao do compilador e sai
|
||||
-Wl,<opcoes> Passar opcoes separadas por virgula ao linkeditor
|
||||
-x Compilacao para criar um executavel
|
||||
-z Gera saida do compilador verbosa
|
||||
Opcoes especificas do COBOL:
|
||||
-C Faz todas as chamadas dinamicas COBOL
|
||||
-D Inclui linhas de debug no fonte
|
||||
-F Fonte de entrada esta em formato de coluna fixa padrao
|
||||
-I <diretorio> Define inclusao(copybooks) de caminhos de procura. (padrao -I./)
|
||||
O caminho pode ser um simples diretorio, ou uma lista de diretorios
|
||||
separados por um ':'
|
||||
-P Gera arquivo de saida listado
|
||||
-T <num> <Expande tabs para um numero de espacos (padrao T=8)
|
||||
-X Arquivo de entrada esta em formato livre X/Open (formato padrao)
|
||||
|
||||
exemplo: htcobol -x -F -P prog_fonte.cob
|
||||
o exemplo acima o htcobol ira' compilar, (-x) criar executavel, (-F) programa
|
||||
escrito devera estar no formato fixo(obdecendo as colunas 8 e 12) e (-P) gera
|
||||
um arquivo de saida de erros e outras informacoes com extensao prog_fonte.lis .
|
||||
|
||||
|
||||
2 - Instalando o Postgresql.
|
||||
|
||||
2.1 Fazendo download.
|
||||
Baixe o Postgresql 8.1 para Windows (roda apenas em Windows XP/2000 - Partição NTFS)
|
||||
http://postgresql.org secao download -> Binários para Windows
|
||||
|
||||
2.2 Descompacte o arquivo postgresql-8.1.x-x.zip em uma pasta.
|
||||
|
||||
2.3 Execute a instalação através do arquivo postgresql-8.1.msi (Windows Installer)
|
||||
Durante a instalação será solicitada uma senha de acesso ao banco. Guarde esta senha, pois
|
||||
você terá de usa-la no item 3.3, para configurar os parâmetros de acesso ao banco.
|
||||
|
||||
2.4 Entendendo o PostgreSQL:
|
||||
O processo de instalação criará um grupo de programas chamado PostgreSQL, onde se encontram
|
||||
todas as ferramentas de administração e execução do banco de dados.
|
||||
Durante a instalação, será criado o banco POSTGRES, que utilizaremos neste tutorial.
|
||||
|
||||
2.5 Conectando ao banco POSTGRES
|
||||
No grupo de programas PostgreSQL existe um atalho denominado "psql para 'postgres'". Esta
|
||||
ferramenta é a que iremos utilizar para administrar o Banco de Dados.
|
||||
Esta ferramenta abrirá um prompt de comando, onde executaremos as intruções SQL.
|
||||
Para sair digite:
|
||||
postgres=# \q
|
||||
|
||||
3 - Compilando programa cad01.cob exemplo(TC+Postgresql).
|
||||
Este programa cad01.cob é um exemplo simples de uso do PostgreSQL através do TinyCOBOL.
|
||||
Trata-se de um pequeno cadastro de filiais.
|
||||
|
||||
3.1 compilando e gerando o executável de cad01.cob digite:
|
||||
htcobol -vCX cad01.cob
|
||||
|
||||
nota: Estamos usando a opção X para compilar o programa porque ele esta escrito em free
|
||||
format, sem o uso das margens características dos fontes COBOL.
|
||||
|
||||
Informacoes:
|
||||
- O TC suporta acesso a PostgreSQL via call's as API's do PgSQL atraves um
|
||||
wrapper(empacotador) criado pelo Rildo. Estas rotinas já se encontram devidamente
|
||||
compiladas e presentes no diretório C:\TinyCOBOL\bin.
|
||||
|
||||
3.2 Manutencao no banco de dados
|
||||
3.2.1 O programa cad01.cob faz acesso a uma tabela chamada "filial", que precisaremos cria-la
|
||||
antes de executar o programa. Para isso, acesse o programa "psql para 'postgres'" e
|
||||
digite as instruções abaixo:
|
||||
|
||||
create table filial (
|
||||
codigo decimal(3,0),
|
||||
nome char(50),
|
||||
nome_fantasia char(40),
|
||||
endereco char(40),
|
||||
numero decimal(5,0),
|
||||
setor char(25),
|
||||
cidade char(25),
|
||||
uf char(02),
|
||||
cep char(08),
|
||||
foneddd char(04),
|
||||
fonenum char(08),
|
||||
faxddd char(04),
|
||||
faxnum char(08),
|
||||
cgc char(18),
|
||||
insest char(20),
|
||||
contato char(40)
|
||||
);
|
||||
|
||||
3.2.2 Se você preferir, as instruções acima poderiam ser gravadas num arquivo texto
|
||||
(comando.sql, por exemplo) e poderiamos executa-lo posteriormente através do
|
||||
seguinte comando:
|
||||
|
||||
postgres=# \i c:/tinycobol/tutoriais/postgresql/comando.sql
|
||||
3.3 O banco de dados necessita de alguns parâmetros para possibilitar o acesso a mesmo.
|
||||
Estes parâmetros são definidos através de variáveis de ambiente, que serão lidas pela
|
||||
biblioteca de acesso ao banco (LIBPQ). Estas variáveis já estão preparadas no arquivo
|
||||
SETBANCO.BAT, que deverá ser executado antes do programa CAD01. Estas são as variáveis:
|
||||
set PGSQL_SERVER=127.0.0.1
|
||||
set PGSQL_USER=postgres
|
||||
set PGSQL_PASSWD=senha
|
||||
A variável PGSQL_SERVER indica o IP do servidor, onde 127.0.0.1 corresponde a localhost,
|
||||
ou seja, a máquina atual.
|
||||
A variável PGSQL_USER=postgres indica o usuário configurado para acesso ao banco. Altere-a
|
||||
se necessário.
|
||||
Já a variável PGSQL_PASSWD indica a senha configurada para acesso ao banco. Altere-a para
|
||||
a senha informada durante o processo de instalação.
|
||||
A configuração destes parâmetros é imprescindível para o correto funcionamento do programa.
|
||||
|
||||
|
||||
3.4 para executar o cadastro de filial digite:
|
||||
|
||||
cad01
|
||||
|
||||
Pronto voce tem um programa em Tinycobol+Postgresql, rodando no Windows.
|
||||
|
||||
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@yahoogrupos.com.br
|
||||
http://br.tinycobol.org
|
||||
http://wiki.tinycobol.org
|
||||
|
||||
4.2 Postgresql
|
||||
lista postgresql@yahoo.com.br
|
||||
http://www.postgresql.org
|
||||
http://www.postgresql.org.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 TinyCOBOL.
|
||||
- Hudson Reis<hudsonreis@gmx.net> pela empenho de tornar esta ferramenta produtiva.
|
||||
- Fernando Wuthstrack por acreditar e implementar o TC em sua Empresa.
|
||||
|
||||
10.2 Colaboradores
|
||||
- Carlucio Lopes
|
||||
- Rildo Pragana
|
||||
- Hudson Reis
|
||||
- Fernando Wuthstrack
|
||||
- Danilo Pacheco Martins
|
||||
- Walter Garrote
|
||||
@@ -0,0 +1,32 @@
|
||||
050-DISCONECTAR.
|
||||
call "sql_disconnect_db" using DB-HANDLE.
|
||||
|
||||
|
||||
conectar-template.
|
||||
move "template1" to nome-banco-dado.
|
||||
call "sql_connect_db" using
|
||||
nome-banco-dado DB-HANDLE DB-STATUS.
|
||||
if DB-STATUS not = zeros
|
||||
display "Erro na coneccao do banco de dados!"
|
||||
line 23 position 1
|
||||
stop run.
|
||||
|
||||
conectar-banco.
|
||||
call "sql_connect_db" using
|
||||
nome-banco-dado DB-HANDLE DB-STATUS.
|
||||
if DB-STATUS not = zeros
|
||||
display "Erro na coneccao do banco de dado!"
|
||||
line 24 position 01
|
||||
stop run.
|
||||
|
||||
faca-comando.
|
||||
call "sql_exec_query" using
|
||||
DB-HANDLE comando-sql QRY-HANDLE DB-STATUS.
|
||||
|
||||
200-CHECK-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.
|
||||
|
||||
@@ -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.
|
||||
|
||||
@@ -0,0 +1,3 @@
|
||||
set PGSQL_SERVER=127.0.0.1
|
||||
set PGSQL_USER=postgres
|
||||
set PGSQL_PASSWD=senha
|
||||
@@ -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.
|
||||
|
||||
|
||||
Binary file not shown.
Binary file not shown.
|
After Width: | Height: | Size: 482 B |
@@ -0,0 +1,260 @@
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. CADASTRO.
|
||||
AUTHOR. Infocont Sistemas Integrados(Danilo).
|
||||
DATE-WRITTEN. 13/10/04.
|
||||
SECURITY. *******************************************************
|
||||
* Cadastro de Clientes *
|
||||
*******************************************************
|
||||
ENVIRONMENT DIVISION.
|
||||
CONFIGURATION SECTION.
|
||||
SPECIAL-NAMES.
|
||||
DECIMAL-POINT IS COMMA.
|
||||
INPUT-OUTPUT SECTION.
|
||||
FILE-CONTROL.
|
||||
SELECT CADASTRO ASSIGN TO "cadastro.dat"
|
||||
ORGANIZATION IS INDEXED
|
||||
ACCESS MODE IS DYNAMIC
|
||||
RECORD KEY IS CAD-CHAVE
|
||||
FILE STATUS IS W77-RETCOD
|
||||
ALTERNATE RECORD KEY IS CAD-NOME
|
||||
WITH DUPLICATES.
|
||||
|
||||
DATA DIVISION.
|
||||
FILE SECTION.
|
||||
FD CADASTRO.
|
||||
01 CAD-PRINCIPAL.
|
||||
03 CAD-CHAVE.
|
||||
05 CAD-CODIGO PIC 9(04).
|
||||
03 CAD-NOME PIC X(40).
|
||||
03 CAD-ENDERECO PIC X(40).
|
||||
03 CAD-BAIRRO PIC X(25).
|
||||
03 CAD-CIDADE PIC X(25).
|
||||
03 CAD-UF PIC X(02).
|
||||
03 CAD-CEP PIC X(10).
|
||||
03 CAD-DDD PIC 9(04).
|
||||
03 CAD-FONE PIC X(09).
|
||||
03 CAD-FAX PIC X(09).
|
||||
|
||||
WORKING-STORAGE SECTION.
|
||||
01 VARIAVEL PIC X(01).
|
||||
01 VARIAVEIS-TCL.
|
||||
03 TCL-CODIGO PIC X(04).
|
||||
03 TCL-NOME PIC X(40).
|
||||
03 TCL-ENDERECO PIC X(40).
|
||||
03 TCL-BAIRRO PIC X(25).
|
||||
03 TCL-CIDADE PIC X(25).
|
||||
03 TCL-UF PIC X(02).
|
||||
03 TCL-CEP PIC X(10).
|
||||
03 TCL-DDD PIC X(04).
|
||||
03 TCL-FONE PIC X(09).
|
||||
03 TCL-FAX PIC X(09).
|
||||
03 TCL-OPCAO PIC X(03).
|
||||
88 TCL-GRAVA VALUE "gra".
|
||||
88 TCL-DELETA VALUE "del".
|
||||
88 TCL-SAI VALUE "sai".
|
||||
88 TCL-BUSCA VALUE "bus".
|
||||
88 TCL-ALTERA VALUE "alt".
|
||||
03 TCL-MENSAGEM PIC X(60).
|
||||
03 TCL-FOCUS PIC X(03).
|
||||
03 TCL-MENSAGEM2 PIC X(10).
|
||||
77 W77-ERRO PIC 9(01) VALUE ZEROS.
|
||||
88 W88-ERRO VALUE 1.
|
||||
77 W77-RETCOD PIC X(02) VALUE SPACES.
|
||||
88 W88-OK VALUE "00" "02" "04" "05".
|
||||
88 W88-CHAVE-DUPLICADA VALUE "22".
|
||||
88 W88-ARQUIVO-INEXISTE VALUE "35".
|
||||
88 W88-ARQUIVO-NAO-LIDO VALUE "43".
|
||||
77 NOME-PROGRAMA PIC X(64) VALUE "cadastro.tcl".
|
||||
01 W01-PARA PIC X(01).
|
||||
|
||||
PROCEDURE DIVISION.
|
||||
0000-PRINCIPAL SECTION.
|
||||
0000-INICIO.
|
||||
CALL "initTcl".
|
||||
0000-ABRE-CADASTRO.
|
||||
OPEN I-O CADASTRO.
|
||||
IF W88-ARQUIVO-INEXISTE
|
||||
OPEN OUTPUT CADASTRO
|
||||
CLOSE CADASTRO
|
||||
GO TO 0000-ABRE-CADASTRO.
|
||||
IF NOT W88-OK
|
||||
DISPLAY "ERRO ABERTURA"
|
||||
DISPLAY W77-RETCOD
|
||||
GO TO 0000-EXIT.
|
||||
INITIALIZE VARIAVEIS-TCL.
|
||||
MOVE "cod" TO TCL-FOCUS.
|
||||
0000-OPCAO.
|
||||
CALL "tcleval" USING VARIAVEIS-TCL NOME-PROGRAMA.
|
||||
MOVE SPACES TO TCL-MENSAGEM2.
|
||||
0000-FUNCAO.
|
||||
IF TCL-GRAVA
|
||||
PERFORM 1000-GRAVA.
|
||||
IF TCL-DELETA
|
||||
PERFORM 2000-DELETA.
|
||||
IF TCL-ALTERA
|
||||
PERFORM 3000-ALTERACAO.
|
||||
IF TCL-BUSCA
|
||||
PERFORM 4000-BUSCA
|
||||
IF W88-ERRO
|
||||
MOVE ZEROS TO W77-ERRO
|
||||
MOVE "err" TO TCL-OPCAO
|
||||
GO TO 0000-FUNCAO
|
||||
ELSE
|
||||
MOVE "cod" TO TCL-FOCUS
|
||||
MOVE SPACES TO TCL-OPCAO.
|
||||
IF TCL-SAI
|
||||
GO TO 0000-EXIT.
|
||||
IF W88-ERRO
|
||||
GO TO 0000-EXIT.
|
||||
GO TO 0000-OPCAO.
|
||||
0000-EXIT.
|
||||
STOP RUN.
|
||||
|
||||
1000-GRAVA SECTION.
|
||||
1000-INICIO.
|
||||
MOVE TCL-CODIGO TO CAD-CODIGO.
|
||||
MOVE TCL-NOME TO CAD-NOME.
|
||||
MOVE TCL-ENDERECO TO CAD-ENDERECO.
|
||||
MOVE TCL-BAIRRO TO CAD-BAIRRO.
|
||||
MOVE TCL-CIDADE TO CAD-CIDADE.
|
||||
MOVE TCL-UF TO CAD-UF.
|
||||
MOVE TCL-CEP TO CAD-CEP.
|
||||
MOVE TCL-DDD TO CAD-DDD.
|
||||
MOVE TCL-FONE TO CAD-FONE.
|
||||
MOVE TCL-FAX TO CAD-FAX.
|
||||
WRITE CAD-PRINCIPAL.
|
||||
IF W88-CHAVE-DUPLICADA
|
||||
REWRITE CAD-PRINCIPAL
|
||||
IF W88-ARQUIVO-NAO-LIDO
|
||||
READ CADASTRO
|
||||
MOVE TCL-NOME TO CAD-NOME
|
||||
MOVE TCL-ENDERECO TO CAD-ENDERECO
|
||||
MOVE TCL-BAIRRO TO CAD-BAIRRO
|
||||
MOVE TCL-CIDADE TO CAD-CIDADE
|
||||
MOVE TCL-UF TO CAD-UF
|
||||
MOVE TCL-CEP TO CAD-CEP
|
||||
MOVE TCL-DDD TO CAD-DDD
|
||||
MOVE TCL-FONE TO CAD-FONE
|
||||
MOVE TCL-FAX TO CAD-FAX
|
||||
REWRITE CAD-PRINCIPAL
|
||||
IF W88-OK
|
||||
INITIALIZE VARIAVEIS-TCL
|
||||
MOVE "ARQUIVO ATUALIZADO" TO TCL-MENSAGEM
|
||||
ELSE
|
||||
INITIALIZE VARIAVEIS-TCL
|
||||
MOVE W77-RETCOD TO TCL-MENSAGEM
|
||||
END-IF
|
||||
END-IF
|
||||
ELSE
|
||||
IF W88-OK
|
||||
INITIALIZE VARIAVEIS-TCL
|
||||
MOVE "CLIENTE CADASTRADO" TO TCL-MENSAGEM
|
||||
ELSE
|
||||
MOVE SPACES TO TCL-MENSAGEM
|
||||
STRING "OCORREU UM ERRO NA GRAVACAO ERRO:"
|
||||
DELIMITED BY SIZE
|
||||
W77-RETCOD DELIMITED BY SIZE
|
||||
INTO TCL-MENSAGEM
|
||||
MOVE 1 TO W77-ERRO.
|
||||
MOVE "cod" TO TCL-FOCUS.
|
||||
1000-EXIT.
|
||||
EXIT.
|
||||
|
||||
2000-DELETA SECTION.
|
||||
2000-INICIO.
|
||||
MOVE TCL-CODIGO TO CAD-CODIGO.
|
||||
READ CADASTRO.
|
||||
IF NOT W88-OK
|
||||
MOVE "CLIENTE NAO CADASTRADO" TO TCL-MENSAGEM
|
||||
MOVE "cod" TO TCL-FOCUS
|
||||
GO TO 2000-EXIT.
|
||||
DELETE CADASTRO.
|
||||
IF W88-OK
|
||||
INITIALIZE VARIAVEIS-TCL
|
||||
MOVE "CLIENTE EXCLUIDO" TO TCL-MENSAGEM
|
||||
ELSE
|
||||
MOVE 1 TO W77-ERRO
|
||||
GO TO 2000-EXIT.
|
||||
MOVE "cod" TO TCL-FOCUS.
|
||||
2000-EXIT.
|
||||
EXIT.
|
||||
|
||||
3000-ALTERACAO SECTION.
|
||||
3000-INICIO.
|
||||
MOVE TCL-CODIGO TO CAD-CODIGO.
|
||||
READ CADASTRO.
|
||||
IF NOT W88-OK
|
||||
MOVE "Gravacao" TO TCL-MENSAGEM2
|
||||
MOVE SPACES TO TCL-NOME
|
||||
MOVE SPACES TO TCL-ENDERECO
|
||||
MOVE SPACES TO TCL-BAIRRO
|
||||
MOVE SPACES TO TCL-CIDADE
|
||||
MOVE SPACES TO TCL-UF
|
||||
MOVE SPACES TO TCL-CEP
|
||||
MOVE SPACES TO TCL-DDD
|
||||
MOVE SPACES TO TCL-FONE
|
||||
MOVE SPACES TO TCL-FAX
|
||||
MOVE SPACES TO TCL-MENSAGEM
|
||||
GO TO 3000-EXIT
|
||||
ELSE
|
||||
MOVE "Alteracao" TO TCL-MENSAGEM2.
|
||||
MOVE CAD-NOME TO TCL-NOME.
|
||||
MOVE CAD-ENDERECO TO TCL-ENDERECO.
|
||||
MOVE CAD-BAIRRO TO TCL-BAIRRO.
|
||||
MOVE CAD-CIDADE TO TCL-CIDADE.
|
||||
MOVE CAD-UF TO TCL-UF.
|
||||
MOVE CAD-CEP TO TCL-CEP.
|
||||
MOVE CAD-DDD TO TCL-DDD.
|
||||
MOVE CAD-FONE TO TCL-FONE.
|
||||
MOVE CAD-FAX TO TCL-FAX.
|
||||
MOVE SPACES TO TCL-MENSAGEM.
|
||||
3000-EXIT.
|
||||
MOVE "nom" TO TCL-FOCUS.
|
||||
EXIT.
|
||||
|
||||
4000-BUSCA SECTION.
|
||||
4000-INICIO.
|
||||
MOVE SPACES TO CAD-NOME
|
||||
START CADASTRO KEY IS NOT LESS THAN CAD-NOME.
|
||||
4000-LE-PROXIMO-REGISTRO.
|
||||
READ CADASTRO NEXT.
|
||||
IF NOT W88-OK
|
||||
MOVE "ini" TO TCL-FOCUS
|
||||
MOVE "pri" TO TCL-OPCAO
|
||||
CALL "tcleval" USING VARIAVEIS-TCL NOME-PROGRAMA
|
||||
IF TCL-OPCAO NOT EQUAL "cer"
|
||||
MOVE 1 TO W77-ERRO
|
||||
MOVE SPACES TO TCL-OPCAO
|
||||
GO TO 4000-EXIT
|
||||
END-IF
|
||||
GO TO 4000-ACHA-REGISTRO.
|
||||
MOVE SPACES TO TCL-MENSAGEM
|
||||
STRING CAD-CODIGO DELIMITED BY SIZE
|
||||
" " DELIMITED BY SIZE
|
||||
CAD-NOME DELIMITED BY SIZE
|
||||
INTO TCL-MENSAGEM.
|
||||
MOVE "bus" TO TCL-OPCAO.
|
||||
MOVE SPACES TO TCL-FOCUS.
|
||||
CALL "tcleval" USING VARIAVEIS-TCL NOME-PROGRAMA.
|
||||
GO TO 4000-LE-PROXIMO-REGISTRO.
|
||||
4000-ACHA-REGISTRO.
|
||||
MOVE TCL-MENSAGEM (1:4) TO CAD-CODIGO.
|
||||
MOVE SPACES TO TCL-MENSAGEM.
|
||||
READ CADASTRO.
|
||||
IF NOT W88-OK
|
||||
display "nao achei"
|
||||
MOVE "Nao foi possivel localzar o registro"
|
||||
TO TCL-MENSAGEM
|
||||
GO TO 4000-EXIT.
|
||||
MOVE CAD-CODIGO TO TCL-CODIGO
|
||||
MOVE CAD-NOME TO TCL-NOME.
|
||||
MOVE CAD-ENDERECO TO TCL-ENDERECO.
|
||||
MOVE CAD-BAIRRO TO TCL-BAIRRO.
|
||||
MOVE CAD-CIDADE TO TCL-CIDADE.
|
||||
MOVE CAD-UF TO TCL-UF.
|
||||
MOVE CAD-CEP TO TCL-CEP.
|
||||
MOVE CAD-DDD TO TCL-DDD.
|
||||
MOVE CAD-FONE TO TCL-FONE.
|
||||
MOVE CAD-FAX TO TCL-FAX.
|
||||
4000-EXIT.
|
||||
EXIT.
|
||||
Binary file not shown.
Binary file not shown.
Binary file not shown.
@@ -0,0 +1,233 @@
|
||||
#!/bin/sh
|
||||
# \
|
||||
exec wish "$0" "$@"
|
||||
wm title . "Cadastro de Clientes"
|
||||
# Os dois comandos abaixo, servem para chamar os pacotes BWidget(ComboBox) \
|
||||
e Wcb(para definir limite de tamanho dos widgets entry), usados nesse tutorial.\
|
||||
OBS: entry: são os campos da tela, como ACCEPTs do Cobol.\
|
||||
widget: objetos de tela(ComboBox, Textos, entry etc)
|
||||
package require BWidget
|
||||
package require Wcb
|
||||
# O comando abaixo serve para definir que todos os compontes "entry" tenham fundo branco
|
||||
option add *Entry.background white
|
||||
# Como voce pode ver, todo componente deve receber um nome, atribuido logo depois da declaracao do componente, \
|
||||
precedido de um ponto (ex: label .nome_do_label)
|
||||
# Quando se coloca o caracter "\" no final da linha, significa que a linha abaixo, e' continuacao da linha atual
|
||||
# O comando abaixo, serve para criar um frame. Um frame serve para organizar melhor a sua janela, pois varios \
|
||||
componetes podem ser armazenados dentro dele, como se fossem filhos desse frame, conforme você exibe ele, \
|
||||
os widgets dentro dele, tambem sao exibidos, a opcao -bd define a largura de sua borda, e a opcao -relief \
|
||||
define o estilo de frame.
|
||||
frame .fr -bd 2 -relief groove
|
||||
frame .meio
|
||||
frame .fim -bd 2 -relief groove
|
||||
# o comando button, serve para criar um botao, e a palavra a seguir e' o nome do botao, no caso abaixo\
|
||||
o nome do botao e' .butgravar(nao se esquecendo do ponto no inicio), a opcao -image, define que imagem \
|
||||
o botao ira mostrar em seu rotulo, a opcao -command, define qual acao sera feita, apos ser clicado no \
|
||||
botao, no caso abaixo, a variavel tclopcao, sera carregada com o valor "gra", e logo em seguida fara o comando\
|
||||
do_exit, que faz com que o programa retorne ao Cobol(explicado mais detalhadamente no arquivo leia-me.txt)\
|
||||
OBS: para um botao que tenha no seu rotulo, epenas texto, voce substitui a opcao -image por -text e o \
|
||||
texto desejado
|
||||
button .butgravar -image [image create photo -file "gravarc.gif"] -command {set tclopcao gra ; do_exit}
|
||||
button .butdeletar -image [image create photo -file "excluirc.gif"] -command {set tclopcao del ; do_exit}
|
||||
button .butcancelar -image [image create photo -file "cancelac.gif"] -command {set tclcodigo "" ;\
|
||||
set tclnome "" ; set tclendereco "" ; set tclbairro "" ; set tclcidade "" ; set tclcep "" ;\
|
||||
set tclddd "" ; set tclfone "" ; set tclfax "" ; set tcluf SC ; focus .entcod}
|
||||
button .butbusca -image [image create photo -file "buscac.gif"] -command {set tclopcao bus ; \
|
||||
janela_busca ; do_exit}
|
||||
button .butsair -image [image create photo -file "sairc.gif"] -command {set tclopcao sai ; do_exit}
|
||||
button .butsobre -image [image create photo -file "sobrec.gif"] -command {janela_infocont}
|
||||
# o comando abaixo, serve para criar rotulos a serem exibidos na tela, grotescamente falando, e' semelhante ao\
|
||||
DISPLAY do Cobol, a opcao -textvariable, indica que o texto a ser exibido pelo label e' o valor que a variavel\
|
||||
indicada tem, conforme muda o valor da variavel, automaticamente, o texto exibido pelo label, tambem e' alterado,\
|
||||
no caso abaixo, o texto do label .labmensagem, tera o valor da variavel tclmensagem.
|
||||
label .labmensagem -textvariable tclmensagem
|
||||
label .mensagem2 -textvariable tclmensagem2
|
||||
# o comando "pack" e' uma forma de mostrar os componentes na tela, explicado mais detalhadamente no arquivo leia-me.txt
|
||||
pack .butgravar .butdeletar .butcancelar .butbusca .butsair .butsobre -in .fr -side left -fill both
|
||||
pack .labmensagem -in .fim -pady 5 -side left
|
||||
pack .mensagem2 -in .fim -pady 5 -side right
|
||||
pack .fr -side top -fill x
|
||||
pack .meio -side top -padx 10 -pady 10 -fill y -anchor nw
|
||||
pack .fim -side bottom -fill x -anchor nw
|
||||
|
||||
label .labcodigo -text "Codigo"
|
||||
label .labnome -text "Nome"
|
||||
label .labendereco -text "Endereco"
|
||||
label .labbairro -text "Bairro"
|
||||
label .labcidade -text "Cidade"
|
||||
label .labuf -text "UF"
|
||||
label .labcep -text "CEP"
|
||||
label .labddd -text "DDD"
|
||||
label .labfone -text "Telefone"
|
||||
label .labfax -text "FAX"
|
||||
# O comando abaixo serve para criar campos na tela(semelhante ao ACCEPT do Cobol), a opcao -textvariable, \
|
||||
tem a mesma funcao referente ao label, o valor exibido pelo entry e' o valor da variavel, conforme muda \
|
||||
o valor da variavel e' alterado o valor do entry, e vice-versa.
|
||||
entry .entcod -textvariable tclcodigo -width 5
|
||||
# O comando abaixo pertence ao pacote Wcb. Ele faz com que o componente indicado(no caso o .entcod), tenha no maximo o \
|
||||
numero de caracteres indicado(no caso, 5) e se os caracteres nao-numericos estao desativados(no caso esta desativado)
|
||||
wcb::callback .entcod before insert {wcb::checkEntryLen 5} wcb::checkEntryForInt
|
||||
entry .entnome -textvariable tclnome -width 40
|
||||
wcb::callback .entnome before insert {wcb::checkEntryLen 40}
|
||||
entry .entendereco -textvariable tclendereco -width 40
|
||||
wcb::callback .entendereco before insert {wcb::checkEntryLen 40}
|
||||
entry .entbairro -textvariable tclbairro -width 25
|
||||
wcb::callback .entbairro before insert {wcb::checkEntryLen 25}
|
||||
entry .entcidade -textvariable tclcidade -width 25
|
||||
wcb::callback .entcidade before insert {wcb::checkEntryLen 25}
|
||||
entry .entfocu -textvariable tclfocus
|
||||
entry .entopcao -textvariable tclopcao
|
||||
entry .entuf -textvariable tcluf
|
||||
# o componente abaixo pertence ao pacote BWidget, e' uma caixa de texto, com uma lista de opcoes, explicado\
|
||||
mais detalhadamente no arquivo leia-me.txt
|
||||
ComboBox .cbuf -width 8 -textvariable tcluf -entrybg white \
|
||||
-values {AC AL AP AM BA CE DF ES FN GO MS MA MT MG PA PB PR PE PI RN RS RJ RO RR SC SP SE TO}
|
||||
entry .entcep -textvariable tclcep -width 9
|
||||
wcb::callback .entcep before insert verifica_cep
|
||||
entry .entddd -textvariable tclddd -width 4
|
||||
wcb::callback .entddd before insert {wcb::checkEntryLen 4} wcb::checkEntryForInt
|
||||
entry .entfone -textvariable tclfone -width 8
|
||||
wcb::callback .entfone before insert {wcb::checkEntryLen 8} wcb::checkEntryForInt
|
||||
entry .entfax -textvariable tclfax -width 8
|
||||
wcb::callback .entfax before insert {wcb::checkEntryLen 8} wcb::checkEntryForInt
|
||||
# o comando "grid" e' um outro metodo de organizacao dos componentes, explicado melhor no arquivo leia-me.txt
|
||||
grid .labcodigo .entcod -in .meio -sticky w -pady 3
|
||||
grid .labnome .entnome -in .meio -sticky w -pady 3
|
||||
grid .labendereco .entendereco -in .meio -sticky w
|
||||
grid .labbairro .entbairro -in .meio -sticky w -pady 3
|
||||
grid .labcidade .entcidade -in .meio -sticky w
|
||||
grid .labuf .cbuf -in .meio -sticky w -pady 3
|
||||
grid .labcep .entcep -in .meio -sticky w
|
||||
grid .labddd .entddd -in .meio -sticky w -pady 3
|
||||
grid .labfone .entfone -in .meio -sticky w -pady 3
|
||||
grid .labfax .entfax -in .meio -sticky w -pady 3
|
||||
### Criando procedures
|
||||
### proc {valores} {corpo}
|
||||
### se voce quiser que a procedure receba mais de um valor, eles sao separados por espaco, \
|
||||
conforme o exemplo abaixo:
|
||||
### proc {valor1 valor2 valor3} {
|
||||
### set valor1 a
|
||||
### set valor2 b
|
||||
### set valor3 c
|
||||
### }
|
||||
|
||||
proc verifica_cep {comp idx str} {
|
||||
set texto [wcb::postInsertEntryText $comp $idx $str]
|
||||
set tamedit [string length $texto]
|
||||
set ::campo $comp
|
||||
regsub -all "::_" $::campo "" ::campo
|
||||
if {![regexp {^[0-9]?[0-9]?[0-9]?[0-9]?[0-9]?\.?[0-9]{0,3}?$} $texto]} {
|
||||
wcb::cancel
|
||||
} else {
|
||||
if {$tamedit == 6} {
|
||||
$comp insert end "."
|
||||
}
|
||||
if {$tamedit == 9} {
|
||||
tk::TabToWindow [tk_focusNext $::campo]
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
proc janela_busca {} {
|
||||
global tclopcao
|
||||
destroy .janbusca
|
||||
toplevel .janbusca -height 195 -width 325
|
||||
wm title .janbusca "Busca"
|
||||
wm transient .janbusca .
|
||||
listbox .janbusca.lista1 -background white -selectmode single -yscrollcommand {.janbusca.rolagem1 set}
|
||||
scrollbar .janbusca.rolagem1 -orient vertical -command {.janbusca.lista1 yview}
|
||||
label .janbusca.labtitulo -text "De dois clicks no item desejado"
|
||||
button .janbusca.butok -text "OK" -command {set tclmensagem \
|
||||
[.janbusca.lista1 get [.janbusca.lista1 curselection]] ; \
|
||||
set tclopcao cer ; do_exit ; destroy .janbusca}
|
||||
button .janbusca.butcan -text "Cancela" -command {destroy .janbusca; do_exit}
|
||||
place .janbusca.labtitulo -x 10 -y 10
|
||||
button .janbusca.sai -text "sai" -command {do_exit}
|
||||
place .janbusca.lista1 -x 10 -y 30 -height 120 -width 286
|
||||
place .janbusca.rolagem1 -x 294 -y 30 -height 120 -width 15
|
||||
place .janbusca.butok -x 10 -y 155 -width 70
|
||||
place .janbusca.butcan -x 85 -y 155 -width 70
|
||||
bind .janbusca.lista1 <Double-Button-1> {set tclmensagem [.janbusca.lista1 get [.janbusca.lista1 curselection]] ; \
|
||||
set tclopcao cer ; do_exit ; destroy .janbusca}
|
||||
}
|
||||
proc janela_infocont {} {
|
||||
destroy .janinfocont
|
||||
toplevel .janinfocont -height 370 -width 450
|
||||
wm maxsize .janinfocont 450 370
|
||||
wm title .janinfocont "Sobre"
|
||||
label .janinfocont.butinfocont -image [image create photo -file "infocont.gif"]
|
||||
label .janinfocont.lab1 -text "Pensando na crescente comunidade do TinyCobol no Brasil a InfoCont"
|
||||
label .janinfocont.lab2 -text "disponibiliza mais um tutorial sobre o uso deste otimo compilador."
|
||||
label .janinfocont.lab3 -text "Atraves da linguagem Tcl/Tk o TinyCobol se torna capaz de manipular"
|
||||
label .janinfocont.lab4 -text "telas graficas tanto em Linux quanto em Windows."
|
||||
label .janinfocont.lab5 -text "Neste tutorial pretendemos demonstrar a todos os interassados o uso"
|
||||
label .janinfocont.lab6 -text "desta nova tecnologia."
|
||||
label .janinfocont.lab7 -text "Desejamos a todos um otimo estudo!"
|
||||
label .janinfocont.lab8 -text "Viva o Software Livre!!!!!!!!"
|
||||
label .janinfocont.lab9 -text "Fernando Wuthstrack" -foreground blue
|
||||
label .janinfocont.lab10 -text "Danilo Pacheco Martins" -foreground blue
|
||||
place .janinfocont.butinfocont -x 15 -y 15
|
||||
place .janinfocont.lab1 -x 15 -y 120
|
||||
place .janinfocont.lab2 -x 15 -y 140
|
||||
place .janinfocont.lab3 -x 15 -y 160
|
||||
place .janinfocont.lab4 -x 15 -y 180
|
||||
place .janinfocont.lab5 -x 15 -y 200
|
||||
place .janinfocont.lab6 -x 15 -y 220
|
||||
place .janinfocont.lab7 -x 15 -y 240
|
||||
place .janinfocont.lab8 -x 15 -y 260
|
||||
place .janinfocont.lab9 -x 300 -y 310
|
||||
place .janinfocont.lab10 -x 300 -y 330
|
||||
}
|
||||
|
||||
proc var_cobol {} {
|
||||
global cobol_fields widget tclnumero0 tclnumero1
|
||||
set cobol_fields {
|
||||
tclcodigo 4
|
||||
tclnome 40
|
||||
tclendereco 40
|
||||
tclbairro 25
|
||||
tclcidade 25
|
||||
tcluf 2
|
||||
tclcep 10
|
||||
tclddd 4
|
||||
tclfone 9
|
||||
tclfax 9
|
||||
tclopcao 3
|
||||
tclmensagem 60
|
||||
tclfocus 3
|
||||
tclmensagem2 10
|
||||
}
|
||||
}
|
||||
|
||||
proc ::cobol_preprocess {args} {
|
||||
global tclopcao tclmensagem tclfocus
|
||||
switch $tclopcao {
|
||||
bus {.janbusca.lista1 insert end $tclmensagem
|
||||
do_exit}
|
||||
}
|
||||
switch $tclfocus {
|
||||
cod {focus .entcod}
|
||||
nom {focus .entnome}
|
||||
ini {focus .janbusca.butok; set tclfocus " "; set tclmensagem ""}
|
||||
}
|
||||
}
|
||||
# O comando "bind", tem por finalidade executar algum comando, conforme o evento solicidado, Ex: \
|
||||
bind .entcod <Return> {puts "voce pressionou enter"} \
|
||||
no caso acima o comando fara com que ao se pressionar "Enter" no componente ".entcod", seja exibido \
|
||||
na tela a frase "voce pressionou enter"
|
||||
# Esse comando abaixo passara o valor "alt" para a variavel tclopcao e depois ira para o cobol (do_exit), \
|
||||
quando o componente .entcod perder o foco(o cursor sair desse componente e ir para outro), isso se a \
|
||||
variavel tclopcao nao for igual a "bus" e nem "pri"
|
||||
bind .entcod <FocusOut> {
|
||||
if {$tclopcao != "bus" && $tclopcao != "pri"} {
|
||||
set tclopcao alt
|
||||
do_exit
|
||||
}
|
||||
}
|
||||
bind .cbuf <Escape> {focus .entcidade}
|
||||
bind Entry <FocusIn> {set [lindex [split [%W configure -textvariable] " "] 4] \
|
||||
[string trimright [%W get] " "] ; %W icursor 0 ; %W selection clear ; focus %W}
|
||||
bind all <Return> {tk::TabToWindow [tk_focusNext %W]}
|
||||
bind all <Escape> {tk::TabToWindow [tk_focusPrev %W]}
|
||||
var_cobol
|
||||
focus .entcod
|
||||
Binary file not shown.
|
After Width: | Height: | Size: 269 B |
Binary file not shown.
|
After Width: | Height: | Size: 711 B |
Binary file not shown.
|
After Width: | Height: | Size: 371 B |
Binary file not shown.
|
After Width: | Height: | Size: 4.1 KiB |
@@ -0,0 +1,670 @@
|
||||
Tutorial Tcl/Tk
|
||||
===========================================
|
||||
|
||||
Danilo Pacheco Martins <Danilo@infocont.com.br>
|
||||
Fernando Wuthstrack <fernando@infocont.com.br>
|
||||
|
||||
|
||||
Jueves, 21 de Enero del 2003
|
||||
|
||||
|
||||
|
||||
Resumen:
|
||||
=======
|
||||
|
||||
Este tutorial tiene como objetivo ser una referencia en el aprendizaje del uso
|
||||
de Tcl/Tk. Es una herramienta óptima para desarrollo gráfico y proporciona una
|
||||
gran ventaja al poder ser ejecutado en varias plataformas sin que sea necesario
|
||||
modificar los archivos fuentes.
|
||||
Dudas, críticas y sugerencias favor dirigirlas al e-mail:danilo@infocont.com.br.
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
Contenido:
|
||||
|
||||
1.- ¿Qué es Tcl/Tk?.
|
||||
2.- Conceptos básicos de Tcl/Tk.
|
||||
3.- Haciendo a Cobol "conversar" con Tcl/Tk.
|
||||
4.- Apéndice.
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
1.- ¿Qué es Tcl/Tk?.
|
||||
|
||||
Tcl (Tcl Command Language) es un lenguaje de scripts usado por medio millón
|
||||
de programadores alrededor del mundo y se ha tornado en un componente
|
||||
crítico en miles de corporaciones. Tiene una sintaxis simple y sus programas
|
||||
pueden ser usados como aplicaciones "standalone" o incrustadas (embedded) en
|
||||
otras aplicaciones.
|
||||
Lo mejor de todo es que Tcl es Open Source y por tanto completamente libre y
|
||||
gratis.
|
||||
Tk es un "toolkit" para crear interfaces gráficas de usuario, posibilitando
|
||||
así crear GUI's poderosas e increíblemente rápidas, al contrario de
|
||||
aplicaciones desarrolladas en otros lenguajes interpretados y hasta
|
||||
compilados. Ha probado ser tan popular que ahora está incorporado en todas
|
||||
las distribuciones Tcl.
|
||||
Tanto Tcl como Tk fueron desarrollados por John Ousterhout. Programadores
|
||||
del mundo entero han seguido el ejemplo y construyen sus propias extensiones
|
||||
de Tcl. Hay centenares de extensiones de Tcl para todas las necesidades de
|
||||
las aplicaciones. Tcl y Tk son altamente portátiles y son ejecutados en
|
||||
prácticamente todos los sabores de Unix, (Linux, Solaris, IRIX, AIX, *BSD*).
|
||||
No podemos dejar de decir que tienen soporte para Windows y Macintosh. Hay
|
||||
varias empresas que proveen binarios de precompiladores para varias
|
||||
plataformas.
|
||||
Tcl/Tk 8.3.4 era la versión estable para cuando se escribió este tutorial.
|
||||
Para esa versión fueron incluidas varias características que hacen de Tcl
|
||||
un lenguaje de scripts altamente recomendado para aplicaciones comerciales.
|
||||
Tcl/Tk 8.4a4 era la versión de desarrollo más reciente para cuando se
|
||||
escribió este documento. Tcl/Tk son Open Source y están en desarrollo
|
||||
continuo, entre los ingenieros de Scriptics (www.stripctics.com) y usuarios
|
||||
de la comunidad de Tcl. Striptics mantiene un repositorio CVS con el código
|
||||
fuente de Tcl/Tk. Todos pueden enviar adiciones y correcciones a ese código
|
||||
fuente de Tcl/Tk. En caso de que encuentre algún error en Tcl/Tk, usted
|
||||
podrá comunicarlo directamente a Scriptics utilizando un repositorio de Bugs.
|
||||
|
||||
1.1.- Tcl: Una plataforma de integración:
|
||||
|
||||
Hoy en día, uno de los grandes problemas enfrentados por los
|
||||
desarrolladores de soluciones es la diversidad de plataformas que
|
||||
pueden ser encontradas en las empresas. Tcl es llamado el programa
|
||||
para la integración de aplicaciones.
|
||||
Para proyectos, la plataforma de integración resulta
|
||||
estratégicamente importante en cuanto al Sistema Operativo y a los
|
||||
Bancos de Datos.
|
||||
Tcl es la mejor plataforma de integración debido a su velocidad,
|
||||
cantidad de funcionalidades y características para proyectos de
|
||||
desarrollo rápido como lineas de seguridad, internacionalización
|
||||
y comportamiento multiplataforma.
|
||||
La más reciente versión de Tcl provee todas las características para
|
||||
satisfacer las necesidades de cualquier proyecto e incluye toda la
|
||||
integración necesaria en un lenguaje de scripts.
|
||||
Los comentarios hechos arriba tienen como base el sitio web:
|
||||
http://tclbrasil.cipsga.org.br/tcltk.h
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
2.- Conceptos básicos de Tcl/Tk.
|
||||
|
||||
2.1.- VENTANA PRINCIPAL.
|
||||
|
||||
2.1.1.- Definiendo Título de la Ventana:
|
||||
wm title . "título de la ventana"
|
||||
|
||||
2.1.2.- Definiendo Tamaño de la Ventana:
|
||||
wm geometry . XXXxYYY
|
||||
|
||||
Ejemplo: wm geometry . 500x500
|
||||
|
||||
2.2.- VARIABLES.
|
||||
|
||||
2.2.1.- Declarando las Variables que vienen de Cobol:
|
||||
|
||||
Las variables recibidas de un programa Cobol tienen
|
||||
obligatoriamente que ser del tipo "string" y tener el mismo
|
||||
tamaño declarado en ambos (tanto en el programa en Cobol
|
||||
como en el script Tcl/Tk). La forma de pasar parámetros de
|
||||
Cobol a Tcl/Tk y viceversa será tratada más adelante. La
|
||||
siguiente declaración de grupo "cobol_fields" es obligatoria
|
||||
y no puede ser alterada:
|
||||
|
||||
set cobol_fiels {
|
||||
variable1 5
|
||||
variable2 25
|
||||
variable3 40
|
||||
}
|
||||
Observación: Un número par de nombres con su tamaño.
|
||||
|
||||
2.2.2.- Definiendo el valor de una Variable:
|
||||
|
||||
Para definir el valor de una variable deberá usar la
|
||||
siguiente sintaxis:
|
||||
|
||||
vnome set Jose
|
||||
|
||||
En este caso el valor "Jose" es insertado en la variable
|
||||
"vnome". El valor especificado _no_ requiere estar entre
|
||||
comillas dobles ("") a no ser que se quiera que el valor a
|
||||
insertar contenga _más_ de una palabra. Ej: "Jose Da Silva".
|
||||
|
||||
2.2.3.- Recibiendo el valor de una Variable:
|
||||
|
||||
Siempre que quiera recibir el valor de una variable, ésta
|
||||
tendrá que estar precedida por el signo dolar ($). Ej:
|
||||
|
||||
vnome1 set $vnome2
|
||||
|
||||
En este caso la variable "vnome1" recibirá el valor de la
|
||||
variable "vnome2".
|
||||
|
||||
|
||||
2.3.- INSERTANDO UNA CONDICIÓN:
|
||||
|
||||
|
||||
El comando "if" es utilizado para evaluar una condición pudiendo el
|
||||
resultado ser "verdadero" o "falso". En caso de que la condición sea
|
||||
verdadera se ejecutarán una serie de comandos, pero si es falsa, se
|
||||
ejecutarán entonces otros comandos, todo de acuerdo a lo definido
|
||||
por el programador.
|
||||
|
||||
Sintaxis:
|
||||
|
||||
if {condición1} [then] {cuerpo si verdadera} [else {cuerpo si falsa}
|
||||
[elseif {condición 2} {cuerpo}]]
|
||||
|
||||
donde:
|
||||
|
||||
{condición1}, es la primera condición a ser evaluada.
|
||||
[then], es opcional para la condición que será evaluada, es
|
||||
utilizado para indicar que es lo que será ejecutado en
|
||||
caso de que la condición sea verdadera.
|
||||
{cuerpo si verdadera}, comandos que serán ejecutados si la
|
||||
condición es verdadera.
|
||||
[else], es utilizado para indicar algo que deberá ser hecho si
|
||||
la condición es evaluada como falsa.
|
||||
{cuerpo si falso}, comandos que será ejecutados cuando la
|
||||
condición evaluada resulte falsa.
|
||||
[elseif], es utilizado para hacer una segunda verificación
|
||||
condicional dentro del mismo "if".
|
||||
{condición2}, es una segunda condición que será evaluada si
|
||||
existe el "elseif".
|
||||
{cuerpo}, lo mismo que "cuerpo si verdadera".
|
||||
|
||||
2.4.- INSERTANDO UNA RUTINA DE REPETICIÓN:
|
||||
|
||||
El comando "while" permitirá ejecutar una serie de comandos en caso
|
||||
de que la primera condición sea verdadera. Si se verifica que dicha
|
||||
condición es falsa, no será ejecutado ningún comando del cuerpo de
|
||||
la instrucción. Es semejante al PERFORM de Cobol.
|
||||
|
||||
Sintaxis:
|
||||
|
||||
while {condición} {cuerpo}
|
||||
|
||||
donde:
|
||||
|
||||
{condición}, será la condición verificada en cada "loop" o
|
||||
ciclo y que indicará si continua o no el lazo o
|
||||
bucle de repetición.
|
||||
{cuerpo}, son los comandos que deberán ser repetidos en cada
|
||||
"loop" (ciclo).
|
||||
|
||||
Ejemplo:
|
||||
|
||||
set var1 0
|
||||
while {$var1 < 10}
|
||||
incr var1
|
||||
}
|
||||
|
||||
2.5.- PROCEDIMIENTOS:
|
||||
|
||||
Es posible en Tcl crear Procedimientos (semejante a PERFORM en
|
||||
Cobol), con la siguiente sintaxis:
|
||||
|
||||
proc asigna_valor {a b c} {
|
||||
set valor1 a
|
||||
set valor2 b
|
||||
set valor3 c
|
||||
}
|
||||
|
||||
Una llamada al procedimiento anterior sería hecha de la siguiente
|
||||
manera:
|
||||
|
||||
asigna_valor vara varb varc
|
||||
|
||||
2.6.- BIND:
|
||||
|
||||
El comando "bind" es utilizado para asociar eventos del teclado o
|
||||
del mouse a objetos de Tk.
|
||||
|
||||
Ejemplo:
|
||||
|
||||
label .lab
|
||||
entry .entcodigo
|
||||
bind .entcodigo <FocusIn> {.lab configure -text "Ha ingresado
|
||||
al campo de código"}
|
||||
bind .entcodigo <FocusOut> {.lab configure -text "Ha salido
|
||||
del campo código"}
|
||||
|
||||
En este ejemplo, cuando el cursor entra en "entcodigo" o pasa sobre
|
||||
la etiqueta "lab", se mostrará el mensaje "Ha ingresado al campo
|
||||
código" y cuando el cursor sale de allí, se mostrará el mensaje "Ha
|
||||
salido del campo código".
|
||||
|
||||
2.7.- COMPONENTES TK:
|
||||
|
||||
Existen varios componentes de Tk. En nuestro tutorial usamos:
|
||||
"entry", "label", "button" y "listbox". Todo nombre atribuido a un
|
||||
componente debe ser precedido por un punto ".".
|
||||
|
||||
2.7.1.- LABEL:
|
||||
|
||||
Label es un componente de texto usado para mostrar textos
|
||||
(ej: identificación de campos). Grotescamente podría ser
|
||||
comparado con el DISPLAY de Cobol. La sintaxis para crear
|
||||
un "label" es la siguiente:
|
||||
|
||||
label nombre_del_label
|
||||
|
||||
Ejemplo:
|
||||
|
||||
label .codigo
|
||||
|
||||
En este caso se ha creado un "label" (etiqueta) con el
|
||||
nombre "codigo".
|
||||
Existen varias propiedades para un "label", como por
|
||||
ejemplo: -text, -foreground, -background, etc.
|
||||
|
||||
Ejemplo:
|
||||
|
||||
label .codigo -text "Código" -foreground blue
|
||||
-background white
|
||||
|
||||
En este caso el valor del [label] "codigo" será "Código" y
|
||||
estará escrito con letra de color azul con fondo blanco.
|
||||
|
||||
Observación: Si Usted quiere que el texto del "label"
|
||||
tenga más de una palabra, deberá encerrarlo
|
||||
entre comillas dobles (" "). Ejemplo:
|
||||
|
||||
-text "InfoCont Sistemas Integrados"
|
||||
|
||||
Para asociar la propiedad -text a una variable deberá
|
||||
declarar dicha variable de la siguiente manera:
|
||||
|
||||
-textvariable var
|
||||
|
||||
En este caso, siempre que la variable "var" cambie su valor
|
||||
el texto del "label" también será modificado.
|
||||
|
||||
2.7.2.- ENTRY:
|
||||
|
||||
Entry es un componente que permite atribuir valor y
|
||||
propiedades a texto introducido mediante teclado. Semejante
|
||||
a ACCEPT de Cobol.
|
||||
La sintaxis para crear un "entry" es como sigue:
|
||||
|
||||
entry nombre_del_entry
|
||||
|
||||
Ejemplo:
|
||||
|
||||
entry .direccion
|
||||
|
||||
Acá se ha creado un "entry" con el nombre "direccion".
|
||||
|
||||
Existen varias propiedades para un "entry" como: -text,
|
||||
-foreground, -background, etc.
|
||||
|
||||
Ejemplo:
|
||||
|
||||
entry .direccion -text "Domicilio" -foreground blue
|
||||
-background white
|
||||
|
||||
En este ejemplo el [entry] "direccion" actualizará el valor
|
||||
de la variable "Domicilio" cuyo texto lucirá con letra de
|
||||
color azul y fondo blanco.
|
||||
|
||||
2.7.3.- BUTTON:
|
||||
|
||||
Button es un componente que ejecuta un procedimiento cuando
|
||||
es accionado. Su sintaxis es como sigue:
|
||||
|
||||
button .nombre_del_botón
|
||||
|
||||
Ejemplo:
|
||||
|
||||
button .but
|
||||
|
||||
En este caso se está creando un botón con el nombre "but".
|
||||
Existen varias propiedades para un botón, así tenemos: -text
|
||||
-foreground, -background, -command, etc.
|
||||
|
||||
Ejemplo:
|
||||
|
||||
button .but -text "Salir" -foreground blue
|
||||
-command {exit}
|
||||
|
||||
Aquí, el rótulo (etiqueta) del botón "but" será "Salir" con
|
||||
letra azul y cerrará el panel (ventana) cuando sea pulsado.
|
||||
Si desea ejecutar más de un proceso cuando un botón es
|
||||
accionado deberá separar un proceso de otro mediante ";"
|
||||
(punto y coma).
|
||||
|
||||
2.7.4.- LISTBOX:
|
||||
|
||||
Es un componente que muestra una lista de items. La sintaxis
|
||||
para crear un "listbox" es la siguiente:
|
||||
|
||||
listbox .lista
|
||||
|
||||
En este caso se ha creado un "listbox" con el nombre "lista".
|
||||
Existen varias propiedades para un "listbox", así tenemos:
|
||||
-selectmode, -yscrollcommand, etc.
|
||||
|
||||
Ejemplo:
|
||||
|
||||
listbox .lista -selectmode browse -yscrollcommand
|
||||
{-rolagemv set}
|
||||
|
||||
En este ejemplo se ha definido el tipo de selección como
|
||||
"browse" y se asoció a una barra de desplazamiento vertical,
|
||||
la cual será usada cuando el número de items sea superior al
|
||||
tamaño físico del componente (vide scrollbar).
|
||||
|
||||
2.7.5.- SCROLLBAR:
|
||||
|
||||
Es un componente que sirve como barra de desplazamiento para
|
||||
otros componentes. Su sintaxis es:
|
||||
|
||||
scrollbar nombre_del_scrollbar
|
||||
|
||||
Existen varias propiedades para un "scrollbar", a saber:
|
||||
-orient y -command.
|
||||
|
||||
Ejemplo:
|
||||
|
||||
listbox .lista -selectmode browse -yscrollcommand
|
||||
{-rolagemv set}
|
||||
scrollbar .rolagemv -orient vertical -command
|
||||
{.lista view}
|
||||
|
||||
En este caso se crea una "listbox" y una "scrollbar", donde
|
||||
la "scrollbar" es vertical y se moverá hacia arriba y/o
|
||||
hacia abajo de la "lista" definida con el comando "listbox".
|
||||
|
||||
2.7.6.- TOPLEVEL:
|
||||
|
||||
Es un comando que crea una nueva ventana y responde a la
|
||||
siguiente sintaxis:
|
||||
|
||||
toplevel .nueva_ventana
|
||||
|
||||
Ejemplo:
|
||||
|
||||
toplevel .catastro
|
||||
|
||||
Con este comando se crea una nueva ventana de nombre
|
||||
"catastro". Para asignar la altura a la ventana se utiliza
|
||||
el parámetro "-height altura_ventana", y para especificar
|
||||
el ancho de la ventana se usa "-width ancho_ventana".
|
||||
Si quiere crear algún componente dentro de la ventana,
|
||||
deberá colocar el nombre de esta última antes del nombre
|
||||
del componente, por ejemplo:
|
||||
|
||||
button .catastro.but -text "Salir" -command {exit}
|
||||
|
||||
En este ejemplo se crea un botón llamado "but" dentro de la
|
||||
ventana llamada "catastro". El rótulo o título del botón
|
||||
será "Salir" y cuando sea presionado se procederá a terminar
|
||||
el programa.
|
||||
|
||||
2.7.7.- PLACE:
|
||||
|
||||
Es un comando cuya utilidad es la de posicionar objetos
|
||||
dentro de una ventana. Su sintaxis es como sigue:
|
||||
|
||||
place objeto -x pos_horz -y pos_vert -height alto
|
||||
-width ancho
|
||||
|
||||
Descripción de Parámetros:
|
||||
|
||||
-x : indica cuantos pixels horizontales abarcará el objeto.
|
||||
-y : " " " verticales " " " .
|
||||
-height : indica la altura del objeto en pixels.
|
||||
-width : " el ancho " " " " .
|
||||
|
||||
Ejemplo:
|
||||
|
||||
place .label -x 10 -y 15 -height 20 -width 170
|
||||
|
||||
En el ejemplo, el objeto "label" estará a 10 pixels del lado
|
||||
izquierdo y a 15 pixels del lado superior de la ventana
|
||||
creada y medirá 20 pixels de alto y 170 pixels de ancho.
|
||||
|
||||
2.9.- Paquete IWIDGETS:
|
||||
|
||||
El IWidget es una biblioteca que provee acceso a otros componentes,
|
||||
como: Combobox y EntryField (campos editados).
|
||||
Antes de utilizar un componente del paquete IWidgets tendrá que
|
||||
declarar que va a usar componentes de esa biblioteca; para hacer
|
||||
esto digite el siguiente comando:
|
||||
|
||||
package require Iwidgets
|
||||
iwidgets::tipo_de_componente nombre_del_componente
|
||||
|
||||
Recordando que todo componente debe ser precedido por un punto ".".
|
||||
En nuestro programa usamos dos componentes de IWidgets: combobox y
|
||||
entryfield.
|
||||
|
||||
2.9.1.- Componente IWidgets ENTRYFIELD:
|
||||
|
||||
Para insertar un "entryfield" deberá usar la siguiente
|
||||
sintaxis:
|
||||
|
||||
iwidgets::entryfield nombre_del_componente
|
||||
|
||||
En nuestro tutorial usamos las siguientes opciones para
|
||||
crear un "entryfield": -validate y -textvariable.
|
||||
La opción -validate es ejecutada cuando se pulsa cualquier
|
||||
tecla. En nuestro programa llamamos un procedimiento de la
|
||||
siguiente forma: -validate {verificacion %W "%c"}. En este
|
||||
caso se llamará al procedimiento "verificacion" partiendo
|
||||
del hecho de que "%W" es el nombre del componente y "%c" es
|
||||
el caracter que fué insertado (digitado).
|
||||
|
||||
2.9.2.- Componente IWidgets COMBOBOX:
|
||||
|
||||
Para insertar un "combobox" debe seguirse la siguiente
|
||||
sintaxis:
|
||||
|
||||
iwidgets::combobox nombre_del_componente
|
||||
|
||||
En nuestro tutorial usamos la opción -selection command,
|
||||
la cual disparará un comando cuando una opción sea
|
||||
seleccionada, Ejemplo:
|
||||
|
||||
-selection command {set tcluf "[.cbuf getcurselection]"}
|
||||
|
||||
En este caso, cuando una opción es seleccionada, la variable
|
||||
"tcluf" recibirá el valor del item seleccionado en el
|
||||
"combobox" (.cbuf).
|
||||
Para insertar un item al final de la lista del "combobox" se
|
||||
usa la siguiente sintaxis:
|
||||
|
||||
nombre_combobox insert list end item_a_ser_insertado
|
||||
|
||||
Ejemplo:
|
||||
|
||||
.cbuf insert list end Dom Lun Mar Mie Jue Vie Sab
|
||||
|
||||
Acá serán ingresados (agregados) los días de la semana. Para
|
||||
referenciar un item cuyo nombre tenga más de una palabra,
|
||||
deberá colocar su nombre entre comillas dobles (" ").
|
||||
Para definir un valor para un "combobox" deberá hacerse
|
||||
mediante el siguiente comando:
|
||||
|
||||
nombre_combobox selection set item
|
||||
|
||||
Ejemplo:
|
||||
|
||||
.cbuf selection set $tclsem
|
||||
|
||||
En este caso el valor definido para el "combobox" es la
|
||||
variable "tclsem" recordando que este item atribuido al
|
||||
"combobox" debe existir en la lista. En caso contrario se
|
||||
producirá un error, por ello debe tenerse cuidado cuando
|
||||
se asigna un item a una variable.
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
3.- Haciendo a Cobol "conversar" con Tcl.
|
||||
|
||||
3.1.- Trabajando con las variables en Cobol:
|
||||
|
||||
Las variables asociadas a Tcl/Tk deberán ser declaradas en el
|
||||
WORKING-STORAGE SECTION. Usted deberá declarar una variable de
|
||||
nivel 01 a la cual pertenecen las variables cuyos valores serán
|
||||
intercambiados. Los nombres de dichas variables quedan a su
|
||||
criterio. También será necesario declarar una variable de tipo
|
||||
COMP PIC 9(12) que servirá para contener la suma de los tamaños
|
||||
de las variables que serán intercambiadas Cobol <--> Tcl/Tk.
|
||||
Además será necesaria una variable más del tipo PIC X(64) que
|
||||
contendrá el nombre del programa(script) en Tcl/Tk.
|
||||
A continuación un ejemplo:
|
||||
|
||||
01 VARIABLES-TCL.
|
||||
03 TCL-CODIGO PIC X(04).
|
||||
03 TCL-NOMBRE PIC X(40).
|
||||
03 TCL-DIRECCION PIC X(40).
|
||||
01 SUMA-VARIABLES COMP PIC 9(12).
|
||||
01 NOMBRE-VENTANA PIC X(64).
|
||||
|
||||
En este ejemplo declaramos la variable "VARIABLES-TCL" en la cual
|
||||
están incluidas todas las variables que Tcl/Tk usará. Es
|
||||
imprescindible que el tamaño de las variables de Cobol sea el mismo
|
||||
que el de las variables declaradas en Tcl/Tk, siendo estas últimas
|
||||
obligatoriamente alfanuméricas (PIC X) debido a que Tcl/Tk no
|
||||
permite declarar campos numéricos.
|
||||
Luego declaramos la variable "SUMA-VARIABLES" cuyo contenido
|
||||
corresponderá a la suma de los tamaños de las variables declaradas
|
||||
en el grupo "VARIABLES-TCL".
|
||||
En el ejemplo de arriba, esta variable tendrá un valor igual a 84 el
|
||||
cual procede de (4 + 40 + 40 = 84).
|
||||
Posteriormente declaramos la variable "NOMBRE-VENTANA" que contendrá
|
||||
el nombre del programa (script Tcl/Tk) que será llamado.
|
||||
Digamos que hacemos un script para manejar una ventana y le damos el
|
||||
nombre de "catastro.tcl", entonces la variable "NOMBRE-VENTANA"
|
||||
recibirá ese mismo valor (catastro.tcl).
|
||||
Vea el punto siguiente (3.2.-) para conocer como son usadas las
|
||||
variables aquí definidas.
|
||||
|
||||
3.2.- Invocando a una Ventana:
|
||||
|
||||
Antes que todo Usted tendrá que llamar al programa "initTcl" el cual
|
||||
inicializa el ambiente gráfico. Esto debe hacerse al comienzo del
|
||||
programa, antes de cualquier rutina.
|
||||
La llamada a la ventana (Tcl/Tk) es hecha a través de la rutina
|
||||
"chamatcl", que es un programa escrito en lenguaje C (chamatcl.c),
|
||||
el cual posee un interpretador de scripts Tcl/Tk. El es el
|
||||
responsable de mostrar la ventana y de trasladar los contenidos de
|
||||
las variables desde Cobol a Tcl/Tk y viceversa.
|
||||
Para mostrar una ventana deberá ejecutar el programa "chamatcl"
|
||||
mediante la sentencia CALL acompañada de las variables definidas
|
||||
bajo "VARIABLES-TCL", que son los campos que se intercambian entre
|
||||
Cobol y Tcl/Tk. La variable "SUMA-VARIABLES", que contiene la suma
|
||||
de los tamaños de las variables de intercambio y la variable
|
||||
"NOMBRE-VENTANA", que contiene el nombre del archivo script Tcl/Tk
|
||||
que será llamado.
|
||||
Usando el mismo ejemplo anterior (3.1.-):
|
||||
|
||||
01 VARIABLES-TCL.
|
||||
03 TCL-CODIGO PIC X(04).
|
||||
03 TCL-NOMBRE PIC X(40).
|
||||
03 TCL-DIRECCION PIC X(40).
|
||||
01 SUMA-VARIABLES COMP PIC 9(12).
|
||||
01 NOMBRE-VENTANA PIC X(64).
|
||||
|
||||
Digamos que la ventana que Usted quiere invocar se llama
|
||||
"catastro.tcl", entonces en Cobol haríamos de la siguiente manera:
|
||||
|
||||
MOVE 84 TO SUMA-VARIABLES.
|
||||
MOVE "catastro.tcl" TO NOMBRE-VENTANA.
|
||||
CALL "chamatcl" USING VARIABLES-TCL SUMA-VARIABLES
|
||||
NOMBRE-VENTANA.
|
||||
|
||||
Esto funciona así, cuando la sentencia CALL es ejecutada, ésta llama
|
||||
al programa(script) de Tcl/Tk "catastro.tcl" en el cual las variables
|
||||
"cobol_fields" reciben los valores de las variables definidas en
|
||||
Cobol ("VARIABLES-TCL").
|
||||
|
||||
3.3.- Regresando a Cobol:
|
||||
|
||||
Retornar a Cobol desde Tcl/Tk es muy simple, solo tiene que ejecutar
|
||||
el comando "do_exit". Haciendo esto cerrará la ventana abierta por
|
||||
Tcl/Tk moviendo las variables de "cobol_fields" a las variables de
|
||||
Cobol conforme se declararon en el WORKING-STORAGE SECTION. Aquí Ud.
|
||||
debe elaborar una rutina para que Cobol reciba los valores y retorne
|
||||
a llamar nuevamente al programa (script) en Tcl/Tk para mostrar los
|
||||
nuevos valores de las variables una vez éstos han sido procesados.
|
||||
|
||||
3.4.- ¿Cómo funciona el programa Cobol ejemplo de este Tutorial?:
|
||||
|
||||
En el ejemplo de nuestro tutorial ("catastro.cob") tenemos una
|
||||
variable declarada con el nombre "TCL-OPCION" con la correspondiente
|
||||
"tclopcion" en Tcl/Tk ("catastro.tcl").
|
||||
El programa Cobol llama al programa Tcl/Tk a través de "chamatcl"
|
||||
para mostrar la ventana. Cuando se pulsa algún botón o se quita el
|
||||
foco del campo "Código", se le atribuye una acción a la variable
|
||||
"tclopcion" y se ejecuta el comando "do_exit". Este comando hace que
|
||||
se retorne al programa en Cobol recibiendo en el proceso el
|
||||
contenido de las variables que vienen del script Tcl/Tk. El programa
|
||||
Cobol lee la variable "TCL-OPCION" y ejecuta la rutina
|
||||
correspondiente en base al valor de ésta, retornando luego al script
|
||||
Tcl/Tk para mostrar la ventana nuevamente.
|
||||
En el programa Cobol encontramos en el WORKING-STORAGE SECTION a la
|
||||
variable "SUMA-VARIABLES" con un valor preasignado de "234", que es
|
||||
el resultado de la suma de los tamaños de las variables que se
|
||||
intercambian y a la variable "NOMBRE-VENTANA" con un valor
|
||||
preasignado igual a "catastro.tcl" que es el nombre del programa
|
||||
(script) en Tcl/Tk.
|
||||
Al inicio del programa Cobol ejecutamos la sentencia CALL "initTcl"
|
||||
que nos servirá para inicializar el ambiente gráfico.
|
||||
Antes de llamar a la ventana objeto de este ejemplo por primera vez,
|
||||
inicializamos las variables que serán usadas para intercambiar datos
|
||||
entre Cobol y Tcl/Tk con el objetivo de que la ventana muestre los
|
||||
campos vacíos.
|
||||
Como las variables "SUMA-VARIABLES" y "NOMBRE-VENTANA" tienen sus
|
||||
valores preasignados, llamamos a la ventana de la siguiente forma:
|
||||
|
||||
CALL "chamatcl" USING VARIABLES-TCL SUMA-VARIABLES NOMBRE-VENTANA.
|
||||
|
||||
Esta sentencia invocará al programa(script) "catastro.tcl", el cual
|
||||
nos permitirá manipular la ventana.
|
||||
Digamos que un Usuario quiere grabar un registro, entonces primero
|
||||
rellenará los campos de datos y luego pulsará el botón "GRABAR".
|
||||
Cuando hace esto el script Tcl/Tk asignará el valor "gra" a la
|
||||
variable "tclopcion" y ejecutará el comando "do_exit"
|
||||
|
||||
(-command {set tclopcion gra ; exit})
|
||||
|
||||
lo cual hará que el procesamiento retorne al programa Cobol con los
|
||||
nuevos valores de las variables.
|
||||
Ya en Cobol, se leerá la variable "TCL-OPCION" la cual tendrá el
|
||||
valor "gra" y se ejecutará un PERFORM a la rutina "1000-GRABAR",
|
||||
donde los valores de las variables recibidas de Tcl/Tk serán movidas
|
||||
al archivo FD "CATASTRO" efectuando luego la grabación del
|
||||
registro.
|
||||
A continuación la secuencia del programa inicializará las variables
|
||||
(que van al script Tcl/Tk), asignará un mensaje de texto a la
|
||||
variable "TCL-MENSAJE" describiendo el resultado del proceso de
|
||||
grabación y saldrá de la rutina retornando al programa(script) en
|
||||
Tcl/Tk. La ventana será mostrada con los nuevos valores venidos de
|
||||
Cobol.
|
||||
En el script Tcl/Tk hay una etiqueta que está vinculada a la
|
||||
variables "tclmensaje" la cual será actualizada en cada retorno
|
||||
mostrando al Usuario el resultado de la acción.
|
||||
En resúmen, Cobol llama a Tcl/Tk, el Usuario modifica los valores
|
||||
de las variables escribiendo sobre los campos en la ventana y luego
|
||||
el control retorna al programa en Cobol. En este punto el programa
|
||||
en Cobol identifica el deseo del Usuario y a continuación ejecuta el
|
||||
proceso correspondiente retornando luego al programa(Script) Tcl/Tk.
|
||||
|
||||
--------------------------------------------------------------------------------------
|
||||
|
||||
4 - Apéndice.
|
||||
|
||||
4.1 - Agradecimientos.
|
||||
|
||||
- Carlucio Lopes<carsanlo@terra.com.br> que, mediante su tutorial, nos
|
||||
permitió dar los primeros pasos con Tcl/Tk;
|
||||
- Rildo Pragana<rildo@pragana.net> por los primeros ejemplos con Tcl/Tk y con
|
||||
TinyCobol y por la paciencia en ayudarnos a superar algunas barreras
|
||||
encontradas;
|
||||
- John Ousterhout por crear el lenguaje Tcl y el toolkit gráfico TK.
|
||||
- A Wesley R. Braga, creador del sitio tclbrasil.cipsga.org.br
|
||||
|
||||
4.2 Colaboradores.
|
||||
|
||||
- Danilo Pacheco Martins
|
||||
- Fernando Wuthstrack
|
||||
- Carlucio Lopes
|
||||
- Rildo Pragana
|
||||
- Wesley R. Braga
|
||||
|
||||
@@ -0,0 +1,479 @@
|
||||
Tutorial Tcl/Tk
|
||||
=====================================
|
||||
|
||||
Danilo Pacheco Martins <Danilo@infocont.com.br>
|
||||
Fernando Wuthstrack <fernando@infocont.com.br>
|
||||
|
||||
Quinta, 27 de maio de 2006
|
||||
|
||||
|
||||
Resumo
|
||||
------
|
||||
|
||||
Este tutorial tem por objetivo ser uma referencia ao aprendizado no uso do
|
||||
Tcl/Tk. E uma otima ferramenta para desenvolvimento grafico, e a sua grande
|
||||
vantagem de rodar em varias plataformas, sem que seja preciso mudar seu fonte.
|
||||
Duvidas, criticas e sugestoes favor postar para o e-mail: danilo@infocont.com.br
|
||||
--------------------------------------------------------------------------------------
|
||||
|
||||
Conteudo
|
||||
--------
|
||||
1 - O que e Tcl/Tk.
|
||||
2 - Conceitos basicos do Tcl/Tk.
|
||||
3 - Fazendo o Cobol "conversar" com o Tcl/TK.
|
||||
4 - Instalando o Tcl/TK no Windows.
|
||||
5 - Compilando o programa cadastro.cob.
|
||||
6 - Duvidas.
|
||||
7 - Apendice.
|
||||
|
||||
--------------------------------------------------------------------------------------
|
||||
1 - O que e Tcl/Tk
|
||||
|
||||
Tcl (Tool Command Language) e uma linguagem de script usada por meio milhao de
|
||||
programadores ao redor do mundo e se tornou um componente critico em milhares de
|
||||
corporacoes. Ele tem uma sintaxe simples e programavel e pode ser usado como uma
|
||||
aplicacao standalone ou embutida em outras aplicacoes. O melhor de tudo, e que o Tcl
|
||||
e Open Source e completamente gratis.
|
||||
|
||||
Tk e um toolkit para criacao de interface graficas com o usuario, possibilitando assim
|
||||
criar GUIs poderosas e inacreditavel mente rapidas, ao contrario de aplicacoes
|
||||
desenvolvidas em outras linguagens Interpretadas ou ate mesmo pre compiladas.
|
||||
Provou-se tao popular que agora vem em todas as distribuicoes do Tcl.
|
||||
|
||||
Tanto o Tcl como o Tk foram desenvolvidos por John Ousterhout. Programadores seguiram
|
||||
o exemplo dele no mundo inteiro e construiram as proprias extensoes de Tcl. Hoje, ha
|
||||
centenas de extensoes do Tcl para todas as necessidades de aplicacoes.
|
||||
|
||||
Tcl e Tk sao altamente portateis e sao executadas praticamente todos os sabores de
|
||||
Unix, (Linux, Solaris, IRIX, AIX, *BSD *), nao podemos deixar de falar que ha suporte
|
||||
para o Windows e Macintosh. Ha varios locais que proveem binarios de precompiladores
|
||||
para varias plataformas.
|
||||
|
||||
Tcl e Tk sao Open Source e o desenvolvimento continuo dele e feito com a colaboracao
|
||||
dos engenheiros da Scriptics (www.scriptics.com) e usuario da comunidade Tcl. A
|
||||
Scriptics mantem um repositorio de CVS para o codigo fonte.
|
||||
|
||||
Todos podem enviar mudancas e correcoes ao codigo fonte do Tcl/TK. Caso seja
|
||||
encontrado algum erro no Tcl/TK voce podera comunica-lo diretamente a Scriptics
|
||||
utilizando o relatorio de Bugs.
|
||||
|
||||
1.1 - Tcl: A Plataforma de Integracao
|
||||
|
||||
Hoje em dia um dos grandes problemas enfrentado pelos desenvolvedores de solucoes e
|
||||
a diversidade de plataformas que poderao ser encontradas nas empresas. O Tcl e chamado
|
||||
de programacao de aplicacoes para integracao.
|
||||
Para empreendimentos, a plataforma de integracao esta ficando tao estrategicamente
|
||||
importante quanto o Sistema Operacional e os bancos de dados.
|
||||
Tcl e a melhor plataforma de integracao por causa de sua velocidade de uso, largura de
|
||||
funcionalidade, e caracteristicas para empreendimento prontas como linha-seguranca,
|
||||
internacionalizacao e desenvolvimento multiplataforma.
|
||||
|
||||
O comentario acima foi feito com base no Site: http://tclbrasil.cipsga.org.br/tcltk.htm
|
||||
--------------------------------------------------------------------------------------
|
||||
|
||||
2 - Conceitos basicos do Tcl/Tk.
|
||||
|
||||
2.1 - Janela principal.
|
||||
|
||||
2.1.1 Definindo titulo da janela.
|
||||
wm title . "Titulo da Janela"
|
||||
|
||||
2.1.2 Definindo tamanho da janela.
|
||||
wm geometry . XXXxYYY
|
||||
Ex: wm geometry . 500x500
|
||||
|
||||
2.2 - Variaveis
|
||||
|
||||
2.2.1 Declarando as variaveis do Cobol.
|
||||
As variaveis vindas do Cobol tem por obrigatoriedade ser do tipo string e terao
|
||||
que ter o mesmo tamanho declarado no fonte Cobol. A forma de passagem de parametros
|
||||
do Cobol para o Tcl/Tk sera tratada mais adiante. A declaracao do grupo
|
||||
"cobol_fields" e obrigatoria e nao pode ser alterada.
|
||||
|
||||
set cobol_fields {
|
||||
variavel_1 5
|
||||
variavel_2 25
|
||||
variavel_3 40
|
||||
}
|
||||
Observacao: O numero apos o nome da variavel e' o seu tamanho.
|
||||
|
||||
2.2.2 Definindo um valor para uma variavel.
|
||||
Para definir um valor para uma variavel, voce usara a seguinte sintaxe:
|
||||
set nome_da_variavel valor
|
||||
Ex:
|
||||
set vnome Jose
|
||||
Neste caso ele inseriu o nome "Jose" na variavel "vnome", o valor atribuido nao
|
||||
precisa necessariamente estar entre "" (aspas), a nao ser que voce queira
|
||||
inserir mas de uma palavra, como por ex:
|
||||
vnome set "Jose da Silva"
|
||||
|
||||
2.2.3 Recebendo o valor de uma variavel.
|
||||
Sempre que voce quiser receber o valor de uma variavel, ela tera que ser
|
||||
precedida do "$" (dolar), como por exemplo:
|
||||
set vnome1 $vnome2
|
||||
Neste caso a variavel "vnome1" recebeu o valor da variavel "vnome2"
|
||||
|
||||
2.3 - Inserindo uma condicao.
|
||||
O comando if e utilizado para avaliar se uma condicao. dada e verdadeira ou
|
||||
falsa. Caso a condicao seja verdadeira ele podera executar uma serie de comandos
|
||||
ou, se falsa, ira executar outra serie de comandos de acordo com o definido
|
||||
pelo programador.
|
||||
Sintaxe:
|
||||
if {condicao1} [then] {corpo se verdadeiro} [else {corpo se falso} [elseif {condicao2} {corpo}]]
|
||||
onde:
|
||||
{condicao1}, e a primeira condicao a ser avaliada
|
||||
[then], e opcional apos a condicao que sera avaliada, e utilizado para indicar
|
||||
o que sera executado caso a condicao seja verdadeira.
|
||||
{corpo se verdadeiro}, e o que sera executado se a condicao avaliada for
|
||||
verdadeira.
|
||||
[else], e utilizado para indicar algo que devera ser feito se a condicao
|
||||
avaliada for falsa.
|
||||
{corpo se falso}, e o que devera ser executado quando a condicao avaliada for
|
||||
falsa.
|
||||
[elseif], e utilizado para fazer uma segunda verificacao condicional dentro do
|
||||
mesmo if.
|
||||
{condicao2}, e a segunda condicao que sera avaliada pelo elseif.
|
||||
{corpo}, o mesmo que {corpo se verdadeiro}.
|
||||
|
||||
2.4 - Inserindo uma rotina de repeticao.
|
||||
O comando while ira executar uma serie de comandos enquanto uma condicao for
|
||||
verdadeira, caso na primeira verificacao ja for verificado que a condicao e
|
||||
falsa nenhum comando do corpo sera executado, semelhante ao PERFORM do Cobol.
|
||||
Sintaxe:
|
||||
while {condicao} {corpo}
|
||||
Onde:
|
||||
{condicao}, sera a condicao verificada a cada loop para continuar ou parar o
|
||||
laco de repeticao.
|
||||
{corpo}, sao os comandos que deverao ser repetidos a cada loop
|
||||
Exemplo:
|
||||
set var1 0
|
||||
while {$var1 < 10} {
|
||||
incr var1
|
||||
}
|
||||
|
||||
2.5 - Procedures.
|
||||
E possivel no Tcl criar procedures (semelhante o PERFORM do Cobol), a sintaxe:
|
||||
proc {valores} {corpo}
|
||||
Exemplo:
|
||||
proc atribui_valor {a b c} {
|
||||
set valor1 $a
|
||||
set valor2 $b
|
||||
set valor3 $c
|
||||
}
|
||||
A chamada da procedure acima, seria feita da seguinte maneira:
|
||||
atribui_valor "primeiro" "segundo" "terceiro"
|
||||
|
||||
2.6 - Bind.
|
||||
O comando bind e utilizado para associar eventos do teclado ou mouse a objetos
|
||||
do Tk. Exemplo:
|
||||
label .lab
|
||||
entry .entcodigo
|
||||
bind .entcodigo <FocusIn> {.lab configure -text "Voce entrou no campo Codigo"}
|
||||
bind .entcodigo <FocusOut> {.lab configure -text "Voce saiu do campo Codigo"}
|
||||
No caso acima, quando o cursor entrar no ".entcodigo", o ".lab" vai exibir:
|
||||
"Voce entrou no campo Codigo", e quando sair ele vai exibir: "Voce saiu do campo
|
||||
Codigo"
|
||||
|
||||
2.7 - Componentes Tk.
|
||||
Existem varios componente do Tk, em nosso tutorial usamos entry, label, button
|
||||
e listbox. Todo nome atribuido a um componente deve proceder de um ponto ".".
|
||||
|
||||
2.7.1 Label.
|
||||
Label e um componente de texto, apenas para exibir(ex: identificar campos).
|
||||
Grotescamente podera ser comparado ao DISPLAY do Cobol.
|
||||
A sintaxe para criar um label e a seguinte:
|
||||
label nome_do_label
|
||||
Exemplo:
|
||||
label .codigo
|
||||
No caso acima ele criou um label com o nome "codigo".
|
||||
Existem varias propriedades para um label, como por exemplo -text, -foregorund,
|
||||
-background e etc.
|
||||
Exemplo:
|
||||
label .codigo -text Codigo -foreground blue -background white
|
||||
No caso acima, o label codigo tera o valor "Codigo", letra azul e fundo branco.
|
||||
Observacao: se voce quiser que o texto do label tenha mais de uma palavra, voce
|
||||
tera que coloca-lo entre "" (aspas). Exemplo: -text "InfoCont Sistemas Integrados"
|
||||
Para associar a propriedade -text a uma variavel, voce tera que declara-la da
|
||||
seguinte maneira:
|
||||
-textvariable var
|
||||
Neste caso, sempre que a variavel "var" mudar de valor, o texto do label tambem
|
||||
sera modificado.
|
||||
|
||||
2.7.2 Entry.
|
||||
Entry e um componente ao qual permite com que voce atribua valor a sua
|
||||
propriedade texto via teclado. Semelhante ao ACCEPT do Cobol.
|
||||
A sintaxe para criar um entry e a seguinte:
|
||||
entry nome_do_entry
|
||||
Exemplo:
|
||||
entry .endereco
|
||||
No caso acima ele criou um entry com o nome de "endereco".
|
||||
Existem varias propriedade para um entry, como por exemplo -text, -foreground,
|
||||
-background e etc.
|
||||
Exemplo:
|
||||
entry .endereco -text desendereco -foreground blue -background white
|
||||
Neste caso, o entry "endereco" ira atualizar o valor da variavel "desendereco",
|
||||
com letra azul e fundo branco.
|
||||
|
||||
2.7.3 Button.
|
||||
Button e um componente que aciona algum procedimento quando acionado.
|
||||
A sintaxe para criar um Button e a seguinte:
|
||||
button .nome_do_botao
|
||||
Exemplo:
|
||||
button .but
|
||||
No caso acima ele criou um botao com o nome de "but"
|
||||
Existem varias propriedade para um botao, como por exemplo -text, -foregorund,
|
||||
-background -command e etc.
|
||||
Exemplo:
|
||||
button .but -text Sair -foreground blue -command {exit}
|
||||
Neste caso, o rotulo do botao "but" sera "Sair", letra azul e fechara a tela
|
||||
quando ele for acionado, se voce quiser fazer mais de um procedimento quando
|
||||
um botao for acionado, voce tera que separar um procedimento do outro com ";"
|
||||
(ponto-e-virgula).
|
||||
|
||||
2.7.4 ListBox.
|
||||
ListBox e um componente que mostra uma lista de itens.
|
||||
A sintaxe para criar um ListBox e a seguinte:
|
||||
listbox .lista
|
||||
No caso acima ele criou um listbox com o nome de "lista"
|
||||
Existem varias propriedades para um listbox, como por exemplo -selectmode
|
||||
-yscrollcommand e etc.
|
||||
-Exemlo:
|
||||
listbox .lista -selectmode browse -yscrollcommand {.rolagemv set}
|
||||
Neste caso ele definiu o tipo de selecao como "browse" a associou uma barra
|
||||
de rolagem vertical, que sera utilizada quando o numero de itens for superior
|
||||
ao tamanho fisico do componente (vide scrollbar).
|
||||
|
||||
2.7.5 Scrollbar.
|
||||
Scrollbar e um componente que serve como barra de rolagem para outros
|
||||
componentes.
|
||||
A sintaxe para criar um Scrollbar e a seguinte:
|
||||
scrollbar nome_do_scrollbar
|
||||
Existem varias propriedades para um Scrollbar, como por exemplo -orient
|
||||
e -command
|
||||
Exemplo:
|
||||
listbox .lista -selectmode browse -yscrollcommand {.rolagemv set}
|
||||
scrollbar .rolagemv -orient vertical -command {.lista yview}
|
||||
Neste caso ele criou um listbox e um scrollbar, onde o scrollbar esta na
|
||||
vertical, e ele ira mover para cima ou para baixo a lista do ListBox.
|
||||
|
||||
2.7.6 TopLevel
|
||||
TopLevel, e um comando que cria uma nova janela.
|
||||
A sintaxe para criar um toplevel e a seguinte:
|
||||
toplevel .nome_janela
|
||||
Exemplo:
|
||||
toplevel .cadastro
|
||||
No caso acima ele criou uma nova janela com o nome de "cadastro"
|
||||
Para setar a altura usa-se o comando -height altura_da_janela
|
||||
para setar a largura usa-se o comando -width largura_da_janela
|
||||
se voce quiser criar algum componente nesta janela voce tera que colocar o nome
|
||||
da janela antes do nome do componente, como por exemplo:
|
||||
button .cadastro.but -text "Sair" -command {exit}
|
||||
No caso acima ele criou um botao chamado "but" na janela chamada "cadastro" o
|
||||
rotulo desse botao e "Sair" e quando ele for pressionado, ele ira fechar o
|
||||
programa.
|
||||
|
||||
2.8 - Place.
|
||||
O Place e um comando com a utilidade de posicionar os objetos na janela.
|
||||
Sua sintaxe e a seguinte:
|
||||
place nome_do_objeto -x posicao_horizontal -y posicao_vertical
|
||||
-height altura -width largura
|
||||
Comandos principais:
|
||||
-x : indica quantos pixels na horizontal o objeto deve se posicionar.
|
||||
-y : indica quantos pixels na vertical o objeto deve se posicionar.
|
||||
-height : indica a altura do objeto em pixels.
|
||||
-width : indica a largura do objeto em pixels.
|
||||
Exemplo:
|
||||
place .entcidade -x 10 -y 15 -height 20 -width 170
|
||||
No caso acima o componente "entcidade" estara 10 pixels na horizontal, da
|
||||
janela criada 15 pixels na vertical, 20 pixels de altura, e 170 pixels de
|
||||
largura.
|
||||
|
||||
2.9 - Grid.
|
||||
Grid e um outro metodo para organizar objetos na tela, muito mais
|
||||
pratico que o place, ele cria uma tabela invisivel na tela, e voce vai
|
||||
colocando cada widget em uma celula dessa tabela, facilitando o trabalho, pois
|
||||
voce nao precisa ficar se preocupando em alinhar os objetos, o grid faz isso
|
||||
sozinho, o largura da coluna, e' do tamanho do componente mais largo da coluna,
|
||||
e a altura da linha, e' o tamanho do componente mais alto da linha. Exemplo:
|
||||
button .but1
|
||||
button .but2
|
||||
button .but3
|
||||
button .but4
|
||||
grid .but1 .but2
|
||||
grid .but3 .but4
|
||||
no caso acima foi criado quatro botoes e exibido na tela com o comando grid,
|
||||
existem varias opcoes para o grid, como por exemplo:
|
||||
-sticky nsew, isso indicara em que posicao da celula ficara o objeto, caso a
|
||||
celula seja maior que o objeto, nesse exemplo, ela ficara na posicao norte, sul, leste
|
||||
e oeste, ou seja, o tamanho do objeto, sera o tamanho da celula.
|
||||
|
||||
2.10 Pack.
|
||||
Pack, e' uma outra maneira de se organizar objetos na tela. E' como se
|
||||
ele jogasse os objetos para os cantos, na opcao -side voce define em que canto
|
||||
o objeto sera jogado: para cima(top), para a esquerda(left), direita(right) ou
|
||||
para baixo(bottom). A opcao -anchor, em que posicao do lado o objeto
|
||||
ira ficar, norte(n), sul(s), leste(e) ou oeste(w) por exemplo:
|
||||
button .but1
|
||||
button .but2
|
||||
button .but3
|
||||
button .but4
|
||||
pack .but1 .but2 .but3 .but4 -side right -anchor nw
|
||||
Nesse exemplo, foram criados quatro botoes, eles irao aparecer no canto direito
|
||||
superior, nao importando se voce altere o tamanho da janela.
|
||||
|
||||
--------------------------------------------------------------------------------------
|
||||
|
||||
3 - Fazendo o Cobol "conversar" com o Tcl/TK.
|
||||
|
||||
3.1 - Trabalhando com as variaveis do Cobol.
|
||||
As variaveis associadas ao Tcl/TK, deverao ser declaradas na
|
||||
WORKING-STORAGE SECTION. Voce ira declarar uma variavel do nivel 1, e as
|
||||
variaveis pertencentes ao Tcl/TK deverao estar dentro dela, o nome das variaveis,
|
||||
fica a seu criterio. Sera necessario declarar mais uma variavel PIC X(64) que
|
||||
servir para identificar o nome do arquivo TCL. Veja o exemplo abaixo:
|
||||
01 VARIAVEIS-TCL.
|
||||
03 TCL-CODIGO PIC X(04).
|
||||
03 TCL-NOME PIC X(40).
|
||||
03 TCL-ENDERECO PIC X(40).
|
||||
01 NOME-TELA PIC X(64).
|
||||
Neste exemplo, declaramos a variavel "VARIAVEIS-TCL", nela estarao todas as
|
||||
variaveis que o Tcl/TK ira usar. E imprescindivel que o tamanho das variaveis no
|
||||
Cobol seja o mesmo das variaveis declaradas no Tcl/Tk e que tem por obrigatoriedade
|
||||
ser PIC X, tendo em vista que o Tcl/Tk nao permite a declaracao de campos numericos.
|
||||
Posteriormente declaramos a variavel "NOME-TELA", que sera o nome do arquivo da tela
|
||||
(script Tcl/Tk) que voce ira chamar. Digamos que fizemos uma tela com o nome de
|
||||
"cadastro.tcl", entao a variavel "NOME-TELA" receberia o valor "cadastro.tcl".
|
||||
Veja no indice 3.2 (proximo) para saber como elas serao usadas.
|
||||
|
||||
3.2 - Chamando a tela.
|
||||
Antes de tudo voce tera que chamar o programa "initTcl". Ele inicializa o
|
||||
ambiente grafico. Faca isso no comeco do programa, antes de comecar qualquer
|
||||
rotina.
|
||||
A chamada da tela Tcl/TK e efetuada atraves da rotina "tcleval", que e
|
||||
um programa escrito em linguagem C, que possui um interpretador de scripts TCL/TK.
|
||||
Ele e responsavel por executar a tela e transportar os conteudos das variaveis
|
||||
do Cobol para o Tcl/TK e vice-versa.
|
||||
Para chamar a tela, voce tera que executar o programa "tcleval" atraves do
|
||||
comando CALL, usando as variaveis do Tcl/Tk e a variavel com o nome do programa,
|
||||
usando o mesmo exemplo anterior:
|
||||
01 VARIAVEIS-TCL.
|
||||
03 TCL-CODIGO PIC X(04).
|
||||
03 TCL-NOME PIC X(40).
|
||||
03 TCL-ENDERECO PIC X(40).
|
||||
01 NOME-TELA PIC X(64).
|
||||
Digamos que a tela que voce ira chamar, e "cadastro.tcl", entao no Cobol fariamos
|
||||
da seguinte maneira.
|
||||
MOVE "cadastro.tcl" TO NOME-TELA.
|
||||
CALL "tcleval" USING VARIAVEIS-TCL NOME-TELA.
|
||||
No caso acima, quando o CALL fosse executado, ele chamaria a tela escrita em Tcl/TK
|
||||
"cadastro.tcl" e as variaveis do "cobol_field" no Tcl/TK receberiam os valores
|
||||
vindos do Cobol.
|
||||
|
||||
3.3 - Voltando para o Cobol.
|
||||
Voltar do Tcl/TK para o Cobol, e muito simples, voce tera que executar
|
||||
no Tcl/TK o comando "do_exit", fazendo isso os valores das variaveis do "cobol_fields"
|
||||
serao movida para as variaveis do Cobol, conforme voce declarou na
|
||||
WORKING-STORAGE SECTION, dai cabe a voce fazer uma rotina, para que o Cobol receba os
|
||||
valores e volte para a chamar a tela, mostrando os novos valores processados.
|
||||
|
||||
3.4 - Como funciona a rotina do tutorial.
|
||||
No exemplo do nosso tutorial, temos uma variavel declarada no Cobol com o nome de
|
||||
"TCL-OPCAO", com a correspondente "tclopcao" no Tcl/TK.
|
||||
O Cobol chama o Tcl/TK atraves do "tcleval" e a tela e exibida. Quando voce clica
|
||||
em algum botao, ou tira o foco do campo "codigo", ele atribui a acao para a variavel
|
||||
tclopcao e executa o "do_exit". Este comando ira retornar o processamento para
|
||||
o Cobol, transportando as variaveis vindas do Tcl/TK. O Cobol le a variavel
|
||||
"TCL-OPCAO" e executa a rotina correspondente a opcao e retorna para o Tcl/Tk.
|
||||
Exemplo:
|
||||
Na WORKING-STORAGE SECTION atribuimos a variavel "NOME-PROGRAMA" com o valor
|
||||
"cadastro.tcl", que e o nome do arquivo do Tcl/TK.
|
||||
No inicio do programa Cobol executamos o "iniTcl" (CALL "initTcl".).
|
||||
Antes de chamar a tela pela primeira vez inicializamos as variaveis que serao
|
||||
usadas pelo Tcl/TK, para que tela seja exibida com os campos vazios.
|
||||
Como a variavel "NOME-PROGRAMA" ja esta carregado com o nome da janela,
|
||||
chamamos a tela (CALL "tcleval" USING VARIAVEIS-TCL NOME-PROGRAMA).
|
||||
Isto ira chamar a tela do Tcl/TK. Digamos que o usuario queira gravar um registro,
|
||||
entao ele ira preencher os dados e depois ira clicar no botao "Gravar". Quando ele
|
||||
clicar em gravar, o Tcl/TK ira atribuir a variavel "tclopcao" o valor "gra" e fara
|
||||
o comando "do_exit" (-command {set tclopcao gra ; do_exit}) que ira fazer com que o
|
||||
processamento retorne ao programa Cobol, com os novos valores da variaveis.
|
||||
O Cobol ira ler a variavel "TCL-OPCAO", que tera o valor "gra", e executara um
|
||||
PERFORM para a secao "1000-GRAVA", onde os valores das variaveis vindas do Tcl/TK
|
||||
serao movidas para a FD "CADASTRO" e sera executa a gravacao. Na seqüencia o
|
||||
programa inicializara as variaveis do Tcl/TK, atribuira uma mensagem descrevendo
|
||||
o resultado do processo de gravacao para a variavel "TCL-MENSAGEM" e saira da rotina,
|
||||
retornando ao Tcl/TK (tcleval). A tela sera exibida com o novos valores vindos do
|
||||
Cobol. No script Tcl/TK temos um label que esta vinculada a variavel "tclmensagem",
|
||||
que no retorno sera atualizada e exibira ao usuario o resultado da acao.
|
||||
Resumido, o Cobol chama o Tcl/TK, o usuario modificara os valores das variaveis,
|
||||
voltara para o Cobol. O Cobol, por sua vez, ira identificar o desejo do usuario,
|
||||
ira executar o processo correspondente e retornara ao Tcl/TK,
|
||||
--------------------------------------------------------------------------------------
|
||||
|
||||
|
||||
4 - Instalando o Tcl/TK no Windows.
|
||||
|
||||
4.1 - O melhor caminho para baixar o TCL/TK para Windows é através pacote ActiveTCL,
|
||||
distribuido pela ActiveState. O interpretador TCL/TK é totalmente free.
|
||||
Para realizar o download do ActiveTCL, acesse o endereço abaixo:
|
||||
|
||||
http://www.activestate.com/Products/ActiveTcl
|
||||
|
||||
O ActiveTCL trás, além do interpretador TCL/TK, inúmeros pacotes de componentes,
|
||||
como o Iwidget e o Bwidgets, que agregam funções como suporte à campos editados,
|
||||
calendários, utilitários para busca e seleção de arquivos e inúmeros outros recursos.
|
||||
A instalação do ActiveTCL também é bastante simples, sendo necessário apenas confirmar
|
||||
todos os passos do processo. Após a instalação é criado um grupo de programas
|
||||
denominado ActiveState ActiveTCL, onde estão disponíveis os interpretadores e também o
|
||||
grupo Demos, onde se encontram disponíveis todos os componentes agregados na instalação,
|
||||
com exemplos em tempo de execução e também do código que deverá ser implementado na
|
||||
sua aplicação.
|
||||
A partir deste momento, você já terá acesso à todas as funcionalidades do TCL/TK,
|
||||
sem a necessidade de qualquer configuração adicional. As interfaces criadas em TCL/TK
|
||||
já poderão ser visualizadas e processadas.
|
||||
|
||||
5 - Compilando o programa cadastro.cob.
|
||||
5.1 Para compilar e gerar o executável de cadastro.cob digite:
|
||||
|
||||
htcobol -vC cadastro.cob
|
||||
|
||||
Informacoes:
|
||||
- O TC suporta a integração com o TCL/TK via call's a um interpretador TCL/TK atraves um
|
||||
wrapper(empacotador) criado pelo Rildo. Esta rotina (initTcl.dll) já se encontra
|
||||
devidamente compilada e presente no diretório C:\TinyCOBOL\bin.
|
||||
|
||||
6 - Duvidas e Sugestoes.
|
||||
Poste suas duvidas e ou sugestoes para a lista abaixo, sendo que o topico devera ser
|
||||
enviado para lista adequada.
|
||||
|
||||
6.1 Tinycobol.
|
||||
Lista cobol@yahoogrupos.com.br
|
||||
http://br.tinycobol.org
|
||||
http://wiki.tinycobol.org
|
||||
|
||||
6.2 TCL/TK
|
||||
lista tcl-br@yahoogrupos.com.br
|
||||
http://tclbrasil.cipsga.org.br
|
||||
http://www.ricardo-jorge.eti.br
|
||||
http://www.tcl.tk
|
||||
|
||||
7 - Apendice.
|
||||
|
||||
7.1 - Agradecimentos.
|
||||
|
||||
- Carlucio Lopes<carsanlo@terra.com.br> que, atraves do seu tutorial, nos
|
||||
permitiu dar os primeiros passos com o Tcl/Tk;
|
||||
- Rildo Pragana<rildo@pragana.net> pelos primeiros exemplos com Tcl/TK com
|
||||
o TinyCobol e pela paciencia em nos ajudar a superar algumas barreiras
|
||||
encontradas;
|
||||
- John Ousterhout por criar a linguagem TCL e o toolkit grafico TK.
|
||||
- Wesley R. Braga, criador do site tclbrasil.cipsga.org.br
|
||||
- Ricardo Jorge, grande colaborador da lista tcl-br.
|
||||
|
||||
7.2 Colaboradores.
|
||||
|
||||
- Danilo Pacheco Martins
|
||||
- Fernando Wuthstrack
|
||||
- Carlucio Lopes
|
||||
- Rildo Pragana
|
||||
- Wesley R. Braga
|
||||
Binary file not shown.
|
After Width: | Height: | Size: 309 B |
Binary file not shown.
|
After Width: | Height: | Size: 1.0 KiB |
Reference in New Issue
Block a user