Comandos e Condições COBOL

    Os programas sempre necessita tomar decisões sobre que rumo tomar em certas circunstâncias. Para que o programa possa fazer isto existem dois comandos condicionais o IF e o EVALUATE.

    O comando IF é utilizado para tomadas de decisões simples do tipo se for verdade faça isto senão faça aquilo.

Exemplo:

...............
if nome equal "Dionatan"
   display nome
else
   display "Desconhecido"
end-if
...............

    Neste exemplo, caso variável nome seja igual a "Dionatan" então o comando display nome será executado, caso contrário será executado o comando display "Desconhecido". Neste exemplo não foi usado a cláusula THEN a mesma é opcional, outro detalhe importante é referente ao ponto, caso o programador opte em adotar um ponto por comando, ele deve se atentar no seguinte.

............ Isto esta errado ...........
if nome equal "Dionatan".
  display nome.
else.
  display "Desconhecido".
end-if.
.........................................
........ Isto esta certo ...........
.........................................
if nome equal "Dionatan"
  display nome
else
   display "Desconhecido"
end-if.
........................................

    O comando IF irá considerar como o fim de seus comandos a cláusula END-IF ou o primeiro ponto encontrado.

    A cláusula EVALUATE possui um sofisticado mecanismo de análises condicionais, onde podemos utilizar as mesmas condições aceitas pela cláusula IF e além disso algumas cláusulas próprias do comando. ALSO indica que EVALUATE deverá analisar duas condições distintas simultaneamente. Podemos também utilizar a instrução TRUE e FALSE, que indicarão que a análise deverá ser feita nas entradas WHEN. WHEN OTHER é uma alternativa caso nenhuma das condições WHEN gere um TRUE na avaliação.

Introdução ao Cobol

Área de numeração sequencial

    Normalmente consiste em seis dígitos em ordem crescente que normalmente são utilizados para marcas de identificação da fonte.

Área de indicação

    Um hífen (-) nesta posição indica que existe uma continuação de uma cadeia de caracteres que foi iniciada na linha anterior, opcionalmente podemos colocar o texto inteiro na linha de baixo para não termos que quebra-lo.

Comentário em cobol

    Para se fazer um comentário em cobol basta usar um asterisco (*), isto indica que toda a linha deve ser tratado como um comentário. Uma barra (/) além de trata toda a linha como um comentário fará com que ao gerar um arquivo (.LST) arquivo de listagem, será adicionado um saldo de página para impressão.

    Um dólar ($) indicará ao compilador que a linha terá diretivas de compilação. Estas diretivas são utilizadas para modificar o comportamento e compatibilidade dos programas no ambiente Merant Micro Focus.

Área A e B

    Originalmente da linguem cobol havia a separação da área A e B, ou seja, o que poderia ser escrito na área A e o que poderia ser escrito na área B, com o ANS85 isto não existe mais.

Identification Division

    Divisão de identificação do programa. Esta divisão possui a seguinte estrutura:

Identification Division.
Programa - ID.                 Nome do programa.
Author.                            Autor do programa.
Installation.                      Instalação do programa.
Date-Written.                   Data da criação.
Date-Compiled.                Data da compilação.

    Lembrando que todos os comandos acima não possui nem um efeito na aplicação, são apenas parâmetros opcionais para documentação, mas deve ser escritos corretamente para que não cause erro de compilação.

Data Division

    Divisão exclusivamente voltada para à definição de estruturas de registro as variáveis e constantes do programa, uma área de alocação de memória.

    Esta divisão possui uma seção voltada para a declaração das variáveis e constantes do programa a Working-Storage Section. Lembrando de que os nomes utilizados no programa e de no máximo trinta caracteres, caso ultrapasse estes tristas caracteres simplesmente terá seu excedente ignorado pelo compilador.

Procedure Division

    Esta divisão controla a execução do programa, é onde colocamos os comandos e a serem executados em um ordem lógica. Esta execução e controlado por parágrafos, eles funcionam como identificações de blocos de comandos.

Condições Símbolo Cláusula do Cobol

Condição                            Símbolo                               Cláusula
  Igual                                    =                                        Equal
  Menor que                           <                                        Less Than
  Menor e igual que                 <=                                      Less Than Or Equal To
  Maior que                            >                                        Greater Than
  Maior igual que                    >=                                      Greater Than Or Equal To
  Diferente                             <>                                      Not Equal ou Unequal To

    Pessoal por hoje é só, mas depois estarei postando mais sobre cobol, como todos sabem o blog é novo esta começando agora, mas sempre que puder estarei postando e postando, se tiverem um pouco de paciência logo, logo vamos ter bastante conteúdo, obrigado pela visita e volte sempre, boa noite. 

