IDENTIFICATION DIVISION. PROGRAM-ID. TSMYSQL9. *-----------------------------------------------------------* * Objetivo: Demonsntra como acessar uma base de dados MYSQL * * usando a SYNTAX SQL. *-----------------------------------------------------------* ENVIRONMENT DIVISION. CONFIGURATION SECTION. SPECIAL-NAMES. call-convention 66 is WINAPI DECIMAL-POINT IS COMMA. INPUT-OUTPUT SECTION. FILE-CONTROL. DATA DIVISION. FILE SECTION. WORKING-STORAGE SECTION. *> "W-ARQUIVOS" Define parametros como: *> "@" - Na primeira posição informa a rotina que se trata de uma base de dados no MYSQL *> 127.0.0.1 - Ip onde encontrar o servidor que se deseja acessar. *> "@" - Nas demais posições identificam o divisor de campo *> 3306 - Porta. Informa qual porta usar para ter acesso ao servidor MYSQL *> root - Usuario. Neste caso no servidor existe um usuario "root" com acesso permitido. *> psw - Senha. A senha vinculada ao usuario "root". *> test - Base de dados onde encontrar as tabelas a serem acessadas. Pode ser alterado *> futuramente. *> cadcep - Tabela a ser acessada. Pode ser alterado futuramente. 77 W-ARQUIVOS PIC X(64) VALUE "@127.0.0.1@3306@root@@tes - "t@cadcep". 77 W-QRTM PIC 9(09) COMP-5. *> Armazena o tamanho do comando sendo enviado. 77 W-CMD PIC X(64000). *> Comando a ser enviado. 77 W-RESULTADO PIC X(79) VALUE SPACES. 01 ESTADO PIC X(02). *> Controla Status do comando executado. *> Esta variavel segue os mesmos padrões adotados pelo *> File Status do COBOL MF. 88 STAT-ERRO VALUE X"3100" THRU X"3943" X"3945" THRU X"39EE". 01 RESTADO REDEFINES ESTADO. 02 ST-K01 PIC X(01). 02 ST-K02 PIC X(01). 02 RST-K02 REDEFINES ST-K02. 03 ST-ERR PIC 9(02) COMP-X. 01 W-CONEXAO USAGE POINTER. *> Handle da conexão 01 W-CURSOR USAGE POINTER. *> Handle do comando 01 EXTMYSQL procedure-pointer. *> Posição de carga da rotina 01 WS-REG. *> Lay-out de uma tabela 02 WS-LAN PIC S9(10). 02 WS-CL1 PIC S9(07). 02 WS-CL2 PIC S9(06). 02 WS-CL3 PIC S9(07)V99. 02 WS-CL4 PIC S9(05). 02 WS-CL5 PIC S9(05)V9999. 02 WS-CH1 PIC X(10). 02 WS-CH2 PIC X(50). PROCEDURE DIVISION. INICIO. SET EXTMYSQL TO ENTRY "EXTMYSQL". *> Carrega a rotina e guarda o Entry point *> em EXTMYSQL *> Informa parametros para acesso ao banco de dados. *> Retorna: *> Handle da conexão para uso futuro *> File status da execução. CALL "MysqlConecta" USING W-ARQUIVOS *> Variavel com os parametros para estabelecer a *> conexão. W-CONEXAO *> Retorna handle para encontrar a FCD-AREA da *> conexão. ESTADO. *> Status de retorno. PERFORM SETA-VARIAVEL. *> exemplifica como setar uma variavel de ambiente *> do MYSQL. MOVE 1 TO W-QRTM. *> Inicializa variável de tamanho de comando a ser *> enviado. STRING "SELECT cadtst.tstlan, cadtst.tstvl1, cadtst.tstvl2, " *> Monta comando SQL a ser *> executado. "cadtst.tstvl3, cadtst.tstvl4, cadtst.tstvl5, " *> Neste exemplo ira executar *> um comando SQL. "cadtst.tstch1, cadtst.tstch2 FROM cadtst" *> que ira popular o Lau-Out *> definido logo. DELIMITED BY SIZE *> acima na WORKING "WS-REG" INTO W-CMD WITH POINTER W-QRTM. *> Salva o tamanho do comando *> a ser executado. *> Executa um comando MYSQL. *> Informa: *> Handle da Conexão a ser usada. *> Handle do Comando a ser executado. *> Tamanho do comando a ser executado *> Retorna: *> Handle do comando caso haja. *> Status de retorno CALL "MysqlComando" USING W-CONEXAO *> Handle da conexão retornado do comando "MysqlConecta" W-CMD *> Comando montado logo acinma, a ser executado W-CURSOR *> Caso o comando executado retorne, handle comando *> sendo executado. W-QRTM *> Tamanho do comando a ser executado, salvo *> anteriormente. ESTADO. *> Status de retorno. IF W-CURSOR NOT = NULL *> Testa se existe resultado do comando anterior PERFORM UNTIL STAT-ERRO *> Loop enquanto existir resultado MOVE ZEROS TO W-QRTM *> Inicializa variavel controle de tamanho *> Recupera do servior o resultado do comando vinculado ao Handle da conexão e do comando *> Informa: *> Handle da Conexão a ser usada. *> Handle do Comando a ser executado. *> Retorna: *> Tamanho do buffer contendo o resultado *> Status de retorno. Mesmos valores retornado de um comando READ *> Buffer contendo o resultado. CALL "MysqlRetorna" USING W-CONEXAO *> Handle da conexão W-CURSOR *> Handle do comando W-QRTM *> Tamanho do buffer sendo retornado ESTADO *> Status de retorno W-CMD *> Buffer contendo o resultado sendo retornado. *> Ter cuidado no programa IF ESTADO = ZEROS MOVE W-CMD TO WS-REG *> Joga o resultado na variavel de lay-out END-IF END-PERFORM END-IF *> Libera recursos usados pelo comando *> Informa: *> Handle do comando CALL "MysqlLiberaCursor" USING W-CONEXAO W-CURSOR. *> Handle para encontrar a FCD-AREA desta conexão *> Libera recursos usados pela conexão *> Informa: *> Handle da conexão *> Handle do comando - Libera recursos do comando caso exista ou não tenha sido *> liberado anteriormente. CALL "MysqlDesConecta" USING W-CONEXAO *> Handle para encontrar a FCD-AREA desta conexão W-CURSOR *> Handle das definições para o cursor, pode não *> vir informado. ESTADO. STOP RUN. SETA-VARIAVEL. *> Ira setar uma variavel de ambiente no Mysql chamada teste MOVE "SET @teste = 2;" TO W-CMD *> Monta comando a ser executado MOVE 15 TO W-QRTM. *> Define o tamanho do comando a ser executado CALL "MysqlComando" USING W-CONEXAO *> Handle para recuperar FCD-AREA W-CMD *> Comando a ser executado W-CURSOR *> Handle do retorno do comando W-QRTM *> Tamanho do comando a ser executado ESTADO. *> Status de retorno *> Ira liberar a variavel de ambiente no Mysql chamada teste MOVE "SELECT @teste;" TO W-CMD MOVE 14 TO W-QRTM. CALL "MysqlComando" USING W-CONEXAO *> Handle para recuperar FCD-AREA W-CMD *> Comando a ser executado W-CURSOR *> Handle do retorno do comando W-QRTM *> Tamanho do comando a ser executado ESTADO. *> Status de retorno IF W-CURSOR NOT = NULL *> Testa se existe resultado do comando anterior PERFORM UNTIL STAT-ERRO *> Loop enquanto existir resultado MOVE ZEROS TO W-QRTM *> Inicializa variavel controle de tamanho *> Recupera do servior o resultado do comando vinculado ao Handle da conexão e do comando *> Informa: *> Handle da Conexão a ser usada. *> Handle do Comando a ser executado. *> Retorna: *> Tamanho do buffer contendo o resultado *> Status de retorno. Mesmos valores retornado de um comando READ *> Buffer contendo o resultado. CALL "MysqlRetorna" USING W-CONEXAO *> Handle da conexão W-CURSOR *> Handle do comando W-QRTM *> Tamanho do buffer sendo retornado ESTADO *> Status de retorno W-CMD *> Buffer contendo o resultado sendo retornado. *> Ter cuidado no programa MOVE W-CMD TO W-RESULTADO IF ESTADO = ZEROS DISPLAY W-RESULTADO ELSE DISPLAY "Nenhum resultado encontrado" END-IF END-PERFORM ELSE DISPLAY "Nenhum resultado encontrado" END-IF. *-- -------------------------------------------------------- *-- Servidor: 127.0.0.1 *-- Versão do servidor: 5.5.24-log - MySQL Community Server (GPL) *-- OS do Servidor: Win64 *-- HeidiSQL Versão: 8.1.0.4545 *-- -------------------------------------------------------- * */*!40101 SET @OLD_CHARACTER_SET_CLIENT=@@CHARACTER_SET_CLIENT */; */*!40101 SET NAMES utf8 */; */*!40014 SET @OLD_FOREIGN_KEY_CHECKS=@@FOREIGN_KEY_CHECKS, FOREIGN_KEY_CHECKS=0 */; */*!40101 SET @OLD_SQL_MODE=@@SQL_MODE, SQL_MODE='NO_AUTO_VALUE_ON_ZERO' */; * *-- Copiando estrutura do banco de dados para test *CREATE DATABASE IF NOT EXISTS `test` /*!40100 DEFAULT CHARACTER SET latin1 */; *USE `test`; * * *-- Copiando estrutura para tabela test.cadtst *CREATE TABLE IF NOT EXISTS `cadtst` ( * `tstlan` int(10) NOT NULL, * `tstvl1` int(7) NOT NULL, * `tstvl2` int(6) NOT NULL, * `tstvl3` decimal(9,2) NOT NULL, * `tstvl4` decimal(5,0) NOT NULL, * `tstvl5` decimal(9,4) NOT NULL, * `tstch1` char(10) NOT NULL, * `tstch2` varchar(50) NOT NULL *) ENGINE=InnoDB DEFAULT CHARSET=latin1; * *-- Copiando dados para a tabela test.cadtst: ~2 rows (aproximadamente) */*!40000 ALTER TABLE `cadtst` DISABLE KEYS */; *INSERT INTO `cadtst` (`tstlan`, `tstvl1`, `tstvl2`, `tstvl3`, `tstvl4`, `tstvl5`, `tstch1`, `tstch2`) VALUES * (1, 1, 111, 111.11, 111, 1234.1234, 'A', 'B'), * (2, -1, -11, -112.22, -12345, -1234.1234, 'A', 'B'), * (3, 2, 31, 123.45, 99999, 6.5432, 'Z', 'O'); */*!40000 ALTER TABLE `cadtst` ENABLE KEYS */; */*!40101 SET SQL_MODE=IFNULL(@OLD_SQL_MODE, '') */; */*!40014 SET FOREIGN_KEY_CHECKS=IF(@OLD_FOREIGN_KEY_CHECKS IS NULL, 1, @OLD_FOREIGN_KEY_CHECKS) */; */*!40101 SET CHARACTER_SET_CLIENT=@OLD_CHARACTER_SET_CLIENT */;