nilopaim
/
tinycobol
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
tinycobol/cbl2cob/mfparser.cob

3018 lines
134 KiB
COBOL
Raw Permalink Blame History

*
* 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. mfparser.
author. Hudson Reis.
date-written. 03/09/2003.
*
* Parser para dialeto MicroFocus COBOL.
*
environment division.
configuration section.
input-output section.
file-control.
copy "entrada.sl".
copy "saida.sl".
data division.
file section.
copy "entrada.fd".
copy "saida.fd".
working-storage section.
01 filler pic 9(01).
copy "globals.ws".
* Linhas usadas para parsing do fonte.
01 W01-PARA PIC X(01) VALUE SPACES.
01 W01-CONT1 PIC 9(03) VALUE ZEROS.
01 W01-CONT2 PIC 9(03) VALUE ZEROS.
01 W01-TIPO PIC 9(01) VALUE ZEROS.
88 W88-PRIMEIRO VALUE 1.
88 W88-ESPACO VALUE 2.
88 W88-CARACTER VALUE 3.
01 W01-TEMP1 PIC X(256) VALUE SPACES.
01 FILLER REDEFINES W01-TEMP1.
03 W03-OCCURS-TEMP1 OCCURS 256 TIMES PIC X(01).
01 W01-TEMP2 PIC X(256) VALUE SPACES.
01 FILLER REDEFINES W01-TEMP2.
03 W03-OCCURS-TEMP2 OCCURS 256 TIMES PIC X(01).
77 ws77-linha-para-parsing pic x(256) value spaces.
77 ws77-linha-temporaria pic x(256) value spaces.
77 ws77-buffer-temporario pic x(256) value spaces.
******************************************************************
*Linhas acrescidas por Fernando Wuthstrack em 09/07/2004
*Linhas usadas para identificar tipos de variaveis
******************************************************************
77 ws77-busca-variaveis pic 9(001) value zeros.
88 ws88-busca-variaveis value 0.
88 ws88-nao-busca-variaveis value 1.
77 ws77-tipo-variavel pic 9(001) value zeros.
88 ws88-tipo-alfa value 0.
88 ws88-tipo-numerico value 1.
77 ws77-linha-anterior pic x(256) value spaces.
77 ws77-count-from pic 9(003) value zeros.
77 ws77-count-to pic 9(003) value zeros.
01 ws01-nome-arq-variaveis.
03 ws03-hora-arq-var pic 9(008) value zeros.
03 filler pic x(004) value ".tmp".
01 ws01-dados-ante-pic pic x(256) value spaces.
01 filler redefines ws01-dados-ante-pic.
03 ws03-digito-ante-pic pic x(001) occurs 256 times.
01 ws01-dados-pos-pic pic x(256) value spaces.
01 filler redefines ws01-dados-pos-pic.
03 ws03-digito-pos-pic pic x(001) occurs 256 times.
01 ws01-dados-pos-accept pic x(256) value spaces.
01 filler redefines ws01-dados-pos-accept.
03 ws03-digito-pos-accept pic x(001) occurs 256 times.
01 ws01-dados-pos-at pic x(256) value spaces.
01 filler redefines ws01-dados-pos-at.
03 ws03-digito-pos-at pic x(001) occurs 256 times.
01 ws01-nome-variavel pic x(030) value spaces.
01 filler redefines ws01-nome-variavel.
03 ws03-digito-nome-variavel pic x(001) occurs 30 times.
01 ws01-tipo-variavel pic x(020) value spaces.
01 filler redefines ws01-tipo-variavel.
03 ws03-digito-tipo-variavel pic x(001) occurs 20 times.
01 ws01-posicao-cursor pic x(030) value spaces.
01 filler redefines ws01-posicao-cursor.
03 ws03-digito-posicao-cursor pic x(001) occurs 30 times.
01 ws01-indice-occurs pic x(030) value spaces.
01 filler redefines ws01-indice-occurs.
03 ws03-digito-indice-occurs pic x(001) occurs 30 times.
******************************************************************
* Flags condicionais para gravacao de linha.
01 ws01-grava-linha pic 9(001) value zeros.
88 ws88-grava-linha value 0.
88 ws88-nao-grava-linha value 1.
* Flags de termino/nao termino de linha.
01 ws01-termino-linha pic 9(001) value zeros.
88 ws88-terminou-linha value 0.
88 ws88-nao-terminou-linha value 1.
01 ws01-status-linha pic 9(001) value zeros.
88 ws88-linha-continuada value 0.
88 ws88-ultima-linha value 1.
* Flags para o DISPLAY.
01 ws01-display pic 9(001) value zeros.
88 ws88-display-nao-terminado value 0.
88 ws88-display-terminado value 1.
* Flags para o ACCEPT.
01 ws01-accept pic 9(001) value zeros.
88 ws88-accept-nao-terminado value 0.
88 ws88-accept-terminado value 1.
* Flags para Identification division.
77 ws77-linha-id pic 9(005) value zeros.
77 ws77-id pic 9(001) value zeros.
88 ws88-nao-existe-id value 0.
88 ws88-existe-id value 1.
* Flags para Environment division.
77 ws77-linha-ed pic 9(005) value zeros.
77 ws77-ed pic 9(001) value zeros.
88 ws88-nao-existe-ed value 0.
88 ws88-existe-ed value 1.
* Crt Status clause.
77 ws77-crt-status-field pic x(256) value spaces.
77 ws77-crt-status-length pic 9(003) value zeros.
01 ws01-precisa-crt-status pic 9(001) value zeros.
88 ws88-nao-precisa-crt-status value 0.
88 ws88-precisa-crt-status value 1.
* Bgcolor e Fgcolor.
77 ws77-bgcolor pic 9(001) value zeros.
88 ws88-nao-encontrou-bgcolor value 0.
88 ws88-encontrou-bgcolor value 1.
77 ws77-fgcolor pic 9(001) value zeros.
88 ws88-nao-encontrou-fgcolor value 0.
88 ws88-encontrou-fgcolor value 1.
* Case.
01 ws01-case.
02 ws02-maiusculo pic x(26)
value "ABCDEFGHIJKLMNOPQRSTUVXYWZ".
02 ws02-minusculo pic x(26)
value "abcdefghijklmnopqrstuvxywz".
* Linhas armazenadas.
01 ws01-linhas.
03 ws03-registro-armazenado pic x(256) occurs 1000 times.
* Para debug.
77 ws77-conta-linha pic 9(005) value 1.
* Verbos a serem parseados.
01 ws01-verbos.
02 ws02-tokens pic x(256) occurs 256 times.
* Informa<6D><61>es sobre FD e VALUE OF FILE-ID.
01 ws01-fd.
02 ws02-nomefd pic x(031) occurs 256 times.
02 ws02-fileidfd pic x(031) occurs 256 times.
02 ws02-indexed pic x(001) occurs 256 times.
77 ws77-count-fd pic 9(003) value zeros.
* Informa<6D><61>es para la<6C>os de repeti<74><69>o, onde se procura um token.
77 ws77-token pic 9(001) value zeros.
88 ws88-token-nao-encontrado value 0.
88 ws88-token-encontrado value 1.
linkage section.
copy "globals.ls".
procedure division using ws77-arquivo-entrada
ws77-arquivo-saida
ws77-processo.
perform descobrir-informacoes
perform parsear-fonte
perform finalizar
.
******************************************************************
* Procedures principais *
******************************************************************
descobrir-informacoes.
perform varying ws02-i from 1 by 1
until ws02-i >= 256
move spaces to ws02-nomefd(ws02-i) ws02-fileidfd(ws02-i)
move "N" to ws02-indexed(ws02-i)
end-perform
open input arquivo-entrada
if not ws88-ok
perform testar-file-status
end-if
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
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " ACCEPT "
if ws02-i > 0
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " FROM "
if ws02-i > 0
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all
" ESCAPE "
if ws02-i > 0
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all
" KEY"
if ws02-i > 0
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for characters
before " ACCEPT "
add 8 to ws02-i
move zeros to ws02-j
inspect ws77-linha-para-parsing
tallying ws02-j for characters
before " FROM "
compute ws02-k = ws02-j - ws02-i
add 1 to ws02-k
move ws77-linha-para-parsing
(ws02-i:ws02-k)
to ws77-crt-status-field
move ws02-k to ws77-crt-status-length
set ws88-precisa-crt-status to true
end-if
end-if
end-if
else
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " IDENTIFICATION "
if ws02-i > 0
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " DIVISION"
if ws02-i > 0
set ws88-existe-id to true
move ws77-conta-linha to ws77-linha-id
end-if
else
if not ws88-existe-id
set ws88-nao-existe-id to true
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " ENVIRONMENT "
if ws02-i > 0
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " DIVISION"
if ws02-i > 0
set ws88-existe-ed to true
move ws77-conta-linha to ws77-linha-ed
end-if
else
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " SELECT "
if ws02-i > 0
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " NOT "
if ws02-i > 0
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " OPTIONAL "
if ws02-i > 0
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for characters
before " OPTIONAL "
add 10 to ws02-i
end-if
else
*> move zeros to ws02-i
*> inspect ws77-linha-para-parsing
*> tallying ws02-i for all " OPTIONAL "
*> if ws02-i > 0
*> move zeros to ws02-i
*> inspect ws77-linha-para-parsing
*> tallying ws02-i for characters
*> before " OPTIONAL "
*> add 10 to ws02-i
*> else
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for characters
before " SELECT "
add 8 to ws02-i
*> end-if
end-if
move zeros to ws02-j
inspect ws77-linha-para-parsing
tallying ws02-j for all " ASSIGN "
if ws02-j > 0
move zeros to ws02-j
inspect ws77-linha-para-parsing
tallying ws02-j for characters
before " ASSIGN "
add 2 to ws02-j
add 1 to ws77-count-fd
perform varying ws02-l
from ws02-i by 1
until ws77-linha-para-parsing
(ws02-l:1)
not equal spaces
continue
end-perform
perform varying ws02-m
from ws02-j by -1
until ws77-linha-para-parsing
(ws02-m:1)
not equal spaces
continue
end-perform
compute ws02-k = ws02-m - ws02-l
move reg-arquivo-entrada
(ws02-l:ws02-k)
to ws02-nomefd(ws77-count-fd)
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " TO "
if ws02-i > 0
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for characters
before " TO "
add 4 to ws02-i
perform varying ws02-l
from ws02-i by 1
until ws77-linha-para-parsing
(ws02-l:1)
not equal spaces
continue
end-perform
perform varying ws02-m
from 256 by -1
until ws77-linha-para-parsing
(ws02-m:1)
not equal spaces
continue
end-perform
compute ws02-n = 256 - ws02-m
compute ws02-o =
(ws02-m + 1) - ws02-l
if ws88-processo-verboso
display "L: " ws02-l
display "M: " ws02-m
display "N; " ws02-n
display "O: " ws02-o
end-if
move reg-arquivo-entrada
(ws02-l:ws02-o)
to ws02-fileidfd(ws77-count-fd)
if ws88-processo-verboso
display "File-id: "
ws02-fileidfd(ws77-count-fd)
end-if
read arquivo-entrada
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
" ORGANIZATION "
if ws02-i > 0
move zeros to ws02-i
inspect
ws77-linha-para-parsing
tallying ws02-i for all
" INDEXED "
if ws02-i > 0
if ws88-processo-verboso
display "Tem indexed"
end-if
move "Y" to
ws02-indexed
(ws77-count-fd)
else
if ws88-processo-verboso
display "<22> tem indexed"
end-if
move "N" to
ws02-indexed
(ws77-count-fd)
end-if
else
move "N" to
ws02-indexed(ws77-count-fd)
end-if
end-if
end-if
else
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " FD "
if ws02-i > 0
perform testes-fd
end-if
end-if
end-if
end-if
end-if
add 1 to ws77-conta-linha
end-perform
add 1 to ws77-count-fd
if ws88-processo-verboso
perform varying ws02-i from 1 by 1
until ws02-i >= 256
or ws02-nomefd(ws02-i) equal spaces
display "NomeFD " ws02-i ":" ws02-nomefd(ws02-i)
display "FileID " ws02-i ":" ws02-fileidfd(ws02-i)
display "Indexed?" ws02-i ":" ws02-indexed(ws02-i)
end-perform
end-if
close arquivo-entrada
.
parsear-fonte.
move 1 to ws77-conta-linha
open input arquivo-entrada
if not ws88-ok
perform testar-file-status
end-if
open output arquivo-saida
if ws88-nao-existe-id
write reg-arquivo-saida from
" IDENTIFICATION DIVISION."
move spaces to reg-arquivo-saida
string " PROGRAM-ID. " ws77-arquivo-entrada(1:6)
"." into reg-arquivo-saida
write reg-arquivo-saida
write reg-arquivo-saida from spaces
if ws88-nao-existe-ed
if ws88-precisa-crt-status
write reg-arquivo-saida from
" ENVIRONMENT DIVISION."
write reg-arquivo-saida from
" CONFIGURATION SECTION."
write reg-arquivo-saida from
" SPECIAL-NAMES."
string " CRT STATUS IS "
ws77-crt-status-field(1:ws77-crt-status-length)
"." into reg-arquivo-saida
write reg-arquivo-saida
end-if
end-if
end-if
perform until ws88-fim-arquivo
read arquivo-entrada
if not ws88-fim-arquivo
if ws88-processo-verboso
display "No..: " ws77-conta-linha
display "Desc: " reg-arquivo-entrada
end-if
inspect reg-arquivo-entrada
replacing all " COMP-X"
by " COMP "
inspect reg-arquivo-entrada
replacing all " comp-x"
by " COMP "
move reg-arquivo-entrada
to ws77-linha-para-parsing
inspect ws77-linha-para-parsing
converting ws02-minusculo
to ws02-maiusculo
perform testes-geral
end-if
end-perform
close arquivo-entrada
close arquivo-saida
.
mais-testes.
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all ' SELECT '
if ws02-i > 0
if ws88-processo-verboso
display "Testes de select"
end-if
perform testes-select
else
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all ' CANCEL '
if ws02-i > 0
if ws88-processo-verboso
display "Testes de cancel"
end-if
perform testes-cancel
else
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " VALUE "
if ws02-i > 0
if ws88-processo-verboso
display "Testes de VALUE"
end-if
perform testes-value
else
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " MOVE "
if ws02-i > 0
if ws88-processo-verboso
display "Testes de move"
end-if
perform testes-move
else
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all ' "'
if ws02-i > 0
if ws88-processo-verboso
display "Testes de aspas duplas"
end-if
perform testes-aspas-duplas
else
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " -"
if ws02-i > 0
if ws88-processo-verboso
display "Testes de hifen"
end-if
perform testes-hifen
else
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " LABEL "
if ws02-i > 0
if ws88-processo-verboso
display "Teste de label"
end-if
perform testes-label
else
write reg-arquivo-saida
from reg-arquivo-entrada
end-if
end-if
end-if
end-if
end-if
end-if
end-if
.
finalizar.
exit program
.
*****************************************************************
* Procedures secundarias *
*****************************************************************
testes-lock.
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " MODE "
if ws02-i > 0
if ws88-processo-verboso
display "Encontrou clausula LOCK MODE"
display "Nao grava linha"
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all "."
if ws02-i > 0
move " ." to reg-arquivo-saida
write reg-arquivo-saida
else
set ws88-nao-grava-linha to true
end-if
else
write reg-arquivo-saida
from reg-arquivo-entrada
end-if
.
testes-label.
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " RECORD "
if ws02-i > 0
if ws88-processo-verboso
display "Encontrou clausula LABEL RECORD."
display "Nao grava linha"
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all "."
if ws02-i > 0
move " ." to reg-arquivo-saida
write reg-arquivo-saida
else
set ws88-nao-grava-linha to true
end-if
else
write reg-arquivo-saida
from reg-arquivo-entrada
end-if
.
testes-data.
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " RECORD "
if ws02-i > 0
if ws88-processo-verboso
display "Encontrou DATA RECORD!"
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all "."
if ws02-i > 0
move " ." to reg-arquivo-entrada
set ws88-grava-linha to true
else
set ws88-nao-grava-linha to true
end-if
else
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " RECORDS "
if ws02-i > 0
if ws88-processo-verboso
display "Encontrou DATA RECORDS!"
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all "."
if ws02-i > 0
move " ." to reg-arquivo-entrada
set ws88-grava-linha to true
else
set ws88-nao-grava-linha to true
end-if
else
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " DIVISION"
if ws02-i > 0
if ws88-processo-verboso
display "Encontrou DATA DIVISION!"
end-if
if ws88-nao-existe-ed
write reg-arquivo-saida from
" ENVIRONMENT DIVISION."
if ws88-precisa-crt-status
write reg-arquivo-saida from
" CONFIGURATION SECTION."
write reg-arquivo-saida from
" SPECIAL-NAMES."
string " CRT STATUS IS "
ws77-crt-status-field
(1:ws77-crt-status-length)
"." into reg-arquivo-saida
write reg-arquivo-saida
end-if
end-if
write reg-arquivo-saida from spaces
end-if
end-if
end-if
if ws88-grava-linha
write reg-arquivo-saida from reg-arquivo-entrada
end-if
.
testes-display.
set ws88-display-nao-terminado to true
perform until ws88-display-terminado
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " AT "
if ws02-i > 0
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " LINE "
if ws02-i > 0
if ws88-processo-verboso
display "Encontrou LINE, vai retirar o AT."
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for characters
before " AT "
if ws02-i > 0
add 1 to ws02-i
move spaces
to reg-arquivo-entrada(ws02-i:4)
ws77-linha-para-parsing(ws02-i:4)
end-if
else
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " PROMPT "
if ws02-i > 0
if ws88-processo-verboso
display "Encontrou o PROMPT, vai remove-lo"
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for characters
before " PROMPT "
if ws02-i > 0
add 1 to ws02-i
move spaces
to reg-arquivo-entrada(ws02-i:8)
ws77-linha-para-parsing(ws02-i:8)
end-if
else
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all
" BACKGROUND-COLOR "
if ws02-i > 0
if ws88-processo-verboso
display " Encontrou o BACKGROUND-COLOR
- " vai remove-lo"
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for characters
before " BACKGROUND-COLOR "
if ws02-i > 0
add 1 to ws02-i
move spaces
to reg-arquivo-entrada(ws02-i:18)
ws77-linha-para-parsing
(ws02-i:18)
add 18 to ws02-i
perform varying ws02-j
from ws02-i by 1
until ws77-linha-para-parsing
(ws02-j:1)
not equal spaces or ws02-j >= 256
continue
end-perform
perform varying ws02-i
from ws02-j by 1
until ws77-linha-para-parsing
(ws02-i:1)
equal spaces or ws02-j >= 256
move spaces
to ws77-linha-para-parsing
(ws02-i:1)
move spaces
to reg-arquivo-entrada
(ws02-i:1)
end-perform
end-if
else
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all
" FOREGROUND-COLOR "
if ws02-i > 0
if ws88-processo-verboso
display " Encontrou o FOREGROUND-C
- "OLOR vai remove-lo"
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for characters
before " FOREGROUND-COLOR "
if ws02-i > 0
add 1 to ws02-i
move spaces
to reg-arquivo-entrada
(ws02-i:18)
ws77-linha-para-parsing
(ws02-i:18)
end-if
add 18 to ws02-i
perform varying ws02-j from ws02-i by 1
until ws77-linha-para-parsing(ws02-j:1)
not equal spaces
or ws02-j >= 256
continue
end-perform
perform varying ws02-i from ws02-j by 1
until ws77-linha-para-parsing(ws02-i:1)
equal spaces
or ws02-j >= 256
move spaces
to ws77-linha-para-parsing(ws02-i:1)
move spaces
to reg-arquivo-entrada(ws02-i:1)
end-perform
else
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all
" AUTO-SKIP "
if ws02-i > 0
if ws88-processo-verboso
display " Encontrou o AUTO-SKI
- "P sera substituido pe
- "lo AUTO"
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for characters
before " AUTO-SKIP "
if ws02-i > 0
add 1 to ws02-i
move spaces
to reg-arquivo-entrada
(ws02-i:10)
ws77-linha-para-parsing
(ws02-i:10)
move " AUTO "
to reg-arquivo-entrada
(ws02-i:6)
ws77-linha-para-parsing
(ws02-i:6)
end-if
else
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all
" WITH "
if ws02-i > 0
if ws88-processo-verboso
display " Encontrou o WITH
- " que sera removido."
end-if
move zeros to ws02-i
inspect
ws77-linha-para-parsing
tallying ws02-i
for characters
before " WITH "
if ws02-i > 0
add 1 to ws02-i
move spaces
to reg-arquivo-entrada
(ws02-i:6)
ws77-linha-para-parsing
(ws02-i:6)
move spaces
to reg-arquivo-entrada
(ws02-i:6)
ws77-linha-para-parsing
(ws02-i:6)
end-if
else
perform tmp-display-bgfgcolor
end-if
end-if
end-if
end-if
end-if
end-if
else
write reg-arquivo-saida
from reg-arquivo-entrada
set ws88-display-terminado to true
end-if
end-perform
.
testes-accept.
set ws88-accept-nao-terminado to true
perform until ws88-accept-terminado
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " AT "
if ws02-i > 0
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " LINE "
if ws02-i > 0
if ws88-processo-verboso
display "Encontrou LINE, vai retirar o AT."
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for characters
before " AT "
if ws02-i > 0
add 1 to ws02-i
move spaces
to reg-arquivo-entrada(ws02-i:4)
ws77-linha-para-parsing(ws02-i:4)
end-if
else
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " PROMPT "
if ws02-i > 0
if ws88-processo-verboso
display "Encontrou o PROMPT, vai remove-lo"
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for characters
before " PROMPT "
if ws02-i > 0
add 1 to ws02-i
move spaces
to reg-arquivo-entrada(ws02-i:8)
ws77-linha-para-parsing(ws02-i:8)
end-if
else
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all
" BACKGROUND-COLOR "
if ws02-i > 0
if ws88-processo-verboso
display " Encontrou o BACKGROUND-COLO
- "R vai remove-lo"
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for characters
before " BACKGROUND-COLOR "
if ws02-i > 0
add 1 to ws02-i
move spaces
to reg-arquivo-entrada(ws02-i:18)
ws77-linha-para-parsing
(ws02-i:18)
add 18 to ws02-i
perform varying ws02-j
from ws02-i by 1
until ws77-linha-para-parsing
(ws02-j:1)
not equal spaces or ws02-j >= 256
continue
end-perform
perform varying ws02-i
from ws02-j by 1
until ws77-linha-para-parsing
(ws02-i:1)
equal spaces or ws02-j >= 256
move spaces
to ws77-linha-para-parsing
(ws02-i:1)
move spaces
to reg-arquivo-entrada
(ws02-i:1)
end-perform
end-if
else
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all
" FOREGROUND-COLOR "
if ws02-i > 0
if ws88-processo-verboso
display " Encontrou o FOREGROUND-C
- "OLOR vai remove-lo"
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for characters
before " FOREGROUND-COLOR "
if ws02-i > 0
add 1 to ws02-i
move spaces
to reg-arquivo-entrada
(ws02-i:18)
ws77-linha-para-parsing
(ws02-i:18)
end-if
add 18 to ws02-i
perform varying ws02-j
from ws02-i by 1
until ws77-linha-para-parsing
(ws02-j:1)
not equal spaces or ws02-j >= 256
continue
end-perform
perform varying ws02-i
from ws02-j by 1
until ws77-linha-para-parsing
(ws02-i:1)
equal spaces or ws02-j >= 256
move spaces
to ws77-linha-para-parsing
(ws02-i:1)
move spaces
to reg-arquivo-entrada
(ws02-i:1)
end-perform
else
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all
" AUTO-SKIP "
if ws02-i > 0
if ws88-processo-verboso
display " Encontrou o AUTO-SKI
- "P sera substituido pe
- "lo AUTO"
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for characters
before " AUTO-SKIP "
if ws02-i > 0
add 1 to ws02-i
move spaces
to reg-arquivo-entrada
(ws02-i:10)
ws77-linha-para-parsing
(ws02-i:10)
move " AUTO "
to reg-arquivo-entrada
(ws02-i:6)
ws77-linha-para-parsing
(ws02-i:6)
end-if
else
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all
" WITH "
if ws02-i > 0
if ws88-processo-verboso
display " Encontrou o WITH
- " que sera removido."
end-if
move zeros to ws02-i
inspect
ws77-linha-para-parsing
tallying ws02-i
for characters
before " WITH "
if ws02-i > 0
add 1 to ws02-i
move spaces
to reg-arquivo-entrada
(ws02-i:6)
ws77-linha-para-parsing
(ws02-i:6)
move spaces
to reg-arquivo-entrada
(ws02-i:6)
ws77-linha-para-parsing
(ws02-i:6)
end-if
else
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all
" BEEP"
if ws02-i > 0
if ws88-processo-verboso
display " Encontrou o
- " BEEP que sera removi
- "do."
end-if
move zeros to ws02-i
inspect
ws77-linha-para-parsing
tallying ws02-i
for characters
before " BEEP"
if ws02-i > 0
add 1 to ws02-i
move spaces
to reg-arquivo-entrada
(ws02-i:6)
ws77-linha-para-parsing
(ws02-i:6)
move spaces
to reg-arquivo-entrada
(ws02-i:6)
ws77-linha-para-parsing
(ws02-i:6)
end-if
else
perform tmp-accept-bgfgcolor
end-if
end-if
end-if
end-if
end-if
end-if
else
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " FROM "
if ws02-i > 0
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " ESCAPE "
if ws02-i > 0
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " KEY"
if ws02-i > 0
set ws88-accept-terminado to true
end-if
else
write reg-arquivo-saida
from reg-arquivo-entrada
set ws88-accept-terminado to true
end-if
else
write reg-arquivo-saida
from reg-arquivo-entrada
set ws88-accept-terminado to true
end-if
end-if
end-perform
.
testes-delete.
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " DELETE "
if ws02-i > 0
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " FILE "
if ws02-i > 0
set ws88-nao-grava-linha to true
end-if
end-if
if ws88-grava-linha
write reg-arquivo-saida from reg-arquivo-entrada
end-if
.
testes-call.
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for characters before " CALL "
add 6 to ws02-i
move zeros to ws02-j
inspect ws77-linha-para-parsing
tallying ws02-j for all " USING "
if ws02-j > 0
move zeros to ws02-j
inspect ws77-linha-para-parsing
tallying ws02-j for characters before " USING "
if ws02-j > 0
compute ws02-k = ws02-j - ws02-i
move zeros to ws02-l
inspect ws77-linha-para-parsing
tallying ws02-l for all 'X"AF"'
if ws02-l > 0
set ws88-nao-grava-linha to true
else
move zeros to ws02-l
inspect ws77-linha-para-parsing
tallying ws02-l for all 'X"91"'
if ws02-l > 0
set ws88-nao-grava-linha to true
else
inspect reg-arquivo-entrada(ws02-i:ws02-k)
converting ws02-maiusculo
to ws02-minusculo
end-if
end-if
end-if
end-if
if ws88-grava-linha
write reg-arquivo-saida from reg-arquivo-entrada
end-if
.
testes-id.
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " DIVISION"
if ws02-i > 0
if ws88-processo-verboso
display "Encontrou IDENTIFICATION DIVISION!"
end-if
write reg-arquivo-saida from reg-arquivo-entrada
read arquivo-entrada
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 " PROGRAM-ID"
if ws02-i <= 0
if ws88-processo-verboso
display "Nao encontrou PROGRAM-ID!"
end-if
string " PROGRAM-ID. " ws77-arquivo-entrada(1:6)
"." into reg-arquivo-saida
inspect reg-arquivo-saida
converting ws02-maiusculo
to ws02-minusculo
write reg-arquivo-saida
else
if ws88-processo-verboso
display "Encontrou PROGRAM-ID!"
end-if
inspect reg-arquivo-entrada
converting ws02-maiusculo
to ws02-minusculo
write reg-arquivo-saida from reg-arquivo-entrada
end-if
.
testes-ed.
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " DIVISION"
if ws02-i > 0
if ws88-processo-verboso
display "Encontrou ENVIRONMENT DIVISION!"
end-if
write reg-arquivo-saida from reg-arquivo-entrada
read arquivo-entrada
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 " CONFIGURATION "
if ws02-i > 0
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " SECTION"
if ws02-i > 0
if ws88-processo-verboso
display "Encontrou CONFIGURATION SECTION!"
end-if
write reg-arquivo-saida from reg-arquivo-entrada
read arquivo-entrada
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 " SOURCE-COMPUTER"
if ws02-i > 0
if ws88-processo-verboso
display "Encontrou SOURCE-COMPUTER!"
end-if
write reg-arquivo-saida
from reg-arquivo-entrada
read arquivo-entrada
move reg-arquivo-entrada
to ws77-linha-para-parsing
inspect ws77-linha-para-parsing
converting ws02-minusculo
to ws02-maiusculo
else
set ws88-finaliza-parsing to true
write reg-arquivo-saida
from reg-arquivo-entrada
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " SPECIAL-NAMES"
if ws02-i > 0
if ws88-processo-verboso
display "Encontrou SPECIAL-NAMES!"
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all
" DECIMAL-POINT"
if ws02-i > 0
if ws88-processo-verboso
display "Encontrou DECIMAL-POINT na m
- "esma linha da SPECIAL-NAMES"
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for characters
before " DECIMAL-POINT"
if ws02-i > 0
move spaces
to reg-arquivo-saida
move reg-arquivo-entrada
(1:ws02-i)
to reg-arquivo-saida
write reg-arquivo-saida
end-if
else
if ws88-continua-parsing
write reg-arquivo-saida
from reg-arquivo-entrada
end-if
end-if
move spaces to reg-arquivo-saida
if ws88-precisa-crt-status
if ws88-processo-verboso
display "Precisa de CRT STATUS!"
end-if
string " CRT STATUS IS "
ws77-crt-status-field
(1:ws77-crt-status-length)
into reg-arquivo-saida
write reg-arquivo-saida
set ws88-nao-grava-linha to true
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all
" DECIMAL-POINT"
if ws02-i > 0
if ws88-processo-verboso
display "Encontrou DECIMAL-POINT na
- "mesma linha da SPECIAL-NAM
- "ES"
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for characters
before " DECIMAL-POINT"
if ws02-i > 0
add 2 to ws02-i
compute ws02-j = 256 - ws02-i
move spaces
to reg-arquivo-saida
move reg-arquivo-entrada
(ws02-i:ws02-j)
to reg-arquivo-saida(12:242)
write reg-arquivo-saida
end-if
end-if
end-if
end-if
end-if
end-if
.
testes-aspas-duplas.
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for characters before ' "'
if ws02-i = 6
if ws88-processo-verboso
display "Encontrou aspas duplas, acertando-as para a
- " coluna 12"
end-if
add 2 to ws02-i
compute ws02-j = 256 - ws02-i
move spaces to reg-arquivo-saida(1:11)
move reg-arquivo-entrada(ws02-i:ws02-j)
to reg-arquivo-saida(12:244)
if reg-arquivo-saida(73:183) not equal spaces
if ws88-processo-verboso
display "Linha n<>o acabou, os testes devem ser fe
- "itos pelo testes-hifen"
end-if
set ws88-nao-terminou-linha to true
move reg-arquivo-saida(73:183)
to ws77-linha-temporaria
move spaces to reg-arquivo-saida(73:183)
end-if
write reg-arquivo-saida
move zeros to ws02-i
inspect ws77-linha-temporaria
tallying ws02-i for all '"'
if ws02-i > 0
move spaces to reg-arquivo-saida
move ' - "' to reg-arquivo-saida(1:12)
move ws77-linha-temporaria
to reg-arquivo-saida(13:)
write reg-arquivo-saida
move spaces to ws77-linha-temporaria
set ws88-terminou-linha to true
end-if
else
move zeros to ws02-j
inspect ws77-linha-para-parsing
tallying ws02-j for characters before ' -'
if ws02-j = 5
perform testes-hifen
else
write reg-arquivo-saida
from reg-arquivo-entrada
end-if
end-if
.
testes-hifen.
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for characters before " -"
if ws02-i = 5
if ws88-processo-verboso
display "Encontrado hifen"
end-if
set ws88-linha-continuada to true
move zeros to ws02-m
inspect ws77-linha-para-parsing
tallying ws02-m for all '"'
if ws02-m >= 2
if ws88-processo-verboso
display "Ultima linha!"
end-if
set ws88-ultima-linha to true
end-if
move zeros to ws02-n
inspect ws77-linha-para-parsing
tallying ws02-n for characters before '"'
if ws02-n < 11
if ws88-processo-verboso
display "Precisa ser modificado posicionamento"
display "N: " ws02-n
end-if
add 3 to ws02-i
set ws88-continua-parsing to true
else
if ws88-processo-verboso
display "N<>o precisa modificar posicionamento"
display "N: " ws02-n
end-if
move reg-arquivo-entrada to reg-arquivo-saida
set ws88-finaliza-parsing to true
end-if
if ws88-continua-parsing
compute ws02-j = 256 - ws02-i
move spaces to reg-arquivo-saida
move " - " to reg-arquivo-saida(1:11)
if ws88-terminou-linha
if ws88-processo-verboso
display "Linha terminada"
end-if
move reg-arquivo-entrada(ws02-i:ws02-j)
to reg-arquivo-saida(12:244)
else
if ws88-processo-verboso
display "Linha nao terminada"
end-if
move '"' to reg-arquivo-saida(12:1)
perform varying ws02-k from 256 by -1
until ws77-linha-temporaria(ws02-k:1)
not equal spaces
continue
end-perform
move ws77-linha-temporaria(1:ws02-k)
to reg-arquivo-saida(13:ws02-k)
compute ws02-l = 13 + ws02-k
if ws88-processo-verboso
display "Linha ant."
reg-arquivo-saida(1:ws02-l)
end-if
add 1 to ws02-i
subtract 1 from ws02-j
compute ws02-m = 256 - ws02-l
if ws88-processo-verboso
display "I: " ws02-i
display "J: " ws02-j
display "L: " ws02-l
display "K: " ws02-k
display "M: " ws02-m
end-if
move reg-arquivo-entrada(ws02-i:ws02-j)
to reg-arquivo-saida(ws02-l:ws02-m)
if ws88-processo-verboso
display "Linha atual: " reg-arquivo-saida
end-if
end-if
end-if
if reg-arquivo-saida(73:183) not equal spaces
if ws88-processo-verboso
display "Linha nao terminou.. testes-hifen"
end-if
set ws88-nao-terminou-linha to true
move reg-arquivo-saida(73:183)
to ws77-linha-temporaria
move spaces to reg-arquivo-saida(73:183)
else
if ws88-processo-verboso
display "Linha terminou.."
end-if
set ws88-terminou-linha to true
end-if
write reg-arquivo-saida
if ws88-ultima-linha
if ws88-nao-terminou-linha
if ws88-processo-verboso
display "Ultima linha desta instrucao!"
end-if
move spaces to reg-arquivo-saida
move zeros to ws02-i
inspect ws77-linha-temporaria
tallying ws02-i for all '"'
if ws02-i >= 1
move ' - "'
to reg-arquivo-saida(1:12)
move 13 to ws02-k
else
move 12 to ws02-k
end-if
perform varying ws02-i from 256 by -1
until ws77-linha-temporaria(ws02-i:1)
not equal spaces
continue
end-perform
move ws77-linha-temporaria(1:ws02-i)
to reg-arquivo-saida(ws02-k:243)
perform varying ws02-i from 256 by -1
until reg-arquivo-saida(ws02-i:1)
not equal '"'
continue
end-perform
compute ws02-j = 256 - ws02-i
move reg-arquivo-saida(ws02-i:ws02-j)
to ws77-linha-temporaria
move spaces to reg-arquivo-saida(ws02-i:ws02-j)
write reg-arquivo-saida
move spaces to reg-arquivo-saida
move ws77-linha-temporaria
to reg-arquivo-saida(ws02-k:244)
write reg-arquivo-saida
set ws88-terminou-linha to true
end-if
end-if
else
write reg-arquivo-saida from reg-arquivo-entrada
end-if
.
testes-value.
move reg-arquivo-entrada to reg-arquivo-saida
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " OF "
if ws02-i > 0
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " FILE-ID "
if ws02-i > 0
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " FD "
if ws02-i > 0
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for characters before
" VALUE "
if ws02-i > 0
add 1 to ws02-i
compute ws02-j = 256 - ws02-i
move spaces to reg-arquivo-saida
(ws02-i:ws02-j)
move "." to reg-arquivo-saida(ws02-i:1)
write reg-arquivo-saida
end-if
else
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all "."
if ws02-i > 0
* DANILO(
MOVE ZEROS TO W01-CONT1
INSPECT ws77-linha-para-parsing
TALLYING W01-CONT1 FOR ALL '"'
IF W01-CONT1 EQUAL 2 AND
ws02-i NOT EQUAL 2
CONTINUE
ELSE
* DANILO)
move " ." to reg-arquivo-saida
write reg-arquivo-saida
END-IF
*> else
*> write reg-arquivo-saida from spaces
end-if
end-if
else
write reg-arquivo-saida from reg-arquivo-entrada
end-if
else
write reg-arquivo-saida from reg-arquivo-entrada
end-if
.
testes-select.
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " ASSIGN "
if ws02-i > 0
if ws88-processo-verboso
display "Encontrou ASSIGN ..."
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " SELECT "
if ws02-i > 0
if ws88-processo-verboso
display "Encontrou SELECT dentro do teste do ASSI
- "GN"
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " NOT "
if ws02-i > 0
if ws88-processo-verboso
display "Encontrou NOT "
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " OPTIONAL "
if ws02-i > 0
if ws88-processo-verboso
display "Encontrou OPTIONAL "
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for characters
before " OPTIONAL "
add 10 to ws02-i
move zeros to ws02-j
inspect ws77-linha-para-parsing
tallying ws02-j for characters
before " ASSIGN "
add 1 to ws02-j
perform varying ws02-k
from ws02-i by 1
until ws77-linha-para-parsing(ws02-k:1)
not equal spaces
continue
end-perform
perform varying ws02-l
from ws02-j by -1
until ws77-linha-para-parsing(ws02-l:1)
not equal spaces
continue
end-perform
compute ws02-m = (ws02-l + 1) - ws02-k
if ws88-processo-verboso
display "Indice I: " ws02-i
display "Indice M: " ws02-m
display "Indice K: " ws02-k
display "Indice L: " ws02-l
display "nome: "
reg-arquivo-entrada(ws02-k:ws02-m)
end-if
perform varying ws02-n from 1 by 1
until ws02-n >= ws77-count-fd
if ws88-processo-verboso
display "Registro: "
reg-arquivo-entrada(ws02-k:ws02-m)
display "Tabela: " ws02-nomefd(ws02-n)
end-if
if reg-arquivo-entrada(ws02-k:ws02-m)
equal ws02-nomefd(ws02-n)
set ws88-nao-grava-linha to true
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " TO "
if ws02-i > 0
if ws88-processo-verboso
display "Encontrou TO"
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " DISK "
if ws02-i > 0
if ws88-processo-verboso
display "Encontrou DISK"
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i
for characters before
" DISK "
move reg-arquivo-entrada
(1:ws02-i)
to reg-arquivo-saida
add 1 to ws02-i
compute ws02-j = 256 - ws02-i
string " EXTERNAL "
ws02-fileidfd(ws02-n)
delimited by size
into reg-arquivo-saida
(ws02-i:ws02-j)
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for characters
before " NOT "
add 1 to ws02-i
move spaces
to reg-arquivo-saida(ws02-i:4)
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i
for characters before
" OPTIONAL "
if ws02-indexed(ws02-n)
equal "N"
if ws88-processo-verboso
display "<22> adiciona opt
- "ional"
end-if
move spaces
to reg-arquivo-saida
(ws02-i:10)
end-if
if ws88-processo-verboso
display "saida: "
reg-arquivo-saida
end-if
* DANILO
MOVE reg-arquivo-saida TO
W01-TEMP1
PERFORM TIRA-ESPACO
MOVE W01-TEMP2 TO
reg-arquivo-saida
* DANILO
write reg-arquivo-saida
move ws77-count-fd to ws02-n
else
move zeros to ws02-i
inspect
ws77-linha-para-parsing
tallying ws02-i for all
" PRINTER"
if ws02-i > 0
if ws88-processo-verboso
display "Encontrou PRI
- "NTER"
end-if
move zeros to ws02-i
inspect
ws77-linha-para-parsing
tallying ws02-i
for characters before
" PRINTER"
move reg-arquivo-entrada
(1:ws02-i)
to reg-arquivo-saida
add 1 to ws02-i
compute ws02-j =
256 - ws02-i
string " EXTERNAL "
ws02-fileidfd(ws02-n)
delimited by size
into reg-arquivo-saida
(ws02-i:ws02-j)
move zeros to ws02-i
inspect
ws77-linha-para-parsing
tallying ws02-i
for characters
before " NOT "
add 1 to ws02-i
move spaces
to reg-arquivo-saida
(ws02-i:4)
move zeros to ws02-i
inspect
ws77-linha-para-parsing
tallying ws02-i
for characters before
" OPTIONAL "
move spaces
to reg-arquivo-saida
(ws02-i:10)
if ws88-processo-verboso
display "saida: "
reg-arquivo-saida
end-if
* DANILO
MOVE reg-arquivo-saida TO
W01-TEMP1
PERFORM TIRA-ESPACO
MOVE W01-TEMP2 TO
reg-arquivo-saida
* DANILO
write reg-arquivo-saida
move ws77-count-fd
to ws02-n
else
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " NOT "
if ws02-i > 0
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for
characters before " NOT "
add 1 to ws02-i
move spaces to reg-arquivo-entrada
(ws02-i:5)
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all
" OPTIONAL "
if ws02-i > 0
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for
characters before " OPTIONAL "
add 1 to ws02-i
if ws02-indexed(ws02-n)
equal "N"
if ws88-processo-verboso
display "<22> adiciona opti
- "onal"
end-if
move spaces to
reg-arquivo-entrada
(ws02-i:10)
end-if
end-if
end-if
* DANILO( TIRANDO EXCESSO DE ESPACOS
MOVE reg-arquivo-entrada TO W01-TEMP1
PERFORM TIRA-ESPACO
MOVE W01-TEMP2 TO reg-arquivo-entrada
* DANILO)
write reg-arquivo-saida
from reg-arquivo-entrada
end-if
end-if
end-if
else
set ws88-grava-linha to true
end-if
end-perform
if ws88-grava-linha
* DANILO( TIRANDO EXCESSO DE ESPACOS
MOVE reg-arquivo-entrada TO W01-TEMP1
PERFORM TIRA-ESPACO
MOVE W01-TEMP2 TO reg-arquivo-entrada
* DANILO)
write reg-arquivo-saida
from reg-arquivo-entrada
end-if
end-if
else
* move zeros to ws02-i
* inspect ws77-linha-para-parsing
* tallying ws02-i for all " OPTIONAL "
* if ws02-i > 0
* if ws88-processo-verboso
* display "Encontrou OPTIONAL"
* end-if
* move zeros to ws02-i
* inspect ws77-linha-para-parsing
* tallying ws02-i for characters
* before " OPTIONAL "
* add 10 to ws02-i
* move zeros to ws02-j
* inspect ws77-linha-para-parsing
* tallying ws02-j for characters
* before " ASSIGN "
* add 1 to ws02-j
* perform varying ws02-k
* from ws02-i by 1
* until ws77-linha-para-parsing(ws02-k:1)
* not equal spaces
* continue
* end-perform
* perform varying ws02-l
* from ws02-j by -1
* until ws77-linha-para-parsing(ws02-l:1)
* not equal spaces
* continue
* end-perform
* compute ws02-m = (ws02-l + 1) - ws02-k
* if ws88-processo-verboso
* display "Indice I: " ws02-i
* display "Indice M: " ws02-m
* display "Indice K: " ws02-k
* display "Indice L: " ws02-l
* display "nome: "
* reg-arquivo-entrada(ws02-k:ws02-m)
* end-if
* perform varying ws02-n from 1 by 1
* until ws02-n >= ws77-count-fd
* if reg-arquivo-entrada(ws02-k:ws02-m)
* equal ws02-nomefd(ws02-n)
* set ws88-nao-grava-linha to true
* move zeros to ws02-i
* inspect ws77-linha-para-parsing
* tallying ws02-i for all " TO "
* if ws02-i > 0
* move zeros to ws02-i
* inspect ws77-linha-para-parsing
* tallying ws02-i for all " DISK "
* if ws02-i > 0
* move zeros to ws02-i
* inspect ws77-linha-para-parsing
* tallying ws02-i
* for characters before
* " DISK "
* move reg-arquivo-entrada
* (1:ws02-i)
* to reg-arquivo-saida
* add 1 to ws02-i
* compute ws02-j = 256 - ws02-i
* string " EXTERNAL "
* ws02-fileidfd(ws02-n)
* delimited by size
* into
* reg-arquivo-saida(ws02-i:ws02-j)
* move zeros to ws02-i
* inspect ws77-linha-para-parsing
* tallying ws02-i for characters
* before " OPTIONAL "
* add 1 to ws02-i
* move spaces
* to reg-arquivo-saida(ws02-i:10)
* if ws88-processo-verboso
* display "saida; "
* reg-arquivo-saida
* end-if
* write reg-arquivo-saida
* move ws77-count-fd to ws02-n
* else
* move zeros to ws02-i
* inspect ws77-linha-para-parsing
* tallying ws02-i for all
* " PRINTER"
* if ws02-i > 0
* move zeros to ws02-i
* inspect
* ws77-linha-para-parsing
* tallying ws02-i
* for characters before
* " PRINTER"
* move reg-arquivo-entrada
* (1:ws02-i)
* to reg-arquivo-saida
* add 1 to ws02-i
* compute ws02-j =
* 256 - ws02-i
* string " EXTERNAL "
* ws02-fileidfd(ws02-n)
* delimited by size
* into reg-arquivo-saida
* (ws02-i:ws02-j)
* move zeros to ws02-i
* inspect
* ws77-linha-para-parsing
* tallying ws02-i
* for characters before
* " OPTIONAL "
* add 1 to ws02-i
* move spaces
* to reg-arquivo-saida
* (ws02-i:10)
* if ws88-processo-verboso
* display "saida; "
* reg-arquivo-saida
* end-if
* write reg-arquivo-saida
* move ws77-count-fd to ws02-n
* else
* move zeros to ws02-i
* inspect ws77-linha-para-parsing
* tallying ws02-i for all
* " OPTIONAL "
* if ws02-i > 0
* move zeros to ws02-i
* inspect ws77-linha-para-parsing
* tallying ws02-i for
* characters before " OPTIONAL "
* add 1 to ws02-i
* move spaces
* to
* reg-arquivo-entrada(ws02-i:10)
* end-if
* set ws88-grava-linha to true
* end-if
* end-if
* end-if
* else
* set ws88-grava-linha to true
* end-if
* end-perform
* if ws88-grava-linha
* write reg-arquivo-saida
* from reg-arquivo-entrada
* end-if
* else
if ws88-processo-verboso
display "Select simples"
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for characters
before " SELECT "
add 08 to ws02-i
move zeros to ws02-j
inspect ws77-linha-para-parsing
tallying ws02-j for characters
before " ASSIGN "
add 1 to ws02-j
perform varying ws02-k
from ws02-i by 1
until ws77-linha-para-parsing(ws02-k:1)
not equal spaces
continue
end-perform
perform varying ws02-l
from ws02-j by -1
until ws77-linha-para-parsing(ws02-l:1)
not equal spaces
continue
end-perform
if ws88-processo-verboso
display "Indice I: " ws02-i
display "Indice M: " ws02-m
display "Indice K: " ws02-k
display "Indice L: " ws02-l
end-if
compute ws02-m = (ws02-l + 1) - ws02-k
if ws88-processo-verboso
display "nome: "
reg-arquivo-entrada(ws02-k:ws02-m)
end-if
perform varying ws02-n from 1 by 1
until ws02-n >= ws77-count-fd
if reg-arquivo-entrada(ws02-k:ws02-m)
equal ws02-nomefd(ws02-n)
set ws88-nao-grava-linha to true
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " TO "
if ws02-i > 0
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " DISK "
if ws02-i > 0
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i
for characters before
" SELECT "
add 8 to ws02-i
move reg-arquivo-entrada
(1:ws02-i)
to reg-arquivo-saida
if ws88-processo-verboso
display "registro 1: "
reg-arquivo-saida
end-if
perform varying ws02-j
from 256 by -1 until
reg-arquivo-saida
(ws02-j:1)
not equal spaces
continue
end-perform
add 1 to ws02-j
if ws02-indexed(ws02-n)
equal "Y"
compute ws02-k =
256 - ws02-j
move " OPTIONAL "
to reg-arquivo-saida
(ws02-j:ws02-k)
end-if
if ws88-processo-verboso
display "registro 2: "
reg-arquivo-saida
end-if
add 10 to ws02-j
move zeros to ws02-l
inspect ws77-linha-para-parsing
tallying ws02-l for all
" TO "
if ws02-l > 0
move zeros to ws02-l
inspect
ws77-linha-para-parsing
tallying ws02-l for
characters before " TO "
add 4 to ws02-l
compute ws02-m =
ws02-l - ws02-i
move reg-arquivo-entrada
(ws02-i:ws02-m)
to reg-arquivo-saida
(ws02-j:)
if ws88-processo-verboso
display "registro 3: "
reg-arquivo-saida
end-if
end-if
perform varying ws02-j
from 256 by -1
until reg-arquivo-saida
(ws02-j:1)
not equal spaces
continue
end-perform
add 1 to ws02-j
move zeros to ws02-s
inspect ws02-fileidfd(ws02-n)
tallying ws02-s
for all '\'
if ws02-s > 0
move zeros to ws02-s
move ws02-fileidfd(ws02-n)
to ws77-linha-temporaria
inspect
ws02-fileidfd(ws02-n)
tallying ws02-s for
characters before
"\"
add 1 to ws02-s
move "/"
to ws77-linha-temporaria
(ws02-s:1)
move ws77-linha-temporaria
to ws02-fileidfd(ws02-n)
end-if
string " EXTERNAL "
ws02-fileidfd(ws02-n)
delimited by size
into reg-arquivo-saida
(ws02-j:)
if ws88-processo-verboso
display "Saida: "
reg-arquivo-saida
end-if
* DANILO(TIRANDO EXCESSO DE ESPACOS
MOVE reg-arquivo-saida TO
W01-TEMP1
PERFORM TIRA-ESPACO
MOVE W01-TEMP2 TO
reg-arquivo-saida
* DANILO)
write reg-arquivo-saida
move ws77-count-fd to ws02-n
else
move zeros to ws02-i
inspect
ws77-linha-para-parsing
tallying ws02-i for all
" PRINTER"
if ws02-i > 0
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i
for characters before
" PRINTER"
move reg-arquivo-entrada
(1:ws02-i)
to reg-arquivo-saida
add 1 to ws02-i
compute ws02-j = 256 - ws02-i
* DANILO
MOVE ZEROS TO W01-CONT1
INSPECT WS02-FILEIDFD(WS02-N)
TALLYING W01-CONT1 FOR ALL "."
IF W01-CONT1 EQUAL ZEROS
STRING WS02-FILEIDFD(WS02-N)
DELIMITED BY " "
"." DELIMITED SIZE
INTO WS02-FILEIDFD(WS02-N)
END-IF
* DANILO
string " EXTERNAL "
ws02-fileidfd(ws02-n)
delimited by size
into reg-arquivo-saida
(ws02-i:ws02-j)
if ws88-processo-verboso
display "Saida: "
reg-arquivo-saida
end-if
* DANILO( TIRANDO EXCESSO DE ESPACOS
MOVE reg-arquivo-saida TO
W01-TEMP1
PERFORM TIRA-ESPACO
MOVE W01-TEMP2 TO
reg-arquivo-saida
* DANILO)
write reg-arquivo-saida
move ws77-count-fd to ws02-n
else
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i
for characters before
" SELECT "
add 8 to ws02-i
move reg-arquivo-entrada
(1:ws02-i)
to reg-arquivo-saida
if ws88-processo-verboso
display "registro 1: "
reg-arquivo-saida
end-if
perform varying ws02-j
from 256 by -1 until
reg-arquivo-saida
(ws02-j:1)
not equal spaces
continue
end-perform
add 1 to ws02-j
if ws02-indexed(ws02-n)
equal "Y"
compute ws02-k =
256 - ws02-j
move " OPTIONAL "
to reg-arquivo-saida
(ws02-j:ws02-k)
end-if
if ws88-processo-verboso
display "registro 2: "
reg-arquivo-saida
end-if
add 10 to ws02-j
move zeros to ws02-l
inspect ws77-linha-para-parsing
tallying ws02-l for all
" TO "
if ws02-l > 0
move zeros to ws02-l
inspect
ws77-linha-para-parsing
tallying ws02-l for
characters before " TO "
add 4 to ws02-l
compute ws02-m =
ws02-l - ws02-i
move reg-arquivo-entrada
(ws02-i:ws02-m)
to reg-arquivo-saida
(ws02-j:)
if ws88-processo-verboso
display "registro 3: "
reg-arquivo-saida
end-if
end-if
perform varying ws02-j
from 256 by -1
until reg-arquivo-saida
(ws02-j:1)
not equal spaces
continue
end-perform
add 1 to ws02-j
compute ws02-r
= 256 - ws02-i
string " EXTERNAL "
ws02-fileidfd(ws02-n)
delimited by size
into reg-arquivo-saida
(ws02-j:ws02-r)
if ws88-processo-verboso
display "Saida: "
reg-arquivo-saida
end-if
* DANILO( TIRANDO EXCESSO DE ESPACOS
MOVE reg-arquivo-saida TO
W01-TEMP1
PERFORM TIRA-ESPACO
MOVE W01-TEMP2 TO
reg-arquivo-saida
* DANILO)
write reg-arquivo-saida
move ws77-count-fd
to ws02-n
end-if
end-if
end-if
else
set ws88-grava-linha to true
end-if
end-perform
if ws88-grava-linha
* DANILO( TIRANDO EXCESSO DE ESPACOS
MOVE reg-arquivo-entrada TO W01-TEMP1
PERFORM TIRA-ESPACO
MOVE W01-TEMP2 TO reg-arquivo-entrada
* DANILO)
write reg-arquivo-saida
from reg-arquivo-entrada
end-if
* end-if
end-if
end-if
else
* DANILO( TIRANDO EXCESSO DE ESPACOS
MOVE reg-arquivo-entrada TO W01-TEMP1
PERFORM TIRA-ESPACO
MOVE W01-TEMP2 TO reg-arquivo-entrada
* DANILO)
write reg-arquivo-saida from reg-arquivo-entrada
end-if
.
testes-move.
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all '"$'
if ws02-i > 0
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for characters before '"$'
if ws02-i > 0
move spaces to reg-arquivo-entrada(ws02-i:1)
add 1 to ws02-i
move ' "' to reg-arquivo-entrada(ws02-i:2)
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all "\"
if ws02-i > 0
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for characters before "\"
if ws02-i > 0
add 1 to ws02-i
move "/" to reg-arquivo-entrada(ws02-i:1)
end-if
end-if
write reg-arquivo-saida from reg-arquivo-entrada
else
write reg-arquivo-saida from reg-arquivo-saida
end-if
else
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all ' "'
if ws02-i > 0
perform testes-aspas-duplas
else
write reg-arquivo-saida from reg-arquivo-entrada
end-if
end-if
.
testes-cancel.
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for characters before ' "'
if ws02-i > 0 and ws02-i not equal 256
add 3 to ws02-i
perform varying ws02-j from 256 by -1
until ws77-linha-para-parsing(ws02-j:1)
equal '"'
continue
end-perform
inspect reg-arquivo-entrada(ws02-i:ws02-j)
converting ws02-maiusculo
to ws02-minusculo
write reg-arquivo-saida from reg-arquivo-entrada
else
write reg-arquivo-saida from reg-arquivo-entrada
end-if
.
testes-geral.
set ws88-grava-linha to true
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " LOCK "
if ws02-i > 0
perform testes-lock
else
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " DATA "
if ws02-i > 0
perform testes-data
else
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " ACCEPT "
if ws02-i > 0
perform testes-accept
else
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " DISPLAY "
if ws02-i > 0
perform testes-display
else
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " DELETE "
if ws02-i > 0
perform testes-delete
else
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all
" CALL "
if ws02-i > 0
perform testes-call
else
move zeros to ws02-i
inspect
ws77-linha-para-parsing
tallying ws02-i for all
" IDENTIFICATION "
if ws02-i > 0
perform testes-id
else
move zeros to ws02-i
inspect
ws77-linha-para-parsing
tallying ws02-i for all
" ENVIRONMENT "
if ws02-i > 0
perform testes-ed
else
perform mais-testes
end-if
end-if
end-if
end-if
end-if
end-if
end-if
end-if
add 1 to ws77-conta-linha
.
tmp-display-bgfgcolor.
move zeros to ws02-s
write reg-arquivo-saida from reg-arquivo-entrada
read arquivo-entrada
move reg-arquivo-entrada to ws77-linha-para-parsing
inspect ws77-linha-para-parsing
converting ws02-minusculo
to ws02-maiusculo
perform 3 times
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " DISPLAY "
if ws02-i > 0
if ws88-processo-verboso
display "Tem DISPLAY"
end-if
else
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " FOREGROUND-COLOR "
if ws02-i > 0
if ws88-processo-verboso
display " Encontrou o FOREGROUND-COLOR vai remove
- "-lo"
end-if
set ws88-encontrou-fgcolor to true
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for characters
before " FOREGROUND-COLOR "
if ws02-i > 0
add 1 to ws02-i
move spaces to reg-arquivo-entrada(ws02-i:18)
ws77-linha-para-parsing(ws02-i:18)
add 18 to ws02-i
perform varying ws02-j from ws02-i by 1
until ws77-linha-para-parsing(ws02-j:1)
not equal spaces
or ws02-j >= 256
continue
end-perform
perform varying ws02-i from ws02-j by 1
until ws77-linha-para-parsing(ws02-i:1)
equal spaces
or ws02-j >= 256
move spaces
to ws77-linha-para-parsing(ws02-i:1)
move spaces
to reg-arquivo-entrada(ws02-i:1)
end-perform
end-if
else
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " BACKGROUND-COLOR "
if ws02-i > 0
if ws88-processo-verboso
display " Encontrou o BACKGROUND-COLOR vai re
- "move-lo"
end-if
set ws88-encontrou-bgcolor to true
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i
for characters before
" BACKGROUND-COLOR "
if ws02-i > 0
add 1 to ws02-i
move spaces to reg-arquivo-entrada(ws02-i:18)
ws77-linha-para-parsing(ws02-i:18)
add 18 to ws02-i
perform varying ws02-j from ws02-i by 1
until ws77-linha-para-parsing(ws02-j:1)
not equal spaces
or ws02-j >= 256
continue
end-perform
perform varying ws02-i from ws02-j by 1
until ws77-linha-para-parsing(ws02-i:1)
equal spaces
or ws02-j >= 256
move spaces
to ws77-linha-para-parsing(ws02-i:1)
move spaces
to reg-arquivo-entrada(ws02-i:1)
end-perform
else
if ws88-processo-verboso
display "N<>o encontrou BACKGROUND-COLOR e
- "ira gravar o registro"
end-if
set ws88-display-terminado to true
perform testes-geral
end-if
else
if ws88-processo-verboso
display "N<>o encontrou BACKGROUND-COLOR e nao
- "ir<69> gravar o arquivo"
end-if
set ws88-display-terminado to true
add 1 to ws02-s
end-if
end-if
end-if
end-perform
if ws88-encontrou-fgcolor or ws88-encontrou-bgcolor
set ws88-nao-encontrou-fgcolor to true
set ws88-nao-encontrou-bgcolor to true
write reg-arquivo-saida from reg-arquivo-entrada
end-if
if ws02-s = 3
write reg-arquivo-saida from reg-arquivo-entrada
end-if
.
tmp-accept-bgfgcolor.
move zeros to ws02-s
write reg-arquivo-saida from reg-arquivo-entrada
read arquivo-entrada
move reg-arquivo-entrada to ws77-linha-para-parsing
inspect ws77-linha-para-parsing
converting ws02-minusculo
to ws02-maiusculo
perform 3 times
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " ACCEPT "
if ws02-i > 0
if ws88-processo-verboso
display "Tem ACCEPT"
end-if
else
if ws88-processo-verboso
display "N<>o tem ACCEPT"
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " FOREGROUND-COLOR"
if ws02-i > 0
if ws88-processo-verboso
display " Encontrou o FOREGROUND-COLOR vai remov
- "e-lo"
end-if
set ws88-encontrou-fgcolor to true
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for characters
before " FOREGROUND-COLOR"
if ws02-i > 0
add 1 to ws02-i
move spaces to reg-arquivo-entrada(ws02-i:18)
ws77-linha-para-parsing(ws02-i:18)
add 18 to ws02-i
perform varying ws02-j from ws02-i by 1
until ws77-linha-para-parsing(ws02-j:1)
not equal spaces
or ws02-j >= 256
continue
end-perform
perform varying ws02-i from ws02-j by 1
until ws77-linha-para-parsing(ws02-i:1)
equal spaces
or ws02-j >= 256
move spaces
to ws77-linha-para-parsing(ws02-i:1)
move spaces
to reg-arquivo-entrada(ws02-i:1)
end-perform
end-if
else
if ws88-processo-verboso
display "N<>o encontrou FOREGROUND-COLOR"
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " BACKGROUND-COLOR "
if ws02-i > 0
if ws88-processo-verboso
display " Encontrou o BACKGROUND-COLOR vai re
- "move-lo"
end-if
set ws88-encontrou-bgcolor to true
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i
for characters before
" BACKGROUND-COLOR "
if ws02-i > 0
add 1 to ws02-i
move spaces to reg-arquivo-entrada(ws02-i:18)
ws77-linha-para-parsing(ws02-i:18)
add 18 to ws02-i
perform varying ws02-j from ws02-i by 1
until ws77-linha-para-parsing(ws02-j:1)
not equal spaces
or ws02-j >= 256
continue
end-perform
perform varying ws02-i from ws02-j by 1
until ws77-linha-para-parsing(ws02-i:1)
equal spaces
or ws02-j >= 256
move spaces
to ws77-linha-para-parsing(ws02-i:1)
move spaces
to reg-arquivo-entrada(ws02-i:1)
end-perform
else
if ws88-processo-verboso
display "N<>o encontrou BACKGROUND-COLOR e
- "ira gravar o registro"
end-if
set ws88-accept-terminado to true
perform testes-geral
end-if
else
if ws88-processo-verboso
display "N<>o encontrou BACKGROUND-COLOR e nao
- "ir<69> gravar o arquivo"
end-if
set ws88-accept-terminado to true
add 1 to ws02-s
end-if
end-if
end-if
end-perform
if ws88-encontrou-fgcolor or ws88-encontrou-bgcolor
set ws88-nao-encontrou-fgcolor to true
set ws88-nao-encontrou-bgcolor to true
write reg-arquivo-saida from reg-arquivo-entrada
end-if
if ws02-s = 3
write reg-arquivo-saida from reg-arquivo-entrada
end-if
.
testes-fd.
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for characters before " FD "
add 4 to ws02-i
perform varying ws02-l from ws02-i by 1
until ws77-linha-para-parsing(ws02-l:1)
not equal spaces
continue
end-perform
if ws88-processo-verboso
display "Linha...: " ws77-linha-para-parsing
display "Indice L: " ws02-l
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " VALUE "
if ws02-i > 0
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for characters
before " VALUE "
move ws02-i to ws02-j
else
move 256 to ws02-j
end-if
if ws88-processo-verboso
display "Indice J: " ws02-j
end-if
perform varying ws02-m from ws02-j by -1
until ws77-linha-para-parsing(ws02-m:1)
not equal spaces and "."
continue
end-perform
if ws88-processo-verboso
display "Indice M: " ws02-m
end-if
compute ws02-k = (ws02-m + 1) - ws02-l
if ws88-processo-verboso
display "Indice K: " ws02-k
display "Tamanho count-fd :" ws77-count-fd
end-if
perform varying ws02-n from 1 by 1
until ws02-n > ws77-count-fd
if reg-arquivo-entrada(ws02-l:ws02-k)
equal ws02-nomefd(ws02-n)
if ws88-processo-verboso
display "FD igual :" ws02-nomefd(ws02-n)
", indice " ws02-n
end-if
if ws02-fileidfd(ws02-n) equal "disk" or "DISK" or
"printer" or "PRINTER" or "printer." or "PRINTER."
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " VALUE "
if ws02-i > 0
if ws88-processo-verboso
display "Encontrou VALUE na mesma linha da
- "FD"
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " OF "
if ws02-i > 0
if ws88-processo-verboso
display "Encontrou OF na mesma linha da
- " FD"
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " FILE-ID"
if ws02-i > 0
if ws88-processo-verboso
display "Encontrou FILE-ID ..."
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " IS "
if ws02-i > 0
if ws88-processo-verboso
display "Encontrou IS ..."
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for characters
before " IS "
add 4 to ws02-i
perform varying ws02-o
from ws02-i by 1
until ws77-linha-para-parsing
(ws02-o:1)
not equal spaces
continue
end-perform
perform varying ws02-p
from 256 by -1
until ws77-linha-para-parsing
(ws02-p:1)
not equal spaces
continue
end-perform
move ws02-fileidfd(ws02-n)
to ws77-linha-temporaria
move zeros to ws02-q
inspect ws77-linha-temporaria
tallying ws02-q for all "."
if ws02-q > 0
add 1 to ws02-p
compute ws02-r = ws02-o + ws02-p
move "."
to reg-arquivo-entrada(ws02-r:1)
end-if
move zeros to ws02-q
compute ws02-q = (ws02-p + 1) - ws02-o
if ws88-processo-verboso
display "file-id: "
reg-arquivo-entrada(ws02-o:ws02-q)
end-if
move reg-arquivo-entrada(ws02-o:ws02-p)
to ws02-fileidfd(ws02-n)
else
if ws88-processo-verboso
display "Encontrou FILE-ID ..."
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for characters
before " FILE-ID "
add 9 to ws02-i
perform varying ws02-o
from ws02-i by 1
until ws77-linha-para-parsing
(ws02-o:1)
not equal spaces
continue
end-perform
perform varying ws02-p
from 256 by -1
until ws77-linha-para-parsing
(ws02-p:1)
not equal spaces and "."
continue
end-perform
move ws02-fileidfd(ws02-n)
to ws77-linha-temporaria
move zeros to ws02-q
inspect ws77-linha-temporaria
tallying ws02-q for all "."
if ws02-q > 0
add 1 to ws02-p
compute ws02-r = ws02-o + ws02-p
move "."
to reg-arquivo-entrada(ws02-r:1)
end-if
move zeros to ws02-q
compute ws02-q = (ws02-p + 1) - ws02-o
if ws88-processo-verboso
display "file-id: "
reg-arquivo-entrada(ws02-o:ws02-q)
end-if
move reg-arquivo-entrada(ws02-o:ws02-q)
to ws02-fileidfd(ws02-n)
end-if
end-if
end-if
else
set ws88-token-nao-encontrado to true
perform until ws88-token-encontrado
read arquivo-entrada
move reg-arquivo-entrada
to ws77-linha-para-parsing
inspect ws77-linha-para-parsing
converting ws02-minusculo
to ws02-maiusculo
if ws88-processo-verboso
display "registro: "
ws77-linha-para-parsing
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all
" DATA "
if ws02-i > 0
set ws88-token-nao-encontrado to true
else
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " LABEL "
if ws02-i > 0
set ws88-token-nao-encontrado
to true
else
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " VALUE "
if ws02-i > 0
set ws88-token-encontrado
to true
else
set ws88-token-nao-encontrado
to true
end-if
end-if
end-if
end-perform
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " VALUE "
if ws02-i > 0
if ws88-processo-verboso
display "Encontrou VALUE na outra linha
- "."
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " OF "
if ws02-i > 0
if ws88-processo-verboso
display "Encontrou OF na outra linh
- "a"
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " FILE-ID"
if ws02-i > 0
if ws88-processo-verboso
display "Encontrou FILE-ID ..."
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for all " IS "
if ws02-i > 0
if ws88-processo-verboso
display "Encontrou IS ..."
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for characters
before " IS "
add 4 to ws02-i
perform varying ws02-o
from ws02-i by 1
until ws77-linha-para-parsing
(ws02-o:1)
not equal spaces
continue
end-perform
perform varying ws02-p
from 256 by -1
until ws77-linha-para-parsing
(ws02-p:1)
not equal spaces and "."
continue
end-perform
move ws02-fileidfd(ws02-n)
to ws77-linha-temporaria
move zeros to ws02-q
inspect ws77-linha-temporaria
tallying ws02-q for all "."
if ws02-q > 0
* DANILO(
* MOVE ZEROS TO W01-CONT1
* INSPECT ws77-linha-temporaria
* TALLYING W01-CONT1 FOR ALL '"'
* IF W01-CONT1 EQUAL 2 AND
* ws02-q NOT EQUAL 2
* CONTINUE
* ELSE
* DANILO)
compute ws02-r = ws02-o + ws02-p
move "."
to reg-arquivo-entrada(ws02-r:1)
* END-IF
end-if
move zeros to ws02-q
compute ws02-q = (ws02-p + 1) - ws02-o
if ws88-processo-verboso
display "file-id: "
reg-arquivo-entrada(ws02-o:ws02-q)
end-if
move reg-arquivo-entrada(ws02-o:ws02-q)
to ws02-fileidfd(ws02-n)
else
if ws88-processo-verboso
display "Encontrou FILE-ID"
end-if
move zeros to ws02-i
inspect ws77-linha-para-parsing
tallying ws02-i for characters
before " FILE-ID "
add 9 to ws02-i
perform varying ws02-o
from ws02-i by 1
until ws77-linha-para-parsing
(ws02-o:1)
not equal spaces
continue
end-perform
perform varying ws02-p
from 256 by -1
until ws77-linha-para-parsing
(ws02-p:1)
not equal spaces and "."
continue
end-perform
move ws02-fileidfd(ws02-n)
to ws77-linha-temporaria
move zeros to ws02-q
inspect ws77-linha-temporaria
tallying ws02-q for all "."
if ws02-q > 0
add 1 to ws02-p
compute ws02-r = ws02-o + ws02-p
move "."
to reg-arquivo-entrada(ws02-r:1)
end-if
move zeros to ws02-q
compute ws02-q = (ws02-p + 1) - ws02-o
if ws88-processo-verboso
display "file-id: "
reg-arquivo-entrada(ws02-o:ws02-q)
end-if
move reg-arquivo-entrada(ws02-o:ws02-q)
to ws02-fileidfd(ws02-n)
end-if
end-if
end-if
end-if
end-if
end-if
else
if ws88-processo-verboso
display "FD diferente - tabela :"
ws02-nomefd(ws02-n)
display "FD diferente - arquivo :"
reg-arquivo-entrada(ws02-l:ws02-k)
end-if
end-if
end-perform
.
TIRA-ESPACO.
MOVE ZEROS TO W01-CONT1 W01-CONT2.
SET W88-PRIMEIRO TO TRUE.
MOVE SPACES TO W01-TEMP2.
PERFORM UNTIL W01-CONT1 EQUAL 256
ADD 1 TO W01-CONT1
IF W88-PRIMEIRO AND W03-OCCURS-TEMP1(W01-CONT1)
NOT EQUAL SPACES
SET W88-CARACTER TO TRUE
END-IF
IF W88-ESPACO AND W03-OCCURS-TEMP1(W01-CONT1)
NOT EQUAL SPACES
SET W88-CARACTER TO TRUE
END-IF
IF W88-CARACTER AND W03-OCCURS-TEMP1(W01-CONT1)
EQUAL SPACES
SET W88-ESPACO TO TRUE
ADD 1 TO W01-CONT2
MOVE " " TO W03-OCCURS-TEMP2(W01-CONT2)
END-IF
IF NOT W88-ESPACO
ADD 1 TO W01-CONT2
MOVE W03-OCCURS-TEMP1(W01-CONT1) TO
W03-OCCURS-TEMP2(W01-CONT2)
END-IF
END-PERFORM.
copy "globals.pd".
Reference in New Issue View Git Blame Copy Permalink