Cobol acessando Mysql.

Foi criada uma rotina que possibilita que programas escritos originalmente em Cobol, acessando arquivos Micro Focus (ISAM), possam acessar base de dados em MySql, obtendo os mesmos resultados sem a necessidade de reescrever os programas.

Esta rotina possibilita acessar a base em MySql usando apenas os comando tradicionais do COBOL. "OPEN, START, READ, WRITE, REWRITE, DELETE e CLOSE".

Para tal basta criar as tabelas no MySql, seguindo determinados critérios, transferir os dados dos arquivos em COBOL para as respectivas tabelas, alterar algumas configurações e pronto, é só rodar o programas.

Feito isso, o programa passa a acessar a base de dados em MySql, é só incluir uma linha contendo 'CALLFH"extmysql"' no arquivo 'COBOL.DIR', na pasta onde estão os fontes, ou incluir uma linha no programa 'SET CALLFH"extmysql"' e recompilar seu programa.

Abaixo, programa modelo para converter base de dados gerada no COBOL MF, para Mysql.

 **************************************************************************
 * IMEDIATA INFORMATICA EMPRESARIAL LTDA *
 * PROGRAMA - CnvMfMy - Converte arquivo gerado originalmente em COBOL *
 * para Banco de dados Mysql *
 **************************************************************************
 IDENTIFICATION DIVISION.
 PROGRAM-ID. CnvMfMy.
 AUTHOR. Franco Stringari Pudler.
 ENVIRONMENT DIVISION.
 CONFIGURATION SECTION.
 SPECIAL-NAMES. DECIMAL-POINT IS COMMA.
 INPUT-OUTPUT SECTION.
 FILE-CONTROL.

 *> Informa que o arquivo é padrão MYSQL

 SELECT ARQMYS ASSIGN TO DYNAMIC W-LABMSQ
 ORGANIZATION IS INDEXED
 ACCESS MODE IS DYNAMIC
 LOCK MODE IS MANUAL
 FILE STATUS IS W-STATUS
 RECORD KEY IS MY-LAN
 ALTERNATE RECORD KEY IS MY-CTA
 WITH DUPLICATES.

 *> Informa que próximo arquivo é padrão DEFAULT MF

 SELECT ARQMFS ASSIGN TO DYNAMIC W-LABMFS
 ORGANIZATION IS INDEXED
 ACCESS MODE IS DYNAMIC
 LOCK MODE IS MANUAL
 FILE STATUS IS W-STATUS
 RECORD KEY IS MF-LAN
 ALTERNATE RECORD KEY IS MF-CTA
 WITH DUPLICATES.

 DATA DIVISION.
 FILE SECTION.

 *> Definição do registro do arquivo que será gerado no MySql
 FD ARQMYS.
 01 MY-REG.
 02 MY-SIT PIC X(01).
 02 MY-LAN PIC S9(09) COMP-3.
 02 MY-CTA PIC S9(15) COMP-3.
 02 MY-CDH PIC S9(05) COMP-3.
 02 MY-HST PIC X(30).
 02 MY-DTA PIC S9(09) COMP-3.
 02 MY-VAL PIC S9(13)V99 COMP-3.

 *> Definição do registro do arquivo com os dados originalmente gerados no padrão MF
 FD ARQMFS.
 01 MF-REG.
 02 MF-SIT PIC X(01).
 02 MF-LAN PIC S9(09) COMP-3.
 02 MF-CTA PIC S9(15) COMP-3.
 02 MF-CDH PIC S9(05) COMP-3.
 02 MF-HST PIC X(30).
 02 MF-DTA PIC S9(09) COMP-3.
 02 MF-VAL PIC S9(13)V99 COMP-3.

 WORKING-STORAGE SECTION.
 77 W-LABMFS PIC X(60) VALUE "ARQMFS".
 77 W-LABMSQ PIC X(60) VALUE SPACES.
 77 W-STATUS PIC X(02).
 88 STAT-ERRO VALUE X"3100" THRU X"3943"
 X"3945" THRU X"39EE".

 88 DUPLICADO VALUE "22".

 77 W-MSG PIC X(80) VALUE SPACES.

 LINKAGE SECTION.

 PROCEDURE DIVISION.
 INICIO.

 MOVE "ARQMFS" TO W-LABMFS. *> Define onde estão os dados

 OPEN INPUT ARQMFS. *> Abre arquivo MF
 IF STAT-ERRO *> Verifica se abertura foi OK
 STRING "Abrindo Lote[" W-LABMFS "] Status"
 W-STATUS DELIMITED BY " " INTO W-MSG
 DISPLAY W-MSG *> Comunica causa do problema
 STOP RUN.

 MOVE "@127.0.0.1@3306@root@1234@imediata@ARQMYS"
 TO W-LABMSQ. *> Define parametros para o MySql

 OPEN I-O ARQMYS. *> Abre arquivo no MySql
 IF STAT-ERRO
 DISPLAY "Criando Arquivo de destino"
 STOP RUN.

 MOVE ZEROS TO MF-LAN. *> Define ponto de partida
 START ARQMFS KEY IS NOT LESS THAN MF-LAN. *> Posiciona no registro Cf definido acima
 PERFORM UNTIL STAT-ERRO *> Loop para geração do arquivo
 READ ARQMFS NEXT RECORD *> Recupera registro no arquivo Micro Focus
 AT END DISPLAY "Fim conversão sem problemas" *> Termino sem problemas
 NOT AT END *> Encontrou registro
 MOVE MF-REG TO MY-REG *> Move estrutura MF para Mysql
 WRITE MY-REG *> Grava registro na tabela Mysql
 IF DUPLICADO *> Teste se registro já estava cadastrado
 MOVE ZEROS TO W-STATUS *> Evita encerramento prematuro caso registro já exista
 ELSE
 IF STAT-ERRO
 DISPLAY "Erro gerando registro no Mysql, Staus *> Não conseguiu gerar o registro
 - "[" W-STATUS "]" *> Retorna possível causa do erro
 STOP RUN *> Encerra processo
 END-IF
 END-IF
 END-READ
 END-PERFORM.

 CLOSE ARQMFS. *> Fecha os arquivos
 CLOSE ARQMYS.

 STOP RUN.

.