Armazenando Dados em Uma Tabela Cobol

           Descrição: Armazena dados em uma tabela, lembrando que todas as linhas que tem o "*"  na frente é comentário, ou seja, será ignorado no processamento do código, bom então vamos lá.

identification division.
program-id.                             tabela.
author.                               Dionatan.
data division.
working-storage section.
       77 indextab                     pic 9(002) value zeros.
       77 tabmes          pic 9(001) value zeros occurs 31 times.
       01 datasistema.
        10 anosistema                  pic 9(004).
        10 mesistema                   pic 9(002).
        10 diasistema                  pic 9(002).
       77 inteirodata                  pic 9(008) value zeros.
       77 diasmes                      pic 9(002) value zeros.
       77 diasemana                    pic 9(001) value zeros.
       77 anobissexto                  pic 9(004) value zeros.
       77 anobissprova                 pic 9(009) value zeros.
procedure division.
inicio.
*Identifica o mes
accept datasistema from date yyyymmdd
*Identifica quantos dias existe no mes
evaluate mesistema
 when 1
move 31 to diasmes
when 2
move 28 to diasmes
move zeros to anobissexto
divide anosistema by 4 giving anobissexto
move anobissexto to anobissprova
subtract anobissprova from anobissexto
if anobissexto equal zeros
move 29 to diasmes
end-if
when 3
move 31 to diasmes
when 4
move 30 to diasmes
when 5
move 31 to diasmes
when 6
move 30 to diasmes
when 7
move 31 to diasmes
when 8
move 31 to diasmes
when 9
move 30 to diasmes
when 10
move 31 to diasmes
when 11
move 30 to diasmes
when 12
move 31 to diasmes
end-evaluate
*Laço para cada dia do mes
perform varying indextab from 1 by 1
until indextab > diasmes
*O dia que será analisado
move indextab to diasistema
*A função não aceita um item de grupo
move datasistema to inteirodata
* Identifica o dia da semana
*1 = Segunda Feira
*2 = Terça Feira
*3 = Quarta Feira
*4 = Quinta Feira
*5 = Sexta Feira
*6 = Sabádo
*7 = Domingo
move function rem(function integer-of-date(inteirodata),7)
to diasemana
if diasemana >= 1 and
diasemana <= 5
* Se condição for verdadeira é um dia útil
move 1 to tabmes(indextab)
end-if
end-perform
stop run
.

Cadastro De Clientes Cobol

          Descrição: Bom com esta aplicação você faz um cadastro de clientes, é bem parecido com o "Cadastro De Estudantes", mas tem algumas diferenças, então vamos lá.

*=============================================================
*                                                        Cadastro De Clientes
*=============================================================
identification division.
program-id.                              cadastrocliente.
author.                                         Dionatan.
environment division.
configuration section.
input-output section.
file-control.
select clientes assign to "clientes.dat"
organization is indexed
access mode is dynamic
record key is codigo
alternate key is nome with duplicates
file status is fs-clientes.
data division.
   file section.
   fd clientes.
   01 registro-clientes.
        02 codigo              pic 9999.
        02 nome                pic x(50).
        02 data-nas.
        03 dia-nas             pic 99.
        03 mes-nas             pic 99.
        03 ano-nas             pic 9999.
            02 telefone               pic x(30).
            02 endereco               pic x(50).
            02 numero                 pic 9(6).
            02 complemento            pic x(30).
            02 bairro                 pic x(30).
            02 cidade                 pic x(30).
            02 cep                    pic x(8).
            02 estado                 pic AA.
            02 email                  pic x(50).
   01 reg-cliente.
        02 wcodigo              pic 9999 values zero.
        02 wnome                pic x(50) values spaces.
        02 wdata-nas.
                03 wdia-nas             pic 99 values zero.
                03 wmes-nas             pic 99 values zero.
                03 wano-nas             pic 9999 values zero.
         02 wtelefone               pic x(30) value spaces.
         02 wendereco               pic x(50) value spaces.
         02 wnumero                 pic 9(6) value zero.
         02 wcomplemento            pic x(30) value spaces.
         02 wbairro                 pic x(30) value spaces.
         02 wcidade                 pic x(30) value spaces.
         02 wcep                    pic x(8) value spaces.
         02 westado                 pic AA value spaces.
         02 wemail                  pic x(50) value spaces.
working-storage section.
      01 fs-clientes.
           02 fs-clientes-1            pic 9.
           02 fs-clientes-2            pic 9.
           02 fs-cliente-r redefines fs-clientes-2 pic 99 comp-x.
77 opcao                       pic x value spaces.
procedure division.
       abertura.
       open i-o clientes.
       inicio.
                 display erase
                 perform tela
                 if opcao="S" or opcao="s" then
                    perform grava-dados
                    perform limpa-campos
                    go to inicio
                 else
                    go to inicio
                 end-if
       .
       tela.
                display "Cadastro de cliente" at 0430
                display "Codigo             : " at 0605
                display "Nome               : " at 0705
                display "Data Nascimento    :   /  /" at 0805
                display "Endereco           : " at 0905
                display "Telelefone         : " at 1005
                display "Numero             : " at 1105
                display "Complemento        : " at 1205
                display "Bairro             : " at 1305
                display "Cidade             : " at 1405
                display "C.E.P              : " at 1505
                display "Estado             : " at 1605
                display "E-mail             : " at 1705
                accept wcodigo at 0625
                if wcodigo = 9999 then
                    close clientes
                    exit program
                end-if
                accept wnome at 0725
                accept wdia-nas at 0825
                accept wmes-nas at 0828
                accept wano-nas at 0831
                accept wendereco at 0925
                accept wtelefone at 1025
                accept wnumero at 1125
                accept wcomplemento at 1225
                accept wbairro at 1325
                accept wcidade at 1425
                accept wcep at 1525
                accept westado at 1625
                accept wemail at 1725
                display "Dados corretos [S/N] [.]" at 1905
                accept opcao at 1927
                .
limpa-campos.
       move spaces to reg-cliente.
       grava-dados.
       move reg-cliente to registro-clientes
write registro-clientes.

Resultado Da Nossa Aplicação No Net  Express

Laço de Repetição Cobol

           Descrição: Identifica a quantidade de números pares digitados, a quantidade de números impares e também o percentual de números pares e impares.  

*=============================================================

*                                                     Laço de Repetição Cobol

*=============================================================

identification division.
       program-id.               LacoRepeticao.
       author.                   DionatanAlves.
       data division.
       working-storage section.

       77 numero                      pic 999 value zero.
       77 pares                       pic 999 value zero.
       77 impares                     pic 999 value zero.
       77 d                           pic 999 value zero.
       77 resto                       pic 999 value zero.
       77 pp                          pic 99v99 value zero.
       77 pi                          pic 99v99 value zero.
       77 i                           pic 99 value zero.
       77 ms                          pic ZZ9.99 value zero.
procedure division.
       inicio.

display erase
          perform varying i from 1 by 1 until  i>10
              display "numero" i
              accept numero
              compute d=numero/2
              compute resto=numero - d*2
          if resto <> 0 then
             add 1 to impares
          else
             add 1 to pares
          end-if
       end-perform
        compute pp=((pares /10) * 100)
        compute pi=((impares / 10) * 100)
        display erase
         display "Qtd de numeros pares :" at 1010 pares
         display "Qtd de numeros impare :" at 1110 impares
         move pp to ms
         display "Percentual de numeros pares: " at 1210 ms
         move pi to ms
         display "Percentual de numeros impares: " at 1310 ms
stop run
 .

Calcula Areá Cobol

       identification division.
       program-id.                           calcarea.
       author.                               dionatan.
       data division.
       working-storage section.
       77 largura                            pic 9(003) value zeros.
       77 altura                             pic 9(003) value zeros.
       77 area-result                        pic 9(006) value zeros.

       procedure division.
       inicio.
        display erase
           display "Calculo de area quadrado retangulo" at 0521
           display "Largura: " at 1010
           display "Altura: " at 1210
           accept largura at 1019
           accept altura at 1219
           multiply largura by altura giving area-result
           display "Area: " at 1410 area-result
       stop run
       .


                                         Print Screen da Tela Net Express

                                        Resultado da Nossa Aplicação

Menu Cobol

identification division.
program-id.                             Menu.
author.                             Dionatan.
data division.
working-storage section.
77 opcao        pic 9 value zero.
77 wopcao       pic 9 value zero.
screen section.
     01 menu-principal.
         02 blank screen.
         02 line 1 col 1 value"#########################################
-"#######################################".
       02 line 3 col 21 value "Sistema de compra e venda de Mercadorias"
      -.
       02 line 5 col 1 value "##########################################
      -"######################################".

          02 line 7 col 33 value "Menu Principal".
          02 line 10 col 10 value "[1] Cadastro Mercadoria".
          02 line 11 col 10 value "[2] Cadastro Cliente".
          02 line 12 col 10 value "[3] Cadastro Vendedor/Comprador".
          02 line 13 col 10 value "[4] Listagem de Mercadoria".
          02 line 14 col 10 value "[5] Listagem Cliente".
          02 line 15 col 10 value "[6] Sair do Sistema".
          02 line 18 col 10 "Digite o numero desejado[...]".
          02 opcao line 18 col 36 pic 9 using wopcao auto.

procedure division.

inicio.
        display menu-principal
         accept menu-principal
         evaluate wopcao
when 1
      call "cadmercadoria" using wopcao
          go to inicio
          when 2
       call "CadastroCliente" using wopcao
             when 6
                stop run
             when other
              go to inicio
end-evaluate
.

* O programa se encerra no ponto final, vou por um Print Screen para você ver como fica, e também um Print do Net Express.


                                                   Print da Tela Do Net Express

                                               Print do Resultado da Nossa Aplicação

Bom temos que levar em conta que quando escolhermos a opção não retornará resultado algum, bom eu estarei fazendo outro post onde ao escolhermos a opção desejada retornará o resultado que queremos, por enquanto é isso pessoal, mas guarde este código vamos precisar dele no outro post que irei fazer, obrigado até.

Contador Cobol

       identification division.
       program-id.                        contagem.
       author.                                Dionatan.
       data division.
       working-storage section.
       77 contador                       pic 999 value zeros.
       procedure division.
       inicio.
       add 1 to contador
       display contador
       if contador=100 then
       stop run
        else
             go to inicio
          end-if
          .

Cadastro de Estudantes Cobol

identification division.
program-id.                              estudantes.
author.                                  dionatan.
environment division.
configuration section.
input-output section.
file-control.
select estudantes assign to "estudantes.dat"
organization is indexed
access mode is dynamic
record key is codigo
alternate key is nome with duplicates
file status is fs-estudantes.
data division.
file section.
fd estudantes.
           01 registro-estudantes .
              02 codigo               pic 9999 values zeros.
              02 nome                 pic x(50) values spaces.
              02 nota1                pic 9999 values zeros.
              02 nota2                pic 9999 values zeros.
              02 nota3                pic 9999 values zeros.
              02 nota4                pic 9999 values zeros.

           01 reg-estudantes.
              02 wcodigo              pic 9999 values zero.
              02 wnome                pic x(50) values spaces.
              02 wnota1               pic 9999 values zeros.
              02 wnota2               pic 9999 values zeros.
              02 wnota3               pic 9999 values zeros.
              02 wnota4               pic 9999 values zeros.
working-storage section.
           01 fs-estudantes.
              02 fs-estudantes-1            pic 9.
              02 fs-estudantes-2            pic 9.
              02 fs-estudante-r redefines fs-estudantes-2 pic 99 comp-x.
              77 opcao                       pic x value spaces.
procedure division.
abertura.
open i-o estudantes.
inicio.
             display erase
              perform tela
               if opcao="S" or opcao="s" then
               perform grava-dados
               perform limpa-campos
             go to inicio
               else
             go to inicio
               end-if
       .
tela.
                 display "Cadastro de estudantes" at 0230
                 display "Codigo              : " at 0605
                 display "Nome                : " at 0705
                 display "Nota1               : " at 0805
                 display "Nota2               : " at 0905
                 display "Nota3               : " at 1005
                 display "Nota4               : " at 1105
                 accept wcodigo at 0625
                 if wcodigo = 9999 then
                 close estudantes
                  stop run
                   end-if

          accept wnome at 0725
          accept wnota1 at 0825
          accept wnota2 at 0925
          accept wnota3 at 1025
          accept wnota4 at 1125
       display "Os dados estão corretos S/N" at 1525
          accept opcao
.
limpa-campos.
move spaces to reg-estudantes.
grava-dados.
move reg-estudantes to registro-estudantes
write registro-estudantes.