Abstração de Acesso a Dados e Orientação a Objetos – Parte 02

Introdução

No post anterior (Abstração de Acesso a Dados e Orientação a Objetos) vimos o conceito de abstração e uma ideia de implementar uma classe superior — ou superclasse — que eliminaria várias duplicidades entre as classes ZDBFFILE e ZMEMFILE. Bem, mãos a obra.

Classe ZISAMFILE

Tudo o que é comum e exatamente igual na implementação de ambas as classes de acesso a DBF em disco e em memória são parte de uma lógica de acesso e comportamento ISAM. Ao criar a classe ZISAMFILE, ela passa a ter as propriedades e métodos comuns a ambas implementações, que são removidas das respectivas implementações e colocadas nela.

A classe ZISAMFILE não tem construtor explícito, ela não têm um “New”. Mas não precisa, pois ela não foi feita para ser instanciada diretamente. Ela deve ser a classe superior a ser herdada pelas classes ZMEMFILE e ZDBFFILE, da seguinte forma:

// Ao invés de 
CLASS ZDBFFILE FROM LONGNAMECLASS
CLASS ZMEMFILE FROM LONGNAMECLASS

// Agora temos
CLASS ZISAMFILE FROM LONGNAMECLASS
CLASS ZDBFFILE FROM ZISAMFILE
CLASS ZMEMFILE FROM ZISAMFILE

Métodos reimplementados

Existem alguns métodos comuns implementados tanto na classe filha como na classe pai. Ao implementar na classe filha um método da classe pai, você pode ou não chamar o método da classe pai de dentro da classe filha, quando o objetivo do método não é substituir a implementação da classe pai, mas sim COMPLEMENTÁ-LA.

Por exemplo, cada uma das classes (ZDBFFILE e ZMEMFILE) possui propriedades específicas, declaradas em sua definição. E, a classe pai ( ZISAMFILE) também tem as suas propriedades, comuns a todas as heranças. Na implementação original, o método de uso interno da classe chamado _InitVars() foi feito para justamente inicializar estas propriedades, e ele agora também foi implementado na classe ZISAMFILE.

A forma correta e elegante de se fazer isso é: Cada método _InitVars() da sua classe inicializa as propriedades da sua classe. E, as classes que herdam a ZISAMFILE -- no caso ZMEMFILE e ZDBFFILE -- antes de mais nada chamam o método _InitVars() da classe superior (ZISAMFILE). Sendo assim, o método _InitVars da classe ZMEMFILE ficou assim:

METHOD _InitVars() CLASS ZMEMFILE 

// Inicialização das propriedades da classe pai
_Super:_InitVars()

// Inicializa demais propriedades da ZMEMFILE
::aFileData   := {}
::lOpened     := .F. 
::lExclusive  := .F. 
::lCanWrite   := .T. 
::dLastUpd    := ctod("")
::aGetRecord  := {}
::aPutRecord  := {}
::lUpdPend    := .F. 
::lSetDeleted := .F. 
::nRecno      := 0

Return

Como eu disse, ainda existem propriedades em duplicidade implementadas nas classes ZMEMFILE e ZDBFFILE, elas serão remanejadas em outro momento. Mas sabe o que é o mais lindo de tudo isso?

  • Os programas de teste que usavam as classes continuam funcionando perfeitamente, pois todos eles acessam as funcionalidades das classes através de métodos, até mesmo as propriedades são retornadas por métodos — recurso também chamado de “Getters and Setters” — torne as propriedades privadas da classe, e encapsule qualquer mudança de estado das propriedades em métodos Set<Propriedade>(), e as consultas por métodos Get<Propriedade>()
  • A classe ZISAMFILE ficou com 700 linhas. Isto significa que cada fonte das classes ZMEMFILE e ZDBFFILE agora tem cada um 700 linhas a menos, eliminando a duplicidade de código, e implementando as funcionalidades na classe pai. 
  • Até mesmo um método que era

Outras mudanças

Aproveitando o momento de refatoração, a classe de índices em memória deixou de se chamar ZDBFMEMINDEX e passou a ser ZMEMINDEX — afinal ela é usada pelos métodos e propriedades de controle da implementação da ZISAMFILE. Outra alteração interessante era o processamento de uma expressão AdvPL, onde era necessário trocar a ocorrência de campos na expressão pelo o:FieldGet() do campo. Isto era feito exatamente da mesma forma tanto na classe de índice quanto nas classes de ZDBFFILE e ZMEMFILE para aplicar filtros.

Agora, existe um método chamado _BuildFieldExpr(), que recebe uma string com uma expressão AdvPL qualquer que use campos da tabela — onde todos os campos na expressão devem ser colocados com letras maiúsculas — e retorna uma string com o texto do Codeblock com a expressão resultante. Agora, quem precisa desta funcionalidade chama o método  _BuildFieldExpr() da classe  ZISAMFILE, e com a expressão resultante, criar o Codeblock dinâmico com macro-execução e usar conforme a necessidade.

GITHUB

Conforme o projeto vai sendo alterado e os fontes refatorados, novos recursos arquivos vão sendo acrescentados no GITHUB, a versão mais atual de todos os fontes envolvidos está lá. Pode ser necessário remover alguns fontes do projeto e recompilar os programadas para dar tudo certo. Em breve os fontes das implementações de arquivo e implementações comuns vão fazer parte de um novo projeto — Chamado “ZLIB”.

Conclusão

Eu deixo a conclusão desse post e da implementação para vocês. Espero que este exemplo sirva não somente pela sua funcionalidade, mas como um modelo de boas práticas de desenvolvimento.

Desejo a todos novamente TERABYTES DE SUCESSO 😀

 

 

 

 

 

Arquivos em Memória – Classe ZMEMFILE

Introdução

Nos posts anteriores, acompanhamos a criação de uma classe de acesso a dados ISAM — chamada de ZDBFTABLE, renomeada para ZDBFFILE — , feita para leitura e manutenção de arquivos no formato DBF em AdvPL, sem dependência de nenhum Driver. Agora, tomando esta classe como base da implementação, nasceu a classe ZMEMFILE.

Classe ZMEMFILE

O lindo da orientação a objetos é o reaproveitamento de código. Como eu não comecei a implementação com uma classe abstrata, e não pretendia criar uma agora, a classe ZMEMFILE nasceu de um “Clone” da classe ZDBFFILE. A diferença é que, ao invés de eu endereçar um handler de arquivo em disco para ler e gravar dados, eu criei na classe uma propriedade chamada ::aFileData, que é um array multi-dimensional com as colunas da tabela, e uma coluna interna a mais — para indicar se o registro foi marcado para deleção ou não.

O meu “RECNO” passa a ser o próprio elemento do array. Cada inserção de novo registro é feita no final do array, e a deleção apenas habilita um flag na ultima coluna do array. Os demais mecanismos são os mesmos, o registro atual lido em memória é uma cópia do original em um array separado, a atualização de valores idem, e os dados da tabela estão associados ao objeto da tabela, visível apenas pelo processo atual, enquanto o objeto não foi destruído ou a tabela for fechada.

Todos os demais métodos da classe que não acessavam fisicamente o arquivo, simplesmente não foram alterados. Estes métodos são os candidatos para uma futura refatoração, criando uma classe superior com estes métodos, fazendo as classes ZDBFFILE e ZMEMFILE herdarem esta classe base, e removendo as duplicidades desnecessárias da implementação.

Aproveitamento da classe ZMEMINDEX

Como a classe que cria o índice em memória não acessa diretamente os dados de nenhum arquivo, mas faz as leituras, criação de índice e demais operações usando os métodos da classe ZDBFFILE, eu praticamente não precisei mexer em nenhuma linha da ZMEMINDEX para usá-la com a ZMEMFILE. 

Isso me deixou simplesmente radiante. A implementação de filtro foi clonada, a implementação de bisca indexada e manutenção de índices também clonada, uma vez que eu reimplementei os métodos que efetivamente acessavam o disco para acessar um array da própria classe, o fonte já funcionava.

Fonte de Testes

Vamos ver o fonte abaixo, chamado de CriaMem.PRW

#include "protheus.ch"

USER Function CriaMEM()
Local cFile := 'memfile.dbf'
Local oDbf
Local aStru := {}

SET DATE BRITISH
SET CENTURY ON 
SET EPOCH TO 1950

// Define a estrutura 
aadd(aStru,{"CPOC","C",10,0})
aadd(aStru,{"CPOM","M",10,0})

// Cria o objeto da tabela 
oDbf := ZMEMFILE():New(cFile)

// Cria a tabela em si 
oDbf:Create(aStru)

// Abre em modo de escrita 
If !oDbf:Open(.T.,.T.)
	UserException( oDBF:GetErrorStr() )
Endif

// Insere um registro
oDBF:Insert()
oDBF:Fieldput(1,'Laranja')
oDBF:Fieldput(2,'0000000001')
oDBF:Update()

// Insere mais um registro 
oDBF:Insert()
oDBF:Fieldput(1,'Banana')
oDBF:Fieldput(2,'0000000002')
oDBF:Update()

// Insere um terceiro registro 
oDBF:Insert()
oDBF:Fieldput(1,'Abacate')
oDBF:Fieldput(2,'0000000003')
oDBF:Update()

conout("Mostrando 3 registros")
oDBF:GoTop()
While !oDBF:Eof()
	// Mostra o registro atual
	ShowRecord(oDBF)
	oDBF:Skip()
Enddo

// Agora cria um indice
conout("Criando indice por CPOC")
oDBF:CreateIndex("CPOC")

// Mostra os dados da tabela novamente, agora ordenados
// A criacao de um indice já o torna ativo, e reposiciona 
// a tabela no primeiro registro 
While !oDBF:Eof()
	// Mostra o registro atual
	ShowRecord(oDBF)
	oDBF:Skip()
Enddo

// Fecha a tabela
// -- Os dados sao eliminados da memoria 
oDBF:Close()

// Limpa / Libera o Objeto
FreeObj(oDBF)

Return

// Função feita para mostrar o conteudo do registro atual 
STATIC Function ShowRecord(oDBF)
Local nI
Local aStru := oDBF:GetStruct()
conout(replicate('-' ,79))
conout("RECNO() ...... " + cValToChar(oDBF:Recno()) +" | " + "DELETED() .... "+cValToChar(oDBF:Deleted()) )
conout("BOF() ........ " + cValToChar(oDBF:Bof())   +" | " + "EOF() ........ "+cValToChar(oDBF:Eof()) )
conout("Index ........ " + "("+cValToChar(oDBF:IndexOrd())+") "+oDBF:IndexKey())
conout("")
For nI := 1 to len(aStru)
	conout("Fld #"+padr(cValToChar(nI),3)+" | "+ ;
	  aStru[nI][1]+" ("+aStru[nI][2]+") => ["+cValToChar(oDBF:Fieldget(nI))+"]" )
Next
conout("")
Return

Em poucas palavras, o fonte de exemplo cria a tabela, insere três registros, mostra no console, cria um índice pelo campo “CPOC”, e mostra novamente os dados ordenados.

Sabe o que você precisa fazer para isso rodar com um DBF ? Apenas troque a seguinte linha:

// Troque a linha abaixo 
oDbf := ZMEMFILE():New(cFile)

// Para esta aqui:
oDbf := ZDBFFILE():New(cFile)

E está feito. Salve o fonte, compile novamente e teste. O arquivo chamado “memfile.dfb” será criado no disco. Recomendo baixar a pasta inteira do GirHub (Blog), e criar um projeto com os seguintes fontes:

zDBFFile.prw
zDbfMemIndex.prw
zDBTFile.prw
zFPTFile.prw
zLibDateTime.prw
zLibDec2Hex.prw
zLibNBin.prw
zMEMFile.prw

Na próxima refatoração, a classe ZDBFMEMINDEX será renomeada para ZMEMINDEX — afinal ela não serve apenas para DBF 😀

Por que não usar um Array “direto” ?

A-há !! A pergunta de meio milhão de dinheiros …risos… Sim, armazenar um resultado temporário de qualquer coisa em um array em AdvPL pode ser feito de forma direta, sem dúvida. Se o seu uso de dados em Array é simples, o array é pequeno e as buscas são ridículas, e a manutenção de elementos praticamente inexistente, então você não precisa usar uma classe para emular um arquivo em memória. Escreva seu fonte criando um array direto e seja feliz.

Agora, se você vai ter um número maior de elementos, precisa de uma busca ou navegação ordenada — HASH faz busca, mas não ordena — e já tem um código que usa o arquivo em disco, como um container temporário, mas ele não vai acabar com a memória do Protheus Server se ele for usado em memória … pronto, você tem uma implementação virtual de arquivo para pintar e bordar.

Evolução natural de funcionalidades

Conforme a implementação vai sendo utilizada, naturalmente sentimos a necessidade de algumas melhorias, alguns métodos ou mesmo novas classes facilitadoras. Por exemplo, copiar dados de um arquivo em disco para a memória. É simples montar, basta instanciar o arquivo em disco em um objeto, pegar a estrutura, criar o objeto em memória, fazer um loop lendo  o primeiro arquivo e inserindo os dados no segundo arquivo.

Porém, se cada vez que você precisar fazer isso, você replicar a implementação, dá-lhe código duplicado. Nada como implementar um método CreateFrom(). Você cria o objeto do arquivo no disco, onde estão os dados, cria o objeto do arquivo em memória, então chama o método CreateFrom() do arquivo em memória, passando como parâmetro o objeto do arquivo em disco. O método CreateFrom() ainda não existe, mas é o próximo da fila… risos…

Internamente este método já vai fazer o que tem que ser feito. Quer algo mais elegante que isso? Seu arquivo temporário em memória não precisa de todos os dados do arquivo em disco, porém apenas os registros que atendam uma determinada condição. Basta setar um filtro no arquivo de origem, o método CreateFrom() vai copiar apenas os registros logicamente visíveis, que atendam a condição de filtro.

Conclusão

Por hora, a conclusão óbvia é que, embora inicialmente pareça um pouco mais difícil mudar seu mind-set para pensar Orientado a Objetos, adotar este paradigma da forma consciente e adequada só têm benefícios.

Agradeço novamente a audiência, e desejo a todos TERABYTES DE SUCESSO !!! 

Referências

PROGRAMAÇÃO ORIENTADA A OBJETOS. In: WIKIPÉDIA, a enciclopédia livre. Flórida: Wikimedia Foundation, 2018. Disponível em: <https://pt.wikipedia.org/w/index.php?title=Programa%C3%A7%C3%A3o_orientada_a_objetos&oldid=53496356>. Acesso em: 2 nov. 2018.

Abstração de Acesso a Dados e Orientação a Objetos

Introdução

Nos últimos posts, a ideia de criar um componente em AdvPL para leitura de arquivos DBF, acessando diretamente o arquivo no disco sem uso de Driver, acabou virando uma implementação completa de manutenção de DBF. Vamos ver agora conceitualmente o que isto representa em termos de desenvolvimento.

Abstração

“O uso da abstração na computação pode ser exemplificada da seguinte forma: Imagine que um determinado processamento é realizado em vários pontos de um sistema, da mesma forma ou de forma idêntica. Ao invés de repetirmos o trecho de código responsável por este processamento, o abstraímos na forma de um procedimento ou função, e apenas fazemos uma chamada à tal procedimento, onde quer que necessitemos e por quantas vezes se fizer necessário.” — Fonte: Wikipedia

Quando programamos com orientação a objetos, uma forma muito elegante de reaproveitamento de código, é usar uma herança de uma classe abstrata — ela não contém exatamente a implementação, mas serve de guia para uma ou mais classes herdarem a classe abstrata e implementarem as operações declaradas usando os métodos como “guia”.

“Uma classe abstrata é desenvolvida para representar entidades e conceitos abstratos. A classe abstrata é sempre uma superclasse que não possui instâncias. Ela define um modelo (template) para uma funcionalidade e fornece uma implementação incompleta – a parte genérica dessa funcionalidade – que é compartilhada por um grupo de classes derivadas. Cada uma das classes derivadas completa a funcionalidade da classe abstrata adicionando um comportamento específico.” — Fonte: Wikipedia

Implementação em AdvPL

Usando AdvPL — mesmo sem usar a implementação do TL++ — podemos criar uma classe base, com métodos e propriedades, e implementar uma classe filha, com os métodos para o seu propósito. Por exemplo, a classe ZDBFTABLE — criada para permitir manutenção e leitura de dados em um arquivo DBF — ela têm os métodos definidos para abertura, fechamento, inserção , atualização, ordenação e afins, mas ela trabalha com um arquivo em formato DBF.

Eu começo a escrever códigos que consomem esta classe e seus métodos. Então, amanhã eu quero armazenar os dados em um outro formato de tabela, pode ser c-Tree, algum banco relacional, um banco em memória, etc. Devido ao dinamismo das classes em AdvPL, eu consigo implementar uma classe nova com os mesmos métodos, e reaproveitar o mesmo código.

Por exemplo, um programa que cria um arquivo e insere um registro, usando a classe ZDBFTABLE, poderia ser escrito assim:

User Function  NewDBF()
Local cFile := '\meuarquivo.dbf'
Local oDbf
Local aStru := {}

aadd(aStru,{"CPOC","C",10,0})
aadd(aStru,{"CPOD","D",8,0})

oDbf := ZDBFTABLE():New(cFile)

If !oDbf:Create(aStru)
   UserException( oDBF:GetErrorStr() )
Endif

If !oDbf:Open(.T.,.T.)
   UserException( oDBF:GetErrorStr() )
Endif

oDBF:Insert()
oDBF:Fieldput(1,'0000000001')
oDBF:Fieldput(2,date())
oDBF:Update()

oDBF:Close()
FreeObj(oDBF)
Return

Se amanhã eu criar uma nova classe para armazenar estes dados em outro formato de arquivo, ou mesmo em memória, ou em um servidor remoto, não importa. Basta eu criar uma classe com os mesmos métodos, e implementá-la. A única coisa que vai mudar inicialmente seria a criação do objeto. Você usaria o construtor  da nova classe, que deve ter publicadas os mesmos métodos disponíveis para uso, com os mesmos nomes e emulando o mesmo comportamento. Ao invés de usar o construtor da ZDBFTABLE, você poderia usar uma outra classe, para criar por exemplo o arquivo em memória, sem alterar praticamente nada do código.

Implementação xBase / ISAM (Clipper / FoxPRO / Harbour / AdvPL)

A implementação de acesso a dados usando xBASE / ISAM usadas nas linguagens acima foram feitas em cima de funções, sem orientação a objeto, porém com o mesmo propósito de reaproveitamento de código. No momento de CRIAR ou ABRIR uma tabela, você informa qual é o DRIVER (ou RDD) que deve ser usado. A partir de então, todas as operações de consulta e manutenção dos dados é feita sobre um ALIAS aberto daquela tabela.

A primeira versão de arquivo de índice usada no Clipper 5.x usava o formato de índice NTX — baseado em uma árvore B+Tree modificada, permitia apenas uma expressão de índice por arquivo. Este driver era chamado DBFNTX, basta especificar na criação e abertura da tabela — e fazer o link com a library correspondente ao gerar o executável. Posteriormente foi criado um novo driver, que usava índices no formato CDX (Compound Index File), que permitia mais de uma expressão de índice no mesmo arquivo, nomeadas internamente como “TAGs”, e internamente usava um algoritmo de compactação.

Para usar o novo driver, era necessário apenas alterar no programa o nome do driver informado na criação e abertura de tabelas, especificar a library DBFCDX no linker, e alguns pequenos ajustes no código devido a mudanças de características intrínsecas ao novo formato — você não criava um novo arquivo para cada índice, mas sum uma nova TAG com a expressão de índice dentro de um arquivo indexador.

Foram implementados vários Drivers no Protheus, seguindo ao máximo a mesma premissa de manter o comportamento esperado de suas funções, de modo que você possa usar um novo Driver de armazenamento e recuperação de dados com o menor impacto possível no seu código.

Abstraindo

O conceito de abstração pode ser aplicado em diversos componentes do sistema. Neste momento só me vêm a cabeça exemplos de uso em componentes de tecnologia. Por exemplo, uma classe de comunicação qualquer ( TCP, HTTP, IMAP, POP, SMTP … ) pode usar uma conexão TCP/IP ou uma conexão segura (SSL/TLS). Porém, ambas conexões possuem os métodos de criar uma nova conexão, encerrar uma conexão, enviar dados, receber dados, verificar status da conexão, espera com time-out. Pronto, crie uma classe abstrata de conexão com estes métodos, crie quantas heranças forem necessárias, e implemente.

O conceito de persistência de qualquer informação parte da premissa que eu possa salvá-la e recuperá-la posteriormente. Eu posso salvar o estado de uma classe em um formato que a própria classe seja capaz de fazer um Save() e um Load(). Uma vez feito isso, eu posso criar uma abstração de persistência de contexto, e implementar o Save e o Load em um arquivo no disco, uma tabela de um banco de dados, ou mesmo um e-mail. E posso ainda ir mais longe, implementar uma abstração de formato de conteúdo. Uma vez que meu armazenamento seja baseado por exemplo em chave e valor, eu posso salvar e ler este conteúdo por exemplo em JSON, XML, Binary ASCII, etc.

Conclusão

Algumas das premissas da orientação envolvem a criação de código reutilizável. Recursos de herança, polimorfismo e associação permitem separar a lógica da sua implementação. Implementar estes conceitos onde cabe e como manda o figurino fatalmente vai fazer parte do diferencial da solução proposta!

Desejo a todos TERABYTES DE SUCESSO !!!! 😀 

Referências

Algoritmos – Parte 01 – Loterias

Introdução

Nos primeiros posts no Blog sobre programação — vide Desmistificando a análise de sistemas e Desmistificando a programação — foi colocada de forma simples a ideia de programar alguma coisa, como sendo apenas uma sequência de instruções e decisões para se realizar uma tarefa. E, realmente é simples assim, o que precisamos fazer é usar corretamente a gramática da linguagem para realizar as tarefas em pequenas etapas, criando tarefas maiores e reaproveitando tarefas menores.

Algoritmos

Uma sequência de instruções para realizar uma tarefa específica pode ser chamada de “Algoritmo” — verifique a definição na Wikipedia – Algoritmo. Não é algo aplicado apenas a programação de computadores.

Consultando também a Wikipédia – Lista de Algoritmos, podemos ver vários exemplos de problemas específicos resolvidos com sequências de operação. Como o algoritmo em si trata apenas da sequência de operações para obter um resultado, ele pode ser implementado em várias linguagens de programação.

Alguns dos mais conhecidos e utilizados são algoritmos de ordenação e busca de dados, compressão, sorteio de números (números randômicos), criptográficos (segurança da informação), entre outros. Na internet podemos obter não apenas vários modelos de algoritmos, mas também várias implementações dos mesmos em várias linguagens de programação.

Algoritmos em AdvPL

Vamos pegar um problema qualquer, e criar um algoritmo para resolvê-lo, um por tópico. Um problema bem interessante de ser resolvido usando um programa de computador, é por exemplo lidar com análise combinatória. Podemos usar um algoritmo de geração de combinações (ou Combinação Simples) para, por exemplo, criar massas de dados explorando as combinações de vários parâmetros para testes de funções, combinar números para cartões de loteria — adoro esse algoritmo — entre outras finalidades. Vamos ver como realizar uma análise combinatória eficiente para loterias em AdvPL.

Combinação para Loterias

Em um determinado cartão de loteria, podemos preencher no mínimo N números diferentes, dentre um total de X números disponíveis, para concorrer a um prêmio caso uma quantidade mínima de números sorteados estejam presentes entre os N números do cartão.

Quando queremos por exemplo, determinar todas as possibilidades de combinação de Y números em cartões de X números, utilizamos um recurso de análise combinatória chamado “Combinação Simples”. Atualmente, para alguns tipos de loterias,o próprio bilhete de apostas já permitem você fazer uma aposta com mais números do que a aposta mínima. Neste caso, a sua aposta equivale a todas as possibilidades de combinação simples dos Y números em um cartão de X números.

MEGA-SENA

Vamos tomar como exemplo a MEGA-SENA, onde a aposta mínima é um bilhete com seis números preenchidos, a um valor de R$ 3,50 . Podemos preencher de 6 a 15 números em um cartão ou bilhete, porém o preço da aposta sobe proporcionalmente ao número de combinações simples da quantidade de números preenchidos em blocos de seis números. Veja a tabela abaixo, de apostas e preços, e a quantidade de apostas de 6 números equivalente.

NUMEROS NO  | VALOR DA     | EQUIVALE A <n> 
BILHETE     | APOSTA       | APOSTAS de 6 números
------------+--------------+------------------------          
6 números   | R$ 3,50      |    1 aposta 
7 números   | R$ 24,50     |    7 apostas 
8 números   | R$ 98,00     |   28 apostas 
9 números   | R$ 294,00    |   84 apostas 
10 números  | R$ 735,00    |  210 apostas 
11 números  | R$ 1617,00   |  462 apostas 
12 números  | R$ 3234,00   |  924 apostas 
13 números  | R$ 6006,00   | 1716 apostas 
14 números  | R$ 10510,50  | 3003 apostas 
15 números  | R$ 17517,50  | 5005 apostas

Quantidade de combinações possíveis

A fórmula para determinar uma combinação simples C, de n números em conjuntos de k elementos é:

C(n,k) = n! / k! * (n-k)!

Onde “!” significa o valor FATORIAL do elemento, “*” é o operador de multiplicação, “/” é o operador de divisão.

Na matemática, o fatorial (AO 1945: factorial) de um número natural n, representado por n!, é o produto de todos os inteiros positivos menores ou iguais a n. A notação n! foi introduzida por Christian Kramp em 1808.

Vamos pegar por exemplo uma combinação de 12 elementos em conjuntos de 6 elementos — equivalente ao cartão de 12 números da MEGA-SENA.

C(12,6) = 12! / 6! * (12-6)!
C(12,6) = 12! / 6! * 6!
C(12,6) = 479001600 / 720 * 720 
C(12,6) = 479001600 / 518400 
C(12,6) = 924

Logo, antes mesmo de começar a fazer a combinação, podemos determinar o número de resultados possíveis.

Combinando elementos

A lógica para realizar a combinação dos elementos é basicamente a mesma, não importa a quantidade de elementos a combinar ou o tamanho do conjunto resultante. Porém, dependendo da forma que ela for implementada, ela tende a ficar mais pesada quanto maior a quantidade de elementos a combinar. Vamos pegar por exemplo a combinação de 7 elementos numéricos, de 1 a 7, em conjuntos de 6 elementos.

C(7,6) = 7! / 6! * (7-6)!
C(7,6) = 7! / 6! * (1)!
C(7,6) = 5040 / 720 * 1
C(7,6) = 7

Logo de antemão, sabemos que esta combinação resultará em 7 resultados. Agora, vamos fazer a combinação. Partindo dos números já ordenados, a primeira combinação é:

1 2 3 4 5 6

Para determinar o próximo resultado, pegamos o próximo numero do conjunto da última posição e incrementamos uma unidade:

1 2 3 4 5 7

Ao tentar fazer a mesma operação para pegar o terceiro resultado, o número 7 é o último elemento do conjunto. Então, precisamos incrementar o número na posição anterior — quinta posição. Quando fazemos isso, o número da posição que atingiu o limite deve ser o próximo elemento relativo a posição anterior. Logo, o próximo resultado será:

1 2 3 4 6 7

Repetindo novamente esta operação, começando da direita para a esquerda, na sexta posição, o elemento 7 já é o último do conjunto. Então vamos para a quinta posição. O próximo elemento desta posição seria o 7, porém ele é o último elemento da combinação, e eu não estou na última posição do conjunto de resultado, isto significa que ele já está em uso em uma posição posterior. Logo, vamos a posição anterior — quarta posição — e incrementamos o número 4 para 5, obtendo o resultado:

1 2 3 5 6 7

Repetindo os passos anteriores, os números 5, 6 e 7 não podem ser incrementados pois já são os elementos finais da combinação. Logo, incrementamos na terceira posição o 3 para 4, depois na segunda posição de 2 para 3, depois na primeira, de 1 para 2, e depois acabou, pois não há como incrementar mais nada.

1 2 4 5 6 7 
1 3 4 5 6 7 
2 3 4 5 6 7

Com isso obtivemos os 7 resultados possíveis. Agora, vamos colocar essa regra em um código fonte. Para facilitar o uso deste recurso, vamos criá-lo como uma Classe em AdvPL. Após construir e otimizar o algoritmo, a primeira versão ficou assim (fonte ACOMB.PRW):

#include "protheus.ch"

CLASS ACOMB FROM LONGNAMECLASS

  DATA nCols
  DATA aElements
  DATA nSize
  DATA aControl
  DATA aMaxVal
  DATA nPos

  METHOD NEW()
  METHOD GETCOMB()
  METHOD NEXTCOMB()
  METHOD GETTOTAL() 

ENDCLASS

METHOD NEW( nCols , aElements ) CLASS ACOMB
Local nI , nMax
::nCols := nCols
::aElements := aElements
::nSize := len(aElements)
::nPos := nCols
::aControl := {}
::aMaxVal := {}
nMax := ::nSize - ::nCols + 1
For nI := 1 to ::nCols
  aadd(::aControl,nI)
  aadd(::aMaxVal, nMax )
  nMax++
Next
Return self

METHOD GETCOMB() CLASS ACOMB
Local nI , aRet := array(::nCols)
For nI := 1 to ::nCols
  aRet[nI] := ::aElements[ ::aControl[nI] ] 
Next 
Return aRet

METHOD NEXTCOMB() CLASS ACOMB
If ::aControl[::nPos] + 1 > ::aMaxVal[::nPos]
  ::nPos := ::nPos - 1 
  If ::nPos < 1 
    Return .F. 
  Endif
  If ::NEXTCOMB()
    ::nPos := ::nPos + 1
    ::aControl[::nPos] := ::aControl[::nPos-1]+1
  Else
    Return .F. 
  Endif
Else
  ::aControl[::nPos]++
Endif
Return .T.

METHOD GETTOTAL() CLASS ACOMB
Local nFat1 := Fatorial( ::nSize )
Local nFat2 := fatorial( ::nCols )
Local nFat3 := Fatorial( ::nSize - ::nCols )
Local nTot := nFat1 / ( nFat2 * nFat3 ) 
Return nTot

STATIC Function Fatorial(nNum)
Local nI := nNum - 1
While nI > 1 
  nNum *= nI 
  nI--
Enddo
Return nNum

A propriedade aControl controla os contadores de cada posição do conjunto de retorno, e a propriedade aMaxVal eu já determino qual é o valor máximo de um determinado contador para a coluna ou posição atual. O Método GetComb() retorna um array com os elementos combinados, e o método NextComb() determina qual a próxima combinação da sequência, atualizando o array aControl. Quando o método NextComb() retornar .F., não há mais combinações possíveis. E, usando o método GetTotal(), eu determino quantas combinações são possíveis.

Para testar a classe acima, vamos usar o seguinte fonte:

User Function ACombTst()
Local nI
Local nResult := 1
Local lEcho := .F. 
Local nTimer
Local nCols , aData := {}

// Monta 35 dezenas para combinar 
For nI := 1 to 35
  aadd(aData,strzero(nI,2))
Next
// Combinação em conjuntos de 6 dezenas 
nCols := 6
oLoto := ACOMB():New( nCols , aData )
nTotal := oLoto:GetTotal()
conout("Elementos ...... "+cValToChar(len(aData)) )
conout("Conjunto ....... "+cValToChar(nCols) )
conout("Combinacoes .... "+cValToChar(nTotal) )
If lEcho
  aRet := oLoto:GETCOMB()
  conout("("+strzero(nResult,6)+") "+aRet[1]+" "+aRet[2]+;
         " "+aRet[3] +" "+aRet[4]+" "+aRet[5]+" "+aRet[6] )
endif
nTimer := seconds()
While oLoto:NEXTCOMB()
  nResult++
  If lEcho
    aRet := oLoto:GETCOMB()
    conout("("+strzero(nResult,6)+") "+aRet[1]+" "+aRet[2]+;
           " "+aRet[3] +" "+aRet[4]+" "+aRet[5]+" "+aRet[6] )
  Endif
Enddo
nTimer := seconds() - nTimer
conout("Resultados ..... "+cValToChar(nResult) )
conout("Tempo .......... "+str(nTimer,12,3)+" s.")
Return

No meu notebook, determinar as 1623160 combinações possíveis de 35 números em blocos de 6 demorou aproximadamente 3,5 segundos. Vejamos o log de console:

Elementos ...... 35
Conjunto ....... 6
Combinacoes .... 1623160
Resultados ..... 1623160
Tempo .......... 3.531 s.

Sim, neste teste eu não peguei os resultados, e não imprimi os resultados, eu apenas chamei em loop o método NextComb() até ele calcular todas as combinações. Para a aplicação imprimir os resultados em console, basta colocar .T. na variável lEcho e recompilar o fonte. Não é necessário dizer que, haverá uma boa diferença de desempenho quando você passar a resgatar cada uma das combinações e mostrar/gravar cada uma no log de console.

Dividindo o número total de combinações pelo tempo que a aplicação demorou, a rotina gerou aproximadamente 459688 resultados por segundo. Eu diria que isso é um tempo fantasticamente rápido. O tempo necessário para gerar estas combinações é simplesmente irrelevante perto do tempo que você deve gastar para, por exemplo, registrar estas combinações em uma tabela ou Banco de Dados.

Outras Loterias

Vamos pegar agora a Lotofácil. Cada cartão tem 25 dezenas, a aposta mínima é um bilhete com 15 dezenas preenchidas, e o prêmio máximo é você acertar os 15 números. As chances de você ganhar jogando um bilhete com a aposta mínima é 1 em 3.268.760. Afinal, se você fizer todas as combinações de 25 dezenas em grupos de 15, é exatamente esse o número de combinações possível. Vamos ver isso rodando o programa ? Basta alterar o programa de teste para criar 25 dezenas, e atribuir 15 para nCols.

Elementos ...... 25
Conjunto ....... 15
Combinacoes .... 3268760
Resultados ..... 3268760
Tempo .......... 12.002 s.

Pode fazer a mesma coisa para a MEGA-SENA, são 60 elementos em conjunto de 6. Garanto que vai demorar bem mais que 12 segundos, afinal a MEGA-SENA são 50.063.860 possibilidades ou combinações, mais de 15 vezes do que a Loto Fácil. Vamos rodar, apenas pra ver quanto tempo demora.

Elementos ...... 60
Conjunto ....... 6
Combinacoes .... 50063860
Resultados ..... 50063860
Tempo .......... 94.201 s.

Conclusão

Mesmo sabendo de tudo isso, até agora eu não ganhei na loteria, pois matematicamente as chances de um número qualquer ser sorteado é uma para o conjunto de números. As chances de acertar todos os números de uma loteria com uma aposta é uma para o conjunto de possibilidades / combinações dos números que eu posso colocar no cartão. Matematicamente, as chances de qualquer aposta — qualquer uma, inclusive por exemplo as dezenas “01 02 03 04 05 06” , ou “05 10 15 20 25 30”, são as mesmas. A única forma de aumentar matematicamente a sua probabilidade ou chance de acerto é jogar mais cartões diferentes. E, no final das contas, você pode jogar um cartão com 16 números e não acertar nenhum.

Agradeço novamente a audiência, curtidas e compartilhamentos, e desejo a todos TERABYTES DE SUCESSO 😀

Referências

 

 

Protheus e FTP Client – Parte 03

Introdução

A ideia era fazer um fonte mais detalhado de exemplo de uso da Classe TFTPClient(), mas o resultado acabou virando um mini WinSCP em AdvPL 😀 Vamos aos prints e aos códigos !!!

O Programa

Existe uma aplicação chamada WINSCP, uma ferramenta de código aberto que permite gerenciamento e sincronização de arquivos, entre a máquina local e um servidor de FTP ou mesmo SFTP (SSH File Transfer Protocol). As operações básicas são realizadas em dois painéis lado-a-lado, onde o lado esquerdo permite navegar na estrutura de pastas da máquina local, e no lado direito é possível conectar em um FTP / SFTP Server, navegar pela estrutura de pastas do servidor FTP, e realizar operações em ambos os lados, como criar pastas, apagar pastas, e copiar pastas e arquivos de um lado para o outro — Download e Upload do FTP.

Este programa de exemplo em AdvPL acabou crescendo, e tornou-se também um exemplo avançado de utilização de interface. Não se trata de um programa muito complexo, ele acaba ficando parecido com o CRUD — Uma máquina de estado de interface onde o disparo das operações dependem do estado de um ou de ambos os painéis de arquivos.

O programa ainda está sendo codificado, a parte mais trabalhosa foi fazer a “área de trabalho” da Interface do programa, onde uma parte as ações são disparadas por um menu superior, e a outra é disparada interativamente dentro dos painéis de navegação. Neste ponto, estou escrevendo as operações para serem feitas entre os painéis, e terminei apenas a cópia (Download/Upload). Porém, com o que já está escrito e operacional, já é possível lançar a versão 1.0 😀

Entrada

Após compilado em um ambiente, o programa deve ser chamado diretamente do SmartClient, através da função U_FTPManager. Ao ser iniciado, o programa abre uma Janela em tela cheia, trazendo os arquivos do RootPath do ambiente “\” no componente de navegação do lado esquerdo. OS detalhes de cada arquivo posicionado podem ser vistos no painel inferior do mesmo lado, tais como Tamanho, Data e Hora de criação (ou última alteração), e atributos do arquivo e/ou pasta.

Uma vez na tela inicial, podemos usar as setas para cima ou para baixo para mudar o arquivo ou pasta em foco, bem como usando o mouse, com um clique no botão esquerdo sobre o arquivo. Caso seja pressionado ENTER ou um Duplo Clique do mouse sobre uma pasta, isto fará com que a aplicação abra esta pasta e mostre os arquivos dentro dela,e permite navegar entre as pastas. Vamos ao fonte inicial do programa:

USER Function FTPManager()
Local oDlg, oFont
Local cTitle := "FTP Client Manager"
Local oSplitter
Local oPLeft , oPRight
Local nOpLeft := 1
Local oLbxLeft,oLbxRight
Local aLList := {} , aLFiles := {}
Local cLPath := "\"
Local nOpRight := 1
Local aRList := {}, aRFiles := {}
Local cRPath := "FTP Client (Não Conectado)"
Local oMenuBar
Local oTMenu1, oTMenu2, oTMenu3, oTMenu4
Local oFtp
Local lConnected := .F.
Local aGetsL := {} , aGetsR := {}
Local cFname := space(50)
Local cFAttr := space(50)
Local cFDate := space(18)
Local nFSize := 0
Local cRFname := space(50)
Local cRFAttr := space(50)
Local cRFDate := space(18)
Local nRFSize := 0
Local aFTPInfo := {}
Local oLSay,oRSay

aadd(aFTPInfo,space(50)) // 1 FTP Addr
aadd(aFTPInfo,21) // 2 FTP Port
aadd(aFTPInfo,5) // 3 FTP TimeOut (sec)
aadd(aFTPInfo,.T.) // 4 Firewall Mode ( passive )
aadd(aFTPInfo,.F.) // 5 Use IP Conn
aadd(aFTPInfo,.T.) // 6 Anonymous Login
aadd(aFTPInfo,"anonymous") // 7 User
aadd(aFTPInfo,"") // 8 Password

// Define Formato de data DD/MM/AAAA
SET DATE BRITISH
SET CENTURY ON

// Usa uma fonte Fixed Size, tamanho 10
oFont := TFont():New('Courier new',,-10,.T.)
SETDEFFONT(oFont)

// Cria o objeto Client de FTP
oFtp := tFtpClient():New()

// Cria a janela principal da Agenda como uma DIALOG
DEFINE WINDOW oDlg FROM 0,0 TO 600,800 PIXEL ;
  TITLE (cTitle) NOSYSMENU

// Permite ESC fechar a janela
oDlg:lEscClose := .T.

// Primeiro cria a barra superior de Menus da Aplicação na Janela Principal
oMenuBar := tMenuBar():New(oDlg)
oMenuBar:SetColor(CLR_BLACK,CLR_WHITE)

// Agora cria a tela inicial
oSplitter := tSplitter():New( 00,00,oDlg,400,280 )
oSplitter:ALIGN := CONTROL_ALIGN_ALLCLIENT

@ 0,0 MSPANEL oPLeft LOWERED SIZE 130, 36 OF oSplitter
@ 0,0 MSPANEL oPRight LOWERED SIZE 130, 36 OF oSplitter

oPLeft:ALIGN := CONTROL_ALIGN_ALLCLIENT
oPRight:ALIGN := CONTROL_ALIGN_ALLCLIENT

@ 0,0 MSPANEL oPLeftUp SIZE 130, 10 OF oPLeft
@ 0,0 MSPANEL oPLeftMid SIZE 130, 15 OF oPLeft
@ 0,0 MSPANEL oPLeftBottom SIZE 130, 65 OF oPLeft

oPLeftUp:ALIGN := CONTROL_ALIGN_TOP
oPLeftBottom:ALIGN := CONTROL_ALIGN_BOTTOM
oPLeftMid:ALIGN := CONTROL_ALIGN_ALLCLIENT

@ 1,1 SAY oLSay PROMPT cLPath SIZE 120,15 COLOR CLR_BLACK,CLR_WHITE ;
  of oPLeftUp PIXEL

@ 0,0 MSPANEL oPRightUp SIZE 130, 10 OF oPRight
@ 0,0 MSPANEL oPRightMid SIZE 130, 15 OF oPRight
@ 0,0 MSPANEL oPRightBottom SIZE 130, 65 OF oPRight

oPRightUp:ALIGN := CONTROL_ALIGN_TOP
oPRightBottom:ALIGN := CONTROL_ALIGN_BOTTOM
oPRightMid:ALIGN := CONTROL_ALIGN_ALLCLIENT

@ 1,1 SAY oRSay PROMPT cRPAth SIZE 120,15 COLOR CLR_BLACK,CLR_WHITE ;
  of oPRightUp PIXEL

// ListBox lado esquerdo
// Arquivos do servidor a partir do RootPath 

aLList := GetLFiles(cLPath,@aLFiles)

@0,0 LISTBOX oLbxLeft VAR nOpLeft;
  ITEMS aLList ;
  ON CHANGE ( doLChange(aGetsL,oLbxLeft,@aLList,@aLFiles) ) ;
  ON DBLCLICK ( EnterLeft(oLbxLeft,@aLList,@aLFiles,@cLPath) ) ;
  OF oPLeftMid

oLbxLeft:ALIGN := CONTROL_ALIGN_ALLCLIENT

aRList := {}

@ 15,15 LISTBOX oLbxRight VAR nOpRight;
  SIZE 300, 300 ;
  OF oPRightMid ;
  ITEMS aRList ;
  ON CHANGE ( doRChange(aGetsR,oLbxRight,@aRList,@aRFiles) ) ;
  ON DBLCLICK ( EnterRight(oFtp,aFtpInfo,oLbxRight,oRSay,@aRList,;
  @aRFiles,@cRPath) ) ;
  PIXEL

oLbxRight:ALIGN := CONTROL_ALIGN_ALLCLIENT

oLSay:ALIGN := CONTROL_ALIGN_TOP
oRSay:ALIGN := CONTROL_ALIGN_TOP

// Insere os gets com os dados do arquivo atual
// do lado esquerdo. Os dados são atualizados conforme
// é feita a navegação na lista

@ 05+3,02 SAY oSay PROMPT "Arquivo" SIZE 40,10 ;
  COLOR CLR_BLACK,CLR_WHITE OF oPLeftBottom PIXEL
@ 05,50 GET oGetFName VAR cFname SIZE CALCSIZEGET(40),10 ;
  OF oPLeftBottom PIXEL
oGetFName:SETENABLE(.F.)
aadd(aGetsL,oGetFName)

@ 20+3,02 SAY oSay PROMPT "Tamanho" SIZE 40,10 ;
  COLOR CLR_BLACK,CLR_WHITE OF oPLeftBottom PIXEL
@ 20,50 GET oGetFSize VAR nFSize PICTURE "999999999999999999" ;
  SIZE CALCSIZEGET(18),10 OF oPLeftBottom PIXEL
oGetFSize:SETENABLE(.F.)
aadd(aGetsL,oGetFSize)

@ 35+3,02 SAY oSay PROMPT "Data" SIZE 40,10 ;
  COLOR CLR_BLACK,CLR_WHITE OF oPLeftBottom PIXEL
@ 35,50 GET oGetFDate VAR cFDate SIZE CALCSIZEGET(18),10 ; 
  OF oPLeftBottom PIXEL
oGetFDate:SETENABLE(.F.)
aadd(aGetsL,oGetFDate)

@ 50+3,02 SAY oSay PROMPT "Atributos" SIZE 40,10 ; 
  COLOR CLR_BLACK,CLR_WHITE OF oPLeftBottom PIXEL
@ 50,50 GET oGetFAttr VAR cFAttr SIZE CALCSIZEGET(5),10 ;
  OF oPLeftBottom PIXEL
oGetFAttr:SETENABLE(.F.)
aadd(aGetsL,oGetFAttr)

// Insere dados e detalhes dos arquivos do FTP
// Os dados são atualizados conforme
// é feita a navegação na lista

@ 05+3,02 SAY oSay PROMPT "Arquivo" SIZE 40,10 ;
  COLOR CLR_BLACK,CLR_WHITE OF oPRightBottom PIXEL
@ 05,50 GET oRFName VAR cRFname SIZE CALCSIZEGET(40),10 ;
  OF oPRightBottom PIXEL
oRFName:SETENABLE(.F.)
aadd(aGetsR,oRFName)

@ 20+3,02 SAY oSay PROMPT "Tamanho" SIZE 40,10 ;
  COLOR CLR_BLACK,CLR_WHITE OF oPRightBottom PIXEL
@ 20,50 GET oRFSize VAR nRFSize PICTURE "999999999999999999" ;
  SIZE CALCSIZEGET(18),10 OF oPRightBottom PIXEL
oRFSize:SETENABLE(.F.)
aadd(aGetsR,oRFSize)

@ 35+3,02 SAY oSay PROMPT "Data" SIZE 40,10 ;
  COLOR CLR_BLACK,CLR_WHITE OF oPRightBottom PIXEL
@ 35,50 GET oRFDate VAR cRFDate SIZE CALCSIZEGET(18),10 ;
  OF oPRightBottom PIXEL
oRFDate:SETENABLE(.F.)
aadd(aGetsR,oRFDate)

@ 50+3,02 SAY oSay PROMPT "Atributos" SIZE 40,10 ;
  COLOR CLR_BLACK,CLR_WHITE OF oPRightBottom PIXEL
@ 50,50 GET oRFAttr VAR cRFAttr SIZE CALCSIZEGET(5),10 ;
  OF oPRightBottom PIXEL
oRFAttr:SETENABLE(.F.)
aadd(aGetsR,oRFAttr)

// Insere as opções de Menu

oTMenu1 := TMenu():New(0,0,0,0,.T.,,oDlg,CLR_BLACK,CLR_WHITE)
oMenuBar:AddItem('&Local' , oTMenu1, .T.)

oTMenu1:Add( TMenuItem():New(oDlg,'&Path',,,,;
  {|| LocalPath(oLbxLeft,@aLList,@aLFiles,oLSay,@cLPath) },,,,,,,,,.T.))
oTMenu1:Add( TMenuItem():New(oDlg,'Sai&r',,,,;
  {||oDlg:End()},,,,,,,,,.T.))

oTMenu2 := TMenu():New(0,0,0,0,.T.,,oDlg,CLR_BLACK,CLR_WHITE)
oMenuBar:AddItem('&FTP' , oTMenu2, .T.)

oTMenu2:Add( TMenuItem():New(oDlg,'&Conectar' ,,,,;
  {|| FTPConn(oDlg,oPRight,oFtp,@aFTPInfo,oLbxRight,@aRList,@aRFiles,oRSay,@cRPath) },,,,,,,,,.T.))
oTMenu2:Add( TMenuItem():New(oDlg,'&Desconectar',,,,;
  {|| FTPDesConn(oDlg,oPRight,oFtp,@aFTPInfo,oLbxRight,@aRList,@aRFiles,oRSay,@cRPath) },,,,,,,,,.T.))

oTMenu4 := TMenu():New(0,0,0,0,.T.,,oDlg,CLR_WHITE,CLR_BLACK)
oMenuBar:AddItem('&Ajuda', oTMenu4, .T.)

oTMenu4:Add(TMenuItem():New(oDlg,'&Sobre',,,,{|| About()},,,,,,,,,.T.))

// Ajusta o tamanho do Menu com o Tamanho da Janela
// PAra nao "suprimir" opções com ">>"
oMenuBar:NWIDTH := oDlg:nWidth

// Posiciona no primeiro arquivo
oLbxLeft:Gotop()

// Copiar Arquivo
SETKEY( VK_F5 , {|| IIF(_KeyRunning , NIL , ;
   ( _KeyRunning := .T. , ;
     CallKey(VK_F5 ,oLbxLeft,oLbxRight,aLFiles,aLList,;
             aRFiles,aRList,cLPath,cRPath,oFtp),;
     _KeyRunning := .F. ))})

ACTIVATE WINDOW oDlg MAXIMIZED ;
  ON INIT DoInit(oDlg) ;
  VALID CanQuit()

// Fecha a conexao com o FTP caso esteja aberta
oFtp:Close()

Return

Estrutura da Interface

A primeira escolha da interface foi usar uma WINDOW para a criação do programa, pois ela permite o redimensionamento da janela. E, para que o redimensionamento mão me obrigasse a fazer cálculos rebuscados de alinhamento de componentes, a grande sacada foi usar um objeto visual tSplitter() para dividir a tela principal em dois painéis, cada um ocupando automaticamente 50% da tela, e dentro de cada painél, mais três painéis de alinhamento automático, para permitir um header e um footer em cada painel, onde a área central contém um tListBox(), que será populado do lado esquerdo com os arquivos locais, e do lado direito com os arquivos da pasta atual do FTP Server conectado.

Para executar o programa, basta iniciar um SmartClient, e chamar diretamente a função U_FTPMANAGER.

FTP Client 1

Ao entrar, o programa ainda não está conectado a nenhum FTP Server, então ele mostra do lado esquerdo a estrutura de pastas a partir do RootPath do Ambiente no Protheus Server, e do lado direito uma lista sem itens.

FTP Client 2

Menu Local

No menu superior chamado “Local”, a opção “Path” permite trocar diretamente a pasta atual do painel do lado esquerdo. Para isso, é aberta uma interface de navegação (função cGetFile) que permite escolher inclusive navegar pela estrutura de pastas do Protheus Server — a partir do Rootpath do ambiente — para escolher um diretório de trabalho.

FTP Client 3

Segue abaixo o fonte da função de menu “LocalPath()

/* ----------------------------------------------------------------------
Permite trocar a pasta atual navegando diretamente
na estrutura de pastas do Servidor a partir do RootPath
---------------------------------------------------------------------- */

STATIC Function LocalPath(oLbxLeft,aLList,aLFiles,oLSay,cLPath)
Local cRet

cRet := cGetFile( 'Todos os Arquivos|*.*' , ;
   'Path', 1, cLPath, .F., GETF_RETDIRECTORY ,.T., .T. )

If !empty(cRet)
  // Troca o path e atualiza a lista de arquivos na tela
  cLPath := cRet
  aLList := GetLFiles(cLPath,aLFiles)
  oLbxLeft:SetArray(aLList)
  oLbxLeft:GoTop()
  oLSay:SetText(cLPath)
Endif

Return

Também temos a opção de Sair, que também pode ser acionada com a tecla ESC.

Menu FTP

No menu superior chamado “FTP”, a opção “Conectar” permite especificar as informações de conexão com um FTP Server, através de uma caixa de diálogo. Normalmente as informações mínimas necessárias — pelo menos para acessar um servidor publico de download — são apenas HOST ou IP do FTP Server, e o número da porta. As demais informações já foram determinadas no programa como DEFAULT.

FTP Client 4

Segue abaixo o fonte da função de conexão com o FTP — “FTPConn()” — Esta função acaba fazendo um pouco mais do que apenas conectar, mas também atualizar o endereço atual do FTP no painel superior, e os arquivos da pasta atual no tListBox() do lado direito.

/* ----------------------------------------------------------------------
Diálogo de Conexão com FTP
Armazema parametros de conexao, e em caso de sucesso,
já alimenta a lista de arquivos do lado direito
---------------------------------------------------------------------- */

STATIC Function FTPConn(oDlg,oPRight,oFtp,aFTPInfo,oLbxRight,aRList,aRFiles,oRSay,cRPath)
Local cTitle := 'Conexão com FTP'
Local oSay1,oSay2
Local lGo := .F.
Local cFTPAddr := padr(aFTPInfo[1],40)
Local nFtpPort := aFTPInfo[2]
Local nTimeOut := aFTPInfo[3]
Local bPasv := aFTPInfo[4]
Local bUseIP := aFTPInfo[5]
Local bAnonymous := aFTPInfo[6]
Local cUser := padr(aFTPInfo[7],40)
Local cPass := padr(aFTPInfo[8],40)
Local nStat

DEFINE DIALOG oDlgConn TITLE (cTitle) ;
  FROM 0,0 TO 220,450 PIXEL;
  OF oDlg ;
  COLOR CLR_WHITE, CLR_BROWN

@ 05+3,05 SAY oSay1 PROMPT "FTP" RIGHT SIZE 40,12 OF oDlgConn PIXEL
@ 05,50 GET oGetFTP VAR cFtpAddr SIZE CALCSIZEGET(40) ,12 OF oDlgConn PIXEL

@ 20+3,05 SAY oSay2 PROMPT "Porta" RIGHT SIZE 40,12 OF oDlgConn PIXEL
@ 20,50 GET oGetPorta VAR nFtpPort PICTURE "99999" ;
  SIZE CALCSIZEGET(5) ,12 OF oDlgConn PIXEL

@ 20+3,100 SAY oSay3 PROMPT "TimeOut" RIGHT SIZE 40,12 OF oDlgConn PIXEL
@ 20,145 GET oGetTimeOut VAR nTimeOut PICTURE "999" ;
  SIZE CALCSIZEGET(3) ,12 OF oDlgConn PIXEL

@ 35,50 CHECKBOX oCkh1 VAR bPasv PROMPT "Passive Mode" ;
  SIZE 80,12 OF oDlgConn PIXEL

@ 45,50 CHECKBOX oCkh2 VAR bUseIP PROMPT "Use IP Conn" ;
  SIZE 80,12 OF oDlgConn PIXEL

@ 55,50 CHECKBOX oCkh3 VAR bAnonymous PROMPT "Anonymous Login" ;
  SIZE 80,12 OF oDlgConn PIXEL

@ 65+3,05 SAY oSay1 PROMPT "Usuário" RIGHT SIZE 40,12 OF oDlgConn PIXEL
@ 65,50 GET oGetUsr VAR cUser SIZE CALCSIZEGET(40) ,12 ;
  WHEN !bAnonymous OF oDlgConn PIXEL

@ 80+3,05 SAY oSay2 PROMPT "Senha" RIGHT SIZE 40,12 OF oDlgConn PIXEL
@ 80,50 GET oGetPsw VAR cPass SIZE CALCSIZEGET(40) ,12 ;
  WHEN !bAnonymous OF oDlgConn PIXEL
oGetPsw:LPASSWORD := .T.

@ 95, CALCSIZEGET(40) - 10 BUTTON oBtnOk PROMPT "Ok" SIZE 60,15 ;
  ACTION (lGo := .T. , oDlgConn:End()) OF oDlgConn PIXEL

ACTIVATE DIALOG oDlgConn CENTER

If lGo

  // Fecha qqer conexão existente anteriormente
  oFTP:Close()

  // Ajusta os parametros
  cFTPAddr := alltrim(cFTPAddr)
  cUser := alltrim(cUser)
  cPass := alltrim(cPass)

  // Guarda os parâmetros utilizados
  aFTPInfo[1] := cFTPAddr
  aFTPInfo[2] := nFtpPort
  aFTPInfo[3] := nTimeOut
  aFTPInfo[4] := bPasv
  aFTPInfo[5] := bUseIP
  aFTPInfo[6] := bAnonymous
  aFTPInfo[7] := cUser
  aFTPInfo[8] := cPass

  // Seta parâmetros na classe antes de conectar
  oFtp:BFIREWALLMODE := bPasv
  oFtp:NCONNECTTIMEOUT := nTimeOut
  oFtp:BUSESIPCONNECTION := bUseIP
 
  // Conecta no FTP
  If !bAnonymous
    MsgRun("FTP Connect",cFtpAddr,;
      {|| nStat := oFtp:FtpConnect(cFtpAddr,nFTPPort,cUser,cPass) })
  Else
    MsgRun("FTP Connect",cFtpAddr,;
      {|| nStat := oFtp:FtpConnect(cFtpAddr,nFTPPort,"anonymous","anonymous") })
  Endif

  If nStat == 0
    cCurrDir := ''
    nStat := oFtp:GETCURDIR(@cCurrDir)
    If nStat <> 0
      cRPath := "ftp://"+cFtpAddr+"/"
      oRSay:SetText(cRPath)
      oRSay:Refresh()
      MsgStop("Falha ao recuperar executar GetCurDir() - Erro "+;
        cValtoChar(nStat),oFtp:CERRORSTRING)
    Else
      // Atualiza pasta atual do FTP
      cRPath := "ftp://"+cFtpAddr+cCurrDir
      oRSay:SetText(cRPath)
      oRSay:Refresh()
    Endif
    // Limpa lado direito
    aSize(aRFiles,0)
    aSize(aRList,0)
    oLbxRight:SetArray(aRList)

    // Conectou com sucesso, recupera pasta atual e lista de arquivos
    MsgRun("Obtendo lista de arquivos",cRPath,;
      {|| aRFiles := oFtp:Directory("*",.T.) })
    aSize(aRList,0)

    aEval(aRFiles,{|x| aadd( aRList , alltrim(x[1]) )})
    oLbxRight:SetArray(aRList)

  Else

    aSize(aRFiles,0)
    aSize(aRList,0)
    oLbxRight:SetArray(aRList)

    MsgStop("Falha de Conexão -- Erro "+cValToChar(nStat),;
      oFtp:CERRORSTRING)
    cRPath := "FTP Client (Não Conectado)"
    oRSay:SetText(cRPath)
  Endif

  oLbxRight:GoTop()
  oPRight:Refresh()

Endif

Return

Reparem que algumas chamadas do FTP foram encapsuladas pela função MsgRun() — isto foi proposital, pois se você está conectando com um servidor de FTP mais “longe”, com latência de rede, as operações podem demorar um pouco, e dessa forma sabemos que função está sendo executada — enquanto ela está sendo executada.

Navegação e Funções

Para navegar entre as pastas, tanto de arquivos locais como do FTP, utilize ENTER ou Duplo Clique nas pastas. Para voltar para a pasta anterior, utilize o primeiro arquivo da lista, chamado “..”. Estas regras de navegação valem para ambos os painéis de arquivos – lado direito e esquerdo.

Por hora, as únicas funções disponíveis — além da navegação nas pastas — é a tecla F5. Caso você esteja com o foco em um arquivo local, e pressionar F5, a aplicação permite fazer UPLOAD deste arquivo na pasta atual do FTP mostrada no painel direito. E, caso você esteja com o foco em um arquivo do FTP, no painel direito, e pressionar F5, a aplicação permite fazer o Download do arquivo para a pasta local sendo mostrada no painel esquerdo.

A tecla ENTER ou o Duplo Clique em um arquivo ou pasta do painel esquerdo dispara a função EnterLeft() — vista abaixo:

/* ----------------------------------------------------------------------
Funcao disparada em caso de [ENTER] ou Duplo Click em um arquivo
na lista de arquivos locais -- lado esquerdo. Permite a navegação
entre os diretorios.
---------------------------------------------------------------------- */

STATIC Function EnterLeft(oLbxLeft,aLList,aLFiles,cLPath)
Local cFile
Local aTmp, nI
Local nOp := oLbxLeft:GetPos()

If nOp > 0
  cFile := alltrim(aLList[nOp])
  If cFile == '..'
    // Tenta ir para o nivel anterior
    aTmp := StrTokarr(cLPath,'\')
    cLPath := ''
    For nI := 1 to len(aTmp)-1
      cLPath += ( aTmp[nI] + '\')
    Next
    if empty(cLPath)
      cLPath := '\'
    Endif
    aLList := GetLFiles(cLPath,aLFiles)
    oLbxLeft:SetArray(aLList)
    oLbxLeft:GoTop()
  Else
    // SE for um diretorio, entra nele
    aTmp := aLFiles[nOp]
    if 'D' $ aTmp[5]
      // Se for um diretorio , entra
      cLPath += ( cFile+'\' )
      aLList := GetLFiles(cLPath,aLFiles)
      oLbxLeft:SetArray(aLList)
      oLbxLeft:GoTop()
    Endif
  Endif
Endif
Return

Esta função usa algumas funções auxiliares, que serão vistas no código completo — a ser disponibilizado no GITHUB. Por hora, vamos dar uma olhada também na função de navegação do lado direito — pasta do FTP Server conectado.

/* ----------------------------------------------------------------------
Função disparada em caso de [ENTER] ou Duplo Click em um arquivo
na lista de arquivos de FTP - Lado direito -- Permite navegar
entre os diretórios.
---------------------------------------------------------------------- */
STATIC Function EnterRight(oFTP,aFtpInfo,oLbxRight,oRSay,aRList,aRFiles,cRPath)
Local cFile
Local aTmp, nI
Local nOp := oLbxRight:GetPos()
Local cCurrDir

If nOp > 0
  cFile := alltrim(aRList[nOp])
    If cFile == '..'
    // Volta ao nivel anterior
    nStat := oFTP:CDUP()
    If nStat != 0
      MsgStop("Falha ao mudar de Diretorio - Erro "+cValToChar(nStat),oFtp:CERRORSTRING)
    Else
      cCurrDir := ''
      nStat := oFtp:GETCURDIR(@cCurrDir)
      cRPath := "ftp://"+aFtpInfo[1]+cCurrDir
      oRSay:SetText(cRPath)
      oRSay:Refresh()
      // Pega os arquivos do diretorio atual
      MsgRun("Obtendo lista de arquivos",cRPath,{|| aRFiles := oFtp:Directory("*",.T.) })
      aSize(aRList,0)
      // Acrescenta um atalho para voltar para o nivel anterior
      // SE eu nao estiver no niver RAIZ ...
      IF !(cCurrDir == '/')
        aadd(aRFiles,{"..",0,ctod(""),"",""})
        aSort(aRFiles,,,{|x1,x2| lower(x1[1]) < lower(x2[1]) })
      Endif
      aEval(aRFiles,{|x| aadd( aRList , alltrim(x[1]) )})
      oLbxRight:SetArray(aRList)
      oLbxRight:GoTop()
    Endif
  Else
    // SE for um diretorio, entra nele
    aTmp := aRFiles[nOp]
    if 'D' $ aTmp[5]
      // Se for um diretorio , entra
      // Troca o diretorio atual
      nStat := oFTP:CHDIR(cFile)
      If nStat != 0
        MsgStop("Falha ao mudar de Diretorio - Erro "+cValToChar(nStat),oFtp:CERRORSTRING)
      Else
        cRPath += ( cFile+'/' )
        oRSay:SetText(cRPath)
        // Pega os arquivos do diretorio atual
        MsgRun("Obtendo lista de arquivos",cRPath,{|| aRFiles := oFtp:Directory("*",.T.) })
        aSize(aRList,0)
        // Acrescenta um atalho para voltar para o nivel anterior
        aadd(aRFiles,{"..",0,ctod(""),"",""})
        aSort(aRFiles,,,{|x1,x2| lower(x1[1]) < lower(x2[1]) })
        aEval(aRFiles,{|x| aadd( aRList , alltrim(x[1]) )})
        oLbxRight:SetArray(aRList)
        oLbxRight:GoTop()
      Endif
    Endif
  Endif
Endif
Return

Pulos do Gato

Alguns pulos do gato neste fonte, além dos alinhamentos, foram a escolha dos arrays. Para cada tListBox, existem 2 arrays que trabalham em “paralelo”, um deles apenas com o nome dos arquivos, para ser mostrado na tela, e o outro array com 5 colunas, contendo o nome, tamanho, atributos e detalhes do arquivo, tanto da pasta local como do FTP. Trabalhar com estes arrays de forma sincronizada permite as validações para a navegação entre pastas, por exemplo, para ignorar um Enter ou Duplo Clique em um arquivo — ao invés de uma pasta.

Outra sacada está no controle do disparo da tecla de atalho F5, para a cópia dos arquivos. Primeiro, a forma de setar o bloco de código usando uma variável STATIC, inicializada com o valor .F. :

SETKEY( VK_F5 , {|| IIF(_KeyRunning , NIL , ;
  ( _KeyRunning := .T. , ;
    CallKey(VK_F5 ,oLbxLeft,oLbxRight,aLFiles,aLList,;
    aRFiles,aRList,cLPath,cRPath,oFtp) , ;
    _KeyRunning := .F. ))})

Na prática, isso evita o duplo disparo da tecla F5,  e ainda mais, quando forem acrescentadas novas teclas de função ou atalho, esta proteção vai fazer com que o primeiro atalho disparado não permita nenhuma outra tecla de atalho ser executada. O tratamento da ação da tecla será determinado internamente dentro da função CallKey(), que recebe todos os parâmetros necessários para ela obter os dados que ela precisa, e fazer uma atualização da interface se ou quando necessário.

A outra grande sacada é descobrir em qual componente eu estou com o FOCO, para eu saber se, quando eu pressionar F5, eu devo copiar o arquivo Local para o FTP, ou baixar o arquivo do FTP para a pasta local ? Vamos ao fonte:

/* ----------------------------------------------------------------------
Teclas de Atalho de funcionalidades do FTP
F5 = Copiar Arquivo ( Download ou Upload ) 
---------------------------------------------------------------------- */

STATIC Function CallKey(nKey,oLbxLeft,oLbxRight,aLFiles,aLList,aRFiles,aRList,cLPath,cRPath,oFtp)
Local hHndFocus
Local nPos
Local cFile
Local cSource
Local cTarget
Local cCurrDir
Local lExist
Local lRun
// Pega Handle do componente de interface que estava com o foco
// quando a tecla de atalho foi pressionada
hHndFocus := GETFOCUS()
If hHndFocus == oLbxLeft:HWND
  // Caso o foco esteja na lista de arquivos locais
  // E exista um arquivo posicionado ... 
  nPos := oLbxLeft:GetPos()
  If nPos > 0
    cFile := alltrim(aLFiles[nPos][1])
    cAttr := aLFiles[nPos][5]
    If cFile == '.' .or. cFile == '..'
      MsgStop("Operação com pasta não implementada. Selecione um arquivo.","Atenção")
      return
    ElseIf 'D'$cAttr
      MsgStop("Operação com pasta não implementada. Selecione um arquivo.","Atenção")
      return
    Endif
    If nKey == VK_F5
      // Copia de arquivo Local para o FTP
      cSource := cLPath+cFile
      cTarget := cRPath+cFile
      If MsgYEsNo("Seseja copiar o arquivo local ["+cSource+"] para o FTP ["+cTarget+"] ?")
        MsgRun("FTP Upload",cFile,{|| nStat := oFTP:SENDFILE(cSource,cFile) })
        If nStat <> 0
          MsgStop("Falha no UPLOAD de Arquivo - Erro "+cValToChar(nStat),oFtp:CERRORSTRING)
        Else
          MsgInfo("Upload realizado com sucesso.")
          cCurrDir := ''
          oFtp:GETCURDIR(@cCurrDir)
          // Pega os arquivos do diretorio atual
          MsgRun("Obtendo lista de arquivos",cRPath,{|| aRFiles := oFtp:Directory("*",.T.) })
          aSize(aRList,0)
          // Acrescenta um atalho para voltar para o nivel anterior
          // SE eu nao estiver no nivel RAIZ ...
          IF !(cCurrDir == '/')
            aadd(aRFiles,{"..",0,ctod(""),"",""})
            aSort(aRFiles,,,{|x1,x2| lower(x1[1]) < lower(x2[1]) })
          Endif
          aEval(aRFiles,{|x| aadd( aRList , alltrim(x[1]) )})
          oLbxRight:SetArray(aRList)
        Endif
      Endif
    Else
      MsgInfo("Operação com Arquivo Local ainda não implementada.")
    Endif
  Endif
ElseIf hHndFocus == oLbxRight:HWND
  // Copia arquivo do FTP para pasta Local
  // e exista algum arquivo posicionado
  nPos := oLbxRight:GetPos()
  IF nPos > 0
    cFile := alltrim(aRFiles[nPos][1])
    cAttr := aRFiles[nPos][5]
    If cFile == '.' .or. cFile == '..'
      MsgStop("Operação com pasta não implementada. Selecione um arquivo.","Atenção")
      return
    ElseIf 'D'$cAttr
      MsgStop("Operação com pasta não implementada. Selecione um arquivo.","Atenção")
      return
    Endif
    // Ajusta o nome vindo do FTP 
    AdjustFTP(@cFile)
    If nKey == VK_F5
      // Copia de arquivo do FTP para a pasta local 
      cSource := cRPath+cFile
      cTarget := cLPath+cFile
      lExist := File(cLPath+cFile)
      lRun := .F. 
      IF lExist
        If MsgYesNo("O Arquivo local já existe. Deseja continuar o Download ? ")
          lRun := .T.
          MsgRun("FTP Resume Download",cFile,{|| nStat := oFTP:RESUMERECEIVEFILE(cFile,cTarget) })
        ElseIf MsgYesNo("Apaga o arquivo local e reinicia o Download ?")
          lRun := .T.
          Ferase(cLPath+cFile)
          MsgRun("FTP Download",cFile,{|| nStat := oFTP:RECEIVEFILE(cFile,cTarget) })
        Endif
      Else
        If MsgYEsNo("Deseja baixar o arquivo do FTP ["+cSource+"] para a pasta local ["+cTarget+"] ?")
          lRun := .T.
          MsgRun("FTP Download",cFile,{|| nStat := oFTP:RECEIVEFILE(cFile,cTarget) })
        Endif
      Endif
      If lRun
        If nStat <> 0
          MsgStop("Falha no DOWNLOAD de Arquivo - Erro "+cValToChar(nStat),oFtp:CERRORSTRING)
        Else
          MsgInfo("Download realizado com sucesso.")
          // Atualiza lista de arquivos 
          aLList := GetLFiles(cLPath,aLFiles)
          oLbxLeft:SetArray(aLList)
        Endif
      Endif
    Else
      MsgInfo("Operação com Arquivo do FTP ainda não implementada.")
    Endif
  Endif
Endif

Return

A mágica do foco é feita inicialmente usando a função GetFocus(), que retorna o ID ou “Handler” do componente de interface que está em foco no momento. Como eu estou iniciando o processamento de uma tecla de atalho que não está relacionada a nenhum componente de interface, pressionar F5 não muda o foco do componente de interface atual.

hHndFocus := GETFOCUS()

A segunda parte da mágica, é eu verificar SE o componente em foco é a lista de arquivos do lado direito ou do lado esquerdo. No momento, estes são os únicos componentes da minha interface — fora o Menu — que permitem foco. Logo, eu devo estar posicionado em um deles. Cada componente da interface visual possui um ID ou “Handler”, dado no momento da criação deste componente, e você pode consultá-lo através da propriedade HWND.

If hHndFocus == oLbxLeft:HWND

Desta forma, eu sei se o foco está no tListBox do lado esquerdo, e realizando o mesmo teste com o objeto oLbxRight, eu sei se ele está com foco no lado direito. Se nenhuma das alternativas for a correta, eu assumo que foi pressionado F5 quando o foco não estava em nenhum componente válido para realizar a execução desta funcionalidade.

Detalhes dos Arquivos em Foco

Cada tListBox() foi parametrizado para disparar um evento ONCHANGE, na mudança da seleção ou foco em um item. Este evento é usado pelas funções  doLChange() e doRChange() para atualizar os detalhes dos arquivos em foco nos painéis, vide fonte abaixo:

/* ----------------------------------------------------------------------
Função disparada na troca de posição da lista de arquivos
do lado esquerdo -- arquivos locais
Atualiza as informações do arquivo selecionado no painel inferior
---------------------------------------------------------------------- */

STATIC Function doLChange(aGetsL,oLbxLeft,aLList,aLFiles)
Local cFname , cFDate, nFSize , cFAttr
Local nOp := oLbxLeft:GetPos()
If nOp > 0 .and. nOp <= Len(aLList)
  cFname := aLFiles[nOp][1]
  nFSize := aLFiles[nOp][2]
  cFDate := dtoc(aLFiles[nOp][3])+' ' +aLFiles[nOp][4]
  cFattr := aLFiles[nOp][5]
  Eval(aGetsL[1]:bSetGet,cFname)
  Eval(aGetsL[2]:bSetGet,nFSize)
  Eval(aGetsL[3]:bSetGet,cFDate)
  Eval(aGetsL[4]:bSetGet,cFattr)
Else
  Eval(aGetsL[1]:bSetGet,"")
  Eval(aGetsL[2]:bSetGet,0)
  Eval(aGetsL[3]:bSetGet,"")
  Eval(aGetsL[4]:bSetGet,"")
Endif
aGetsL[1]:Refresh()
aGetsL[2]:Refresh()
aGetsL[3]:Refresh()
aGetsL[4]:Refresh()
return


/* ----------------------------------------------------------------------
Função disparada na troca de posição da lista de arquivos FTP
do lado direito.
Atualiza as informações do arquivo selecionado no painel inferior
---------------------------------------------------------------------- */
STATIC Function doRChange(aGetsR,oLbxRight,aRList,aRFiles)
Local cFname , cFDate, nFSize , cFAttr
Local nOp := oLbxRight:GetPos()
If nOp > 0 .and. nOp <= Len(arList)
  cFname := aRFiles[nOp][1]
  nFSize := aRFiles[nOp][2]
  cFDate := dtoc(aRFiles[nOp][3])+' ' +aRFiles[nOp][4]
  cFattr := aRFiles[nOp][5]
  Eval(aGetsR[1]:bSetGet,cFname)
  Eval(aGetsR[2]:bSetGet,nFSize)
  Eval(aGetsR[3]:bSetGet,cFDate)
  Eval(aGetsR[4]:bSetGet,cFattr)
Else
  Eval(aGetsR[1]:bSetGet,"")
  Eval(aGetsR[2]:bSetGet,0)
  Eval(aGetsR[3]:bSetGet,"")
  Eval(aGetsR[4]:bSetGet,"")
Endif
aGetsR[1]:Refresh()
aGetsR[2]:Refresh()
aGetsR[3]:Refresh()
aGetsR[4]:Refresh()
return

Conclusão

Muitas vezes o fonte cresce em trabalho, não necessariamente em complexidade — desde que ele já tenha nascido usando um mínimo de boas práticas de programação. Se você olhar o fonte com uma lupa, vai ver que ainda existe códigos duplicados e algumas “pontas soltas”, que serão vistas na continuação desse post! O Fonte completo está no link do GITHUB logo abaixo, nas referências.

Agradeço novamente a todos pela audiência e lhes desejo TERABYTES DE SUCESSO !!! 

Referências

 

Orientação a Objetos em AdvPL – Parte 01

Introdução

Para quem ainda não sabe o que é ou porquê a Orientação a Objetos, também conhecida por OOP (Object Oriented Programming), nesse post vamos dar uma passada mais a fundo neste tema, cobrindo algumas lacunas dos posts anteriores, para depois entrar nas recentes melhorias e implementações a serem disponibilizadas na próxima Build Oficial do TOTVS Application Server, chamada de “Lobo Guará”.

Programação Estruturada

A programação tradicional em AdvPL é conhecida por ser estruturada. Na prática, o sistema inteiro é criado a partir de funções ou sub-rotinas, usando estruturas de decisão (IF/CASE) e repetição (FOR/WHILE).

Normalmente as funções criadas declaram e usam variáveis de escopo local — vistas apenas dentro do corpo da função — e podem usar escopos mais abrangentes para compartilhar valores entre funções do mesmo fonte (STATIC), funções na pilha de chamadas (PRIVATE) e ainda entre qualquer função do sistema (PUBLIC), sem a necessidade de passagem de parâmetros.

A restrição de acesso à variáveis e funções normalmente é feita pelo escopo. As funções declaradas em um fone AdvPL por default são públicas — qualquer fonte pode chamar qualquer função — e podemos declarar a função como STATIC FUNCTION, restringindo sua visibilidade apenas para as demais funções presentes no mesmo código fonte onde a função foi declarada.

Programação Orientada a Objetos

Também presente no AdvPL, a orientação a objetos consiste em criar um agrupamento de dados e funções, chamada de “CLASSE”, onde cada variável da classe é chamada de “propriedade”, e cada função da classe é chamada de “método”. Basicamente, os métodos são funções aplicáveis apenas para a classe na qual foram declarados, eles podem ter parâmetros e retornos, e eles normalmente têm acesso às propriedades da classe. Em AdvPL, dentro de um método, você tem acesso às propriedades daquela instância da classe usando a variável especial “self”.

Como a classe em si é apenas uma definição, você precisa criar um contexto daquela classe para utilizá-la. Para isso, chamamos um método do tipo “construtor”, que pode ou não receber argumentos, e seu retorno é chamado de “instância” da classe, e essa instância é do tipo AdvPL “O” Objeto.

A classe por si só já representa um “container” de informação e manutenção de informação, mas ela permite ainda um recurso de reaproveitamento e organização de funcionalidades chamada HERANÇA. Isto permite que você crie uma classe que tenha acesso aos métodos e propriedades da classe pai, e permite que você implemente propriedades e métodos que atendam a sua necessidade, usando ou substituindo as implementações da classe pai, conforme a necessidade da sua especializacao.

Escopo de propriedades, métodos e heranças

Por hora, desde as primeiras versões do Protheus Server, a orientação a objetos do AdvPL não tinha restrição de escopo, isto é, tudo é público — propriedades e métodos da classe atual, e em caso de herança, também temos acesso a propriedades e métodos da classe pai informada na herança. Logo, ao criar uma instância de uma classe, qualquer propriedade ou método desta classe pode ser visto e acessado a partir da variável que armazena a instância da classe.

Classes em AdvPL na TDN

Existe uma árvore de documentos na TDN dedicada às classes AdvPL nativas do TOTVS Application Server, incluindo classes visuais e não-visuais, disponível no link Advpl – Classes, e na seção “Como Fazer – Classes AdvPL”, a documentação de como fazer classes em AdvPL sem e com herança.

Classes em AdvPL no Blog

Complementando a documentação da TDN, no próprio BLOG já tem quatro posts sobre Classes em AdvPL, com detalhes e exemplos, vide links abaixo:

https://siga0984.wordpress.com/2014/12/01/classes-em-advpl-parte-01/
https://siga0984.wordpress.com/2014/12/02/classes-em-advpl-parte-02/
https://siga0984.wordpress.com/2014/12/03/classes-em-advpl-parte-03/
https://siga0984.wordpress.com/2014/12/06/classes-em-advpl-parte-04/

TL++

Batizada de TL++ (Totvs Language Plus Plus), a criação de classes em AdvPL passa a ter os recursos de uma orientação a objetos tradicional, como modificadores de acesso, escopo de propriedades e métodos, até mesmo declaração de tipagem. Para não conflitar com as declarações já existentes, foi adotada uma nova extensão de arquivo fonte (.tlpp) para utilizar estes recursos, que estarão disponíveis apenas na liberação oficial na nova Build do TOTVS Application Server, chamada de “Lobo Guará”. Para ver esta documentação na TDN, acesse o link A Linguagem TL++

F.A.Q.

Qual a diferença entre Classe, Instância e Objeto ?

Classe = Definição da estrutura, dividida em propriedades e métodos.
Instância = Corresponde a uma área de memória alocada para uso da classe
Objeto = Tipo da variável que contêm uma instância de uma classe

Eu posso criar uma classe sem métodos ?

Sim, inclusive isso é conhecido por “estrutura”, isto é, apenas um agrupamento de dados em propriedades. Porém, no AdvPL, você precisa criar pelo menos um método New(), para servir de construtor da estrutura. Existe uma classe diferenciada, chamada WSSTRUCT, usada em WebServices. Esta classe não precisa de construtor, porém a criação de uma nova instância de uma estrutura de WebServices é criada pela função WSCLASSNEW(), que faz o papel do construtor, porém sem receber parâmetros — e neste caso todas as propriedades da estrutura são inicializados com “NIL”.

Eu posso passar uma instancia de uma classe como parâmetro para um JOB ou RPC ?

Não, não pode. Uma instância da classe está internamente amarrada ao processo que criou a instância. Os tipos AdvPL “O” Objeto e “B” CodeBlock têm esta característica restritiva. O que você pode fazer é, por exemplo, criar uma nova instancia da classe, passar as propriedades da instância encapsulado em uma string ou array, e reatribuir as propriedades na nova instância. Neste caso, você terá uma instância “clone” da instância do processo original, e não uma “referência” dela.

Existe certo ou errado entre criar funções ou classes ?

Cada paradigma foi criado para atender a uma necessidade. É mais simples e intuitivo programar de forma estruturada, funções genéricas que não dependem diretamente de contexto ou não precisam ter o nível de controle oferecido pela Orientação a Objetos não precisam necessariamente serem feitos usando OOP.

Quando optamos por usar Orientação a Objetos, precisamos ter em mente as responsavilidades de cada parte do código, tempo de vida da instância, necessidade ou não da existência de propriedades, necessidade ou não de uso de herança.

Normalmente os dois paradigmas usam-se mutuamente. Isto é, voce cria uma função com estruturas e controles, que cria por sua vez instâncias de classes, e as manipula ou chama sua execução para obter um resultado, onde os próprios métodos são funções estruturadas. Existem várias formas de se fazer alguma coisa, a melhor é aquela que atende a sua necessidade hoje, e pode ser expandida facilmente para atender uma necessidade maior amanhã.

Para não criarmos monstros, seja programando estruturalmente, ou orientado a objeto, é importante deixar claro o papel de cada função, classe ou método. A coisa começa a ficar confusa e sem sentido quando uma classe resolve fazer mais coisas do que ela foi originalmente projetada, ou você começa a engordar a classe com métodos especialistas desnecessários.

Conclusão

Pra assimilar o conceito da utiliação de Orientação a Objetos, o melhor a fazer é colocar a mão na massa e implementar uma funcionalidade que assim a utilize, e procurar basear-se em bons exemplos de uso.

Desejo a todos TERABYTES de sucesso !!!

Referências

TOTVS – Central de Atendimento – AppServer Lobo Guará

PROGRAMAÇÃO ESTRUTURADA. In: WIKIPÉDIA, a enciclopédia livre. Flórida: Wikimedia Foundation, 2018. Disponível em: <https://pt.wikipedia.org/w/index.php?title=Programa%C3%A7%C3%A3o_estruturada&oldid=52590881>. Acesso em: 6 jul. 2018.

ORIENTAÇÃO A OBJETOS. In: WIKIPÉDIA, a enciclopédia livre. Flórida: Wikimedia Foundation, 2018. Disponível em: <https://pt.wikipedia.org/w/index.php?title=Orienta%C3%A7%C3%A3o_a_objetos&oldid=52638985>. Acesso em: 11 jul. 2018.

Web Services em AdvPL – Parte 02

Introdução

No tópico anterior sobre Web Services em AdvPL, foi apresentado um overview dos Web Services, e dois exemplos de código AdvPL para atuar como client de Web Services, utilizando um serviço publico na Internet para previsão do tempo.

Hoje, vamos criar um exemplo de um Web Service SERVER em AdvPL, que receberá como parâmetro uma estrutura complexa (ComplexType), e dentro dele um array de estruturas complexas. A idéia inicial era criar um exemplo completo de envio e retorno, mas o tópico ficaria muito grande, então optei por dividí-lo.

Web Service SERVER em AdvPL

Existe um tópico na TDN, que engloba todos os aspectos de criação de um Web Services SERVER em AdvPL, desde a configuração até o deploy de um serviço. Ele está disponível no link http://tdn.totvs.com/pages/viewpage.action?pageId=6064936 . O conteúdo do post atual no blog complementa algumas definições e parte para um exemplo onde é recomendável que você já tenha lido a TDN.

Resumindo em poucas linhas, um Web Service SERVER em AdvPL consiste na declaração de uma classe diferenciada (WSSERVICE), onde configuramos uma interface de publicação para Web Services no TOTVS Application Server, que a partir das classes WSSERVICE compiladas no RPO, consegue disponibilizar uma interface de chamada, consulta e testes via HTTP, bem como a definição (WSDL) da classe para que outras linguagens que trabalham nativamente com Web Services sejam capazes de gerar uma classe Client para consumir este Web Service.

Parâmetros e retornos

Na declaração de um Web Services SERVER em AdvPL, os parâmetros e retornos dos métodos devem ser declarados como propriedades da classe. O tipo destes parâmetros podem ser tipos simples ( http://tdn.totvs.com/pages/viewpage.action?pageId=6064941 ) ou tipos complexos ( http://tdn.totvs.com/display/tec/05.+Estruturas+-+Tipos+complexos ). Quando a quantidade de elementos de um parametro (simples ou compexo) for maior que 1, podemos declarar a propriedade como um ARRAY OF , onde o tipo pode ser simples ou complexo.

Na prática, um tipo complexo não passa de um agrupamento de um ou mais tipos simples ou complexos, como se fosse uma estrutura (classe sem métodos). Em um Web Service AdvPL, é possível declarar metodos para as estruturas, mas os métodos das estruturas não são publicados no WSDL, podem ser usados apenas dentro da classe de Web Service SERVER.

Projeto Web Services TORNEIOS

Vamos partir de um exemplo didático da criação de um WebServices para cadastrar um torneio esportivo. Os dados relevantes do torneio são as datas de inicio e final, uma descrição, e uma lista de atletas participantes. Cada atleta deve informar seu CPF, nome e data de nascimento. Opcionalmente, o atleta pode informar seu peso (em Kg) e altura (em metros).

Logo, precisamos de uma estrutura para os dados de um torneio e outra para os dados do atleta. Como um torneio pode ter vários atletas, a estrutura do atleta deve ser declarada como uma propriedade do tipo ARRAY OF ATLETA na estrutura de torneios. Vamos à primeira parte do código:

( Fonte WSSRV01.PRW )

#include "protheus.ch"
#include "apwebsrv.ch"
/* -------------------------------------------------------------
Fonte WSSRV01.PRW 
Autor Julio Wittwer
Data 10/06/2015
Descrição Fonte de exemplo de Web Services Server com 
 recebimento e retorno de tipos complexos 
 e array de tipos complexos
------------------------------------------------------------- */
// Estutura de dados de um atleta
// CPF, Nome, Aniversário ( obrigatorios ) 
// peso e altura ( opcionais )
WSSTRUCT ATLETA
 
 WSDATA CPF as STRING
 WSDATA Nome as STRING
 WSDATA Nascim as DATE 
 WSDATA PesoKg as FLOAT OPTIONAL
 WSDATA Altura as FLOAT OPTIONAL
ENDWSSTRUCT
// Estrutura de dados de um torneio 
// Descrição, data de inicio e término, e array de atletas participantes
WSSTRUCt TORNEIO
WSDATA Descricao as STRING
 WSDATA Inicio as DATE
 WSDATA Final as DATE 
 WSDATA Atletas as ARRAY OF ATLETA
 
ENDWSSTRUCT

Todas as propriedades declaradas nas estruturas (WSDATA) por default são obrigatórias. Para tornar uma propriedade opcional, usamos a palavra reservada “OPTIONAL” após o tipo da propriedade. Feita a declaração das estruturas, vamos agora para a prototipação da classe.

// Prototipação do WebServices
// Serviço de cadastro de torneios esportivos
WSSERVICE TORNEIOS DESCRIPTION "Torneios Esportivos"
 
 // propriedades de entrada e retorno, usados 
 // como parametros ou retornos nos metodos
 
 WSDATA TorneioIn AS TORNEIO 
 WSDATA Status as INTEGER 
 
 // Metodos do WebService
 WSMETHOD Incluir
ENDWSSERVICE

Por enquanto o WebService vai apenas receber os dados completos de um torneio. O foco do exemplo é justamente como os dados serão recebidos, e como você poderá enviá-los através de um Web Service client em AdvPL criado pela geração de classe client do TDS ou pela nova classe tWSDLManager. O exemplo não abrange a persistência das informações em base de dados. Agora, vamos implementar o método “Incluir” neste fonte:

// Metodo de inclusao. Recebe um Torneio com todos os dados 
// e o array de atletas, e retorna um status numerico ( 0 = sucesso )
WSMETHOD Incluir WSRECEIVE TorneioIn WSSEND Status WSSERVICE TORNEIOS 
 
// Vamos ver tudo o que chegou como parametro
// varinfo("TorneioIn",::TorneioIn) 
 
/*
TorneioIn -> OBJECT ( 4) [...]
 TorneioIn:ATLETAS -> ARRAY ( 2) [...]
 TorneioIn:ATLETAS[1] -> OBJECT ( 5) [...]
 TorneioIn:ATLETAS[1]:ALTURA -> U ( 1) [ ]
 TorneioIn:ATLETAS[1]:CPF -> C ( 12) [123456789-09]
 TorneioIn:ATLETAS[1]:NASCIM -> D ( 8) [02/02/81]
 TorneioIn:ATLETAS[1]:NOME -> C ( 13) [Joao da Silva]
 TorneioIn:ATLETAS[1]:PESOKG -> N ( 15) [ 72.5000]
 TorneioIn:ATLETAS[2] -> OBJECT ( 5) [...]
 TorneioIn:ATLETAS[2]:ALTURA -> U ( 1) [ ]
 TorneioIn:ATLETAS[2]:CPF -> C ( 12) [111111111-11]
 TorneioIn:ATLETAS[2]:NASCIM -> D ( 8) [03/03/80]
 TorneioIn:ATLETAS[2]:NOME -> C ( 13) [Jose da Silva]
 TorneioIn:ATLETAS[2]:PESOKG -> N ( 15) [ 75.2000]
 TorneioIn:DESCRICAO -> C ( 16) [Torneio de Teste]
 TorneioIn:FINAL -> D ( 8) [06/29/15]
 TorneioIn:INICIO -> D ( 8) [06/28/15]
*/
 
// com isso conseguimos montar facilmente o codigo AdvPl para tratar os dados 
// recebidos nesta propriedade. Logo abaixo, eu mostro na tela de console do 
// TOTVS App server a descricao do torneio recebida, e o nome dos atletas recebidos
conout("Torneio : "+TorneioIn:DESCRICAO)
conout("Atletas : "+cValToChar( len(TorneioIn:ATLETAS) ))
For nI := 1 to len(TorneioIn:ATLETAS)
 conout(TorneioIn:ATLETAS[nI]:Nome)
Next
// Caso o processamento seja concluido com sucesso, 
// alimentamos a propriedade de retorno com 0
// em caso de falha, podemos usar um ou mais numeros negativos para indicar
// uma impossibilidade de processamento, como um torneio na mesma data....
::Status := 0
Return .T.

Uma vez criado o fonte e compilado no RPO, e configurado adequadamente o APPServer para ser um servidor de HTTP para WEB Services (vide documentação da TDN), podemos partir para a geração do fonte client em AdvPL.

Exemplo gerando o fonte client de Web Services

Primeiro, vamos gerar um fonte client AdvPL usando o IDE ou TDS. Usando o endereço HTTP onde foi disponibilizado o WSDL deste serviço, o código fonte client gerado deve ficar assim:

( Fonte WSCLI01.PRW )

#INCLUDE "PROTHEUS.CH"
#INCLUDE "APWEBSRV.CH"
/* ===============================================================================
WSDL Location http://localhost/ws/TORNEIOS.apw?WSDL
Gerado em 06/28/15 15:31:26
Observações Código-Fonte gerado por ADVPL WSDL Client 1.120703
 Alterações neste arquivo podem causar funcionamento incorreto
 e serão perdidas caso o código-fonte seja gerado novamente.
=============================================================================== */
User Function _SSLXTLW ; Return // "dummy" function - Internal Use
/* -------------------------------------------------------------------------------
WSDL Service WSTORNEIOS
------------------------------------------------------------------------------- */
WSCLIENT WSTORNEIOS
WSMETHOD NEW
 WSMETHOD INIT
 WSMETHOD RESET
 WSMETHOD CLONE
 WSMETHOD INCLUIR
WSDATA _URL AS String
 WSDATA _HEADOUT AS Array of String
 WSDATA _COOKIES AS Array of String
 WSDATA oWSTORNEIOIN AS TORNEIOS_TORNEIO
 WSDATA nINCLUIRRESULT AS integer
// Estruturas mantidas por compatibilidade - NÃO USAR
 WSDATA oWSTORNEIO AS TORNEIOS_TORNEIO
ENDWSCLIENT
WSMETHOD NEW WSCLIENT WSTORNEIOS
::Init()
If !FindFunction("XMLCHILDEX")
 UserException("O Código-Fonte Client atual requer os executáveis do Protheus Build [7.00.131227A-20150620] ou superior. Atualize o Protheus ou gere o Código-Fonte novamente utilizando o Build atual.")
EndIf
Return Self
WSMETHOD INIT WSCLIENT WSTORNEIOS
 ::oWSTORNEIOIN := TORNEIOS_TORNEIO():New()
// Estruturas mantidas por compatibilidade - NÃO USAR
 ::oWSTORNEIO := ::oWSTORNEIOIN
Return
WSMETHOD RESET WSCLIENT WSTORNEIOS
 ::oWSTORNEIOIN := NIL 
 ::nINCLUIRRESULT := NIL
// Estruturas mantidas por compatibilidade - NÃO USAR
 ::oWSTORNEIO := NIL
 ::Init()
Return
WSMETHOD CLONE WSCLIENT WSTORNEIOS
Local oClone := WSTORNEIOS():New()
 oClone:_URL := ::_URL 
 oClone:oWSTORNEIOIN := IIF(::oWSTORNEIOIN = NIL , NIL ,::oWSTORNEIOIN:Clone() )
 oClone:nINCLUIRRESULT := ::nINCLUIRRESULT
// Estruturas mantidas por compatibilidade - NÃO USAR
 oClone:oWSTORNEIO := oClone:oWSTORNEIOIN
Return oClone
// WSDL Method INCLUIR of Service WSTORNEIOS
WSMETHOD INCLUIR WSSEND oWSTORNEIOIN WSRECEIVE nINCLUIRRESULT WSCLIENT WSTORNEIOS
Local cSoap := "" , oXmlRet
BEGIN WSMETHOD
cSoap += 'xmlns="http://localhost/">'
cSoap += WSSoapValue("TORNEIOIN", ::oWSTORNEIOIN, oWSTORNEIOIN , "TORNEIO", .T. , .F., 0 , NIL, .F.) 
cSoap += "</INCLUIR>"
oXmlRet := SvcSoapCall( Self,cSoap,; 
 "http://localhost/INCLUIR",; 
 "DOCUMENT","http://localhost/",,"1.031217",; 
 "http://localhost/ws/TORNEIOS.apw")
::Init()
::nINCLUIRRESULT := WSAdvValue( oXmlRet,"_INCLUIRRESPONSE:_INCLUIRRESULT:TEXT","integer",NIL,NIL,NIL,NIL,NIL,NIL)
END WSMETHOD
oXmlRet := NIL
Return .T.
// WSDL Data Structure TORNEIO
WSSTRUCT TORNEIOS_TORNEIO
 WSDATA oWSATLETAS AS TORNEIOS_ARRAYOFATLETA
 WSDATA cDESCRICAO AS string
 WSDATA dFINAL AS date
 WSDATA dINICIO AS date
 WSMETHOD NEW
 WSMETHOD INIT
 WSMETHOD CLONE
 WSMETHOD SOAPSEND
 WSMETHOD SOAPRECV
ENDWSSTRUCT
WSMETHOD NEW WSCLIENT TORNEIOS_TORNEIO
 ::Init()
Return Self
WSMETHOD INIT WSCLIENT TORNEIOS_TORNEIO
Return
WSMETHOD CLONE WSCLIENT TORNEIOS_TORNEIO
 Local oClone := TORNEIOS_TORNEIO():NEW()
 oClone:oWSATLETAS := IIF(::oWSATLETAS = NIL , NIL , ::oWSATLETAS:Clone() )
 oClone:cDESCRICAO := ::cDESCRICAO
 oClone:dFINAL := ::dFINAL
 oClone:dINICIO := ::dINICIO
Return oClone
WSMETHOD SOAPSEND WSCLIENT TORNEIOS_TORNEIO
 Local cSoap := ""
 cSoap += WSSoapValue("ATLETAS", ::oWSATLETAS, ::oWSATLETAS , "ARRAYOFATLETA", .T. , .F., 0 , NIL, .F.) 
 cSoap += WSSoapValue("DESCRICAO", ::cDESCRICAO, ::cDESCRICAO , "string", .T. , .F., 0 , NIL, .F.) 
 cSoap += WSSoapValue("FINAL", ::dFINAL, ::dFINAL , "date", .T. , .F., 0 , NIL, .F.) 
 cSoap += WSSoapValue("INICIO", ::dINICIO, ::dINICIO , "date", .T. , .F., 0 , NIL, .F.) 
Return cSoap
WSMETHOD SOAPRECV WSSEND oResponse WSCLIENT TORNEIOS_TORNEIO
 Local oNode1
 ::Init()
 If oResponse = NIL ; Return ; Endif 
 oNode1 := WSAdvValue( oResponse,"_ATLETAS","ARRAYOFATLETA",NIL,"Property oWSATLETAS as s0:ARRAYOFATLETA on SOAP Response not found.",NIL,"O",NIL,NIL) 
 If oNode1 != NIL
 ::oWSATLETAS := TORNEIOS_ARRAYOFATLETA():New()
 ::oWSATLETAS:SoapRecv(oNode1)
 EndIf
 ::cDESCRICAO := WSAdvValue( oResponse,"_DESCRICAO","string",NIL,"Property cDESCRICAO as s:string on SOAP Response not found.",NIL,"S",NIL,NIL) 
 ::dFINAL := WSAdvValue( oResponse,"_FINAL","date",NIL,"Property dFINAL as s:date on SOAP Response not found.",NIL,"D",NIL,NIL) 
 ::dINICIO := WSAdvValue( oResponse,"_INICIO","date",NIL,"Property dINICIO as s:date on SOAP Response not found.",NIL,"D",NIL,NIL) 
Return
// WSDL Data Structure ARRAYOFATLETA
WSSTRUCT TORNEIOS_ARRAYOFATLETA
 WSDATA oWSATLETA AS TORNEIOS_ATLETA OPTIONAL
 WSMETHOD NEW
 WSMETHOD INIT
 WSMETHOD CLONE
 WSMETHOD SOAPSEND
 WSMETHOD SOAPRECV
ENDWSSTRUCT
WSMETHOD NEW WSCLIENT TORNEIOS_ARRAYOFATLETA
 ::Init()
Return Self
WSMETHOD INIT WSCLIENT TORNEIOS_ARRAYOFATLETA
 ::oWSATLETA := {} // Array Of TORNEIOS_ATLETA():New()
Return
WSMETHOD CLONE WSCLIENT TORNEIOS_ARRAYOFATLETA
 Local oClone := TORNEIOS_ARRAYOFATLETA():NEW()
 oClone:oWSATLETA := NIL
 If ::oWSATLETA <> NIL 
 oClone:oWSATLETA := {}
 aEval( ::oWSATLETA , { |x| aadd( oClone:oWSATLETA , x:Clone() ) } )
 Endif 
Return oClone
WSMETHOD SOAPSEND WSCLIENT TORNEIOS_ARRAYOFATLETA
 Local cSoap := ""
 aEval( ::oWSATLETA , {|x| cSoap := cSoap + WSSoapValue("ATLETA", x , x , "ATLETA", .F. , .F., 0 , NIL, .F.) } ) 
Return cSoap
WSMETHOD SOAPRECV WSSEND oResponse WSCLIENT TORNEIOS_ARRAYOFATLETA
 Local nRElem1, oNodes1, nTElem1
 ::Init()
 If oResponse = NIL ; Return ; Endif 
 oNodes1 := WSAdvValue( oResponse,"_ATLETA","ATLETA",{},NIL,.T.,"O",NIL,NIL) 
 nTElem1 := len(oNodes1)
 For nRElem1 := 1 to nTElem1 
 If !WSIsNilNode( oNodes1[nRElem1] )
 aadd(::oWSATLETA , TORNEIOS_ATLETA():New() )
 ::oWSATLETA[len(::oWSATLETA)]:SoapRecv(oNodes1[nRElem1])
 Endif
 Next
Return
// WSDL Data Structure ATLETA
WSSTRUCT TORNEIOS_ATLETA
 WSDATA nALTURA AS float OPTIONAL
 WSDATA cCPF AS string
 WSDATA dNASCIM AS date
 WSDATA cNOME AS string
 WSDATA nPESOKG AS float OPTIONAL
 WSMETHOD NEW
 WSMETHOD INIT
 WSMETHOD CLONE
 WSMETHOD SOAPSEND
 WSMETHOD SOAPRECV
ENDWSSTRUCT
WSMETHOD NEW WSCLIENT TORNEIOS_ATLETA
 ::Init()
Return Self
WSMETHOD INIT WSCLIENT TORNEIOS_ATLETA
Return
WSMETHOD CLONE WSCLIENT TORNEIOS_ATLETA
 Local oClone := TORNEIOS_ATLETA():NEW()
 oClone:nALTURA := ::nALTURA
 oClone:cCPF := ::cCPF
 oClone:dNASCIM := ::dNASCIM
 oClone:cNOME := ::cNOME
 oClone:nPESOKG := ::nPESOKG
Return oClone
WSMETHOD SOAPSEND WSCLIENT TORNEIOS_ATLETA
 Local cSoap := ""
 cSoap += WSSoapValue("ALTURA", ::nALTURA, ::nALTURA , "float", .F. , .F., 0 , NIL, .F.) 
 cSoap += WSSoapValue("CPF", ::cCPF, ::cCPF , "string", .T. , .F., 0 , NIL, .F.) 
 cSoap += WSSoapValue("NASCIM", ::dNASCIM, ::dNASCIM , "date", .T. , .F., 0 , NIL, .F.) 
 cSoap += WSSoapValue("NOME", ::cNOME, ::cNOME , "string", .T. , .F., 0 , NIL, .F.) 
 cSoap += WSSoapValue("PESOKG", ::nPESOKG, ::nPESOKG , "float", .F. , .F., 0 , NIL, .F.) 
Return cSoap
WSMETHOD SOAPRECV WSSEND oResponse WSCLIENT TORNEIOS_ATLETA
 ::Init()
 If oResponse = NIL ; Return ; Endif 
 ::nALTURA := WSAdvValue( oResponse,"_ALTURA","float",NIL,NIL,NIL,"N",NIL,NIL) 
 ::cCPF := WSAdvValue( oResponse,"_CPF","string",NIL,"Property cCPF as s:string on SOAP Response not found.",NIL,"S",NIL,NIL) 
 ::dNASCIM := WSAdvValue( oResponse,"_NASCIM","date",NIL,"Property dNASCIM as s:date on SOAP Response not found.",NIL,"D",NIL,NIL) 
 ::cNOME := WSAdvValue( oResponse,"_NOME","string",NIL,"Property cNOME as s:string on SOAP Response not found.",NIL,"S",NIL,NIL) 
 ::nPESOKG := WSAdvValue( oResponse,"_PESOKG","float",NIL,NIL,NIL,"N",NIL,NIL) 
Return

Agora, podemos montar um novo fonte ( WSTST01.PRW ), que vai usar a classe client gerada no AdvPL para interagir com este serviço. No fonte abaixo, todos os detalhes da implementação e o passo a passo utilizado para entender como usar as estruturas e métodos definidos na classe client do Web Service.

#include "protheus.ch"
/* ===========================================================================
Fonte WSTST01.PRW
Funcoes U_TST01I()
Autor Julio Wittwer
Data 10/06/2015
Descricao Fonte de testes da classe client do WebService "TORNEIOS" em AddPl
=========================================================================== */
User Function Tst01I()
Local oWSClient 
Local oAtleta
SET DATE BRITISH
SET CENTURY ON 
SET EPOCH TO 1960
 
// Cria a instância da classe Client do WebService de Torneios
oWSClient := WSTORNEIOS():New()
/*
Vamos chamar a inclusao de torneios. para isso, primeiro vemos qual foi o metodo 
de inclusao gerado na classe client Advpl
WSMETHOD INCLUIR WSSEND oWSTORNEIOIN WSRECEIVE nINCLUIRRESULT WSCLIENT WSTORNEIOS
*/
// o parametro oWSTorneioIn é uma estrutura nomeada de TORNEIOS_TORNEIO
// Como esta estrutura é um parâmetro de um método, ela já vem 
// criada, mas seus valores nao estao preenchidos 
// vamos preencher as propriedades desta estrutura
// consultamos as propriedades da estrutura no fonte Client Advpl gerado
/*
WSSTRUCT TORNEIOS_TORNEIO
 WSDATA oWSATLETAS AS TORNEIOS_ARRAYOFATLETA
 WSDATA cDESCRICAO AS string
 WSDATA dFINAL AS date
 WSDATA dINICIO AS date
(...)
*/
oWSClient:oWSTORNEIOIN:cDESCRICAO := 'Torneio de Teste'
oWSClient:oWSTORNEIOIN:dInicio := date()+1
oWSClient:oWSTORNEIOIN:dFinal := date()+2
// Dentro da estrutura de torneio, temos tambem a propriedade oWSAtletas
// Como ela nao vem criada, vamos criar uma instância dela
oWSClient:oWSTORNEIOIN:oWSATLETAS := TORNEIOS_ARRAYOFATLETA():New()
// Como a estrutura é um encapsulamento de array de objetos, 
// a propriedade oWSATLETA desta estrutura vem com {} um array vazio 
// ::oWSATLETA := {} // Array Of TORNEIOS_ATLETA():New()
// Para cada atleta a acrescentar, criamos uma nova instancia da estrutura 
// TORNEIOS_ATLETA . Devemos ver a declaração da estrutura para saber 
// quais propriedades devem ser preenchidas
 
/*
WSSTRUCT TORNEIOS_ATLETA
 WSDATA nALTURA AS float OPTIONAL
 WSDATA cCPF AS string
 WSDATA dNASCIM AS date
 WSDATA cNOME AS string
 WSDATA nPESOKG AS float OPTIONAL
(...)
*/
oAtleta := TORNEIOS_ATLETA():New()
oAtleta:cNome := "Joao da Silva"
oAtleta:cCPF := "123456789-09"
oAtleta:dNASCIM := ctod('02/02/1981')
oAtleta:nPESOKG := 72.5
// agora acrescentamos o atleta da propriedade correta
aadd( oWSClient:oWSTORNEIOIN:oWSATLETAS:oWSATLETA , oAtleta ) 
 
// Criamos um novo atleta
oAtleta := TORNEIOS_ATLETA():New()
oAtleta:cNome := "Jose da Silva"
oAtleta:cCPF := "111111111-11"
oAtleta:dNASCIM := ctod('03/03/1980')
oAtleta:nPESOKG := 75.2
// agora acrescentamos o segundo atleta da propriedade correta
aadd( oWSClient:oWSTORNEIOIN:oWSATLETAS:oWSATLETA , oAtleta )
// vamos ver como ficou a estrutura 
// varinfo("oWSClient:oWSTORNEIOIN",oWSClient:oWSTORNEIOIN)
// agora vamos chamar o metodo de inclusao
If oWSClient:Incluir() 
 
 // Chamada realizada com sucesso. 
 // Vamos ver o que chegou na propriedade de retorno
 msgInfo("Codigo de retorno = "+cValToChar(oWSClient:nINCLUIRRESULT),"Chamada realizada.")
Else
// houve algum erro na chamada
 // ou no processamento do webservice 
 MsgStop(getwscerror(3))
Endif
Return

A função de testes de inclusão ( U_TST01I ) pode ser chamada diretamente pelo SmartClient, não precisa colocar ela dentro do Menu do ERP. Os dados utilizados para os atletas estão “chumbados” no fonte. Ao ser executado, o Web Services SERVER deve receber e aceitar o XML enviado por HTTP, e mostrar no LOG de console a descrição do torneio e o nome dos dois atletas informados.

Exemplo usando tWSDLManager

Agora sim, vamos ver como é possível usar a casse nova de Web Services para informar estruturas complexas, e arrays de estruturas complexas.

A classe tWSDLManager permite mapear, a partir do WSDL, as estruturas complexas e tipos simples que precisam ser enviados para uma requisição de WebServices. Como um tipo complexo na verdade é um agrupamento de tipos simples, ao usar o método SimpleInput(), vamos obter um array contendo os identificadores de todos os dados que podem ser enviados, porem a classe considera por default que voce vai enviar apenas uma ocorrencia de um dado ou estrutura. Como nós sabemos que vamos inserir mais de um valor, precisamos dizer para a classe quantos valores serão informados, e somente com estes valores definidos podemos usar o método SimpleInput() para ver como e onde os dados serão informados. Toda a sequencia de identificação está documentada no proprio fonte, em linhas de comentário.

#include "protheus.ch"
/* ===========================================================================
Fonte WSTST02.PRW
Funcoes U_TST02I()
Autor Julio Wittwer
Data 28/06/2015
Descricao Fonte de testes do webService de Torneios, usando a nova classe
 client de websservices "tWSDLManager"
http://tdn.totvs.com/display/tec/Classe+TWsdlManager
=========================================================================== */
User Function TST02I()
Local oWSDL
Local lOk, cResp, aElem, nPos
oWSDL := tWSDLManager():New()
// Seta o modo de trabalho da classe para "verbose"
// apenas para fins de desenvolvimento e depuracao
// oWSDL:lVerbose := .T.
// Primeiro faz o parser do WSDL a partir da URL
lOk := oWsdl:ParseURL( "http://localhost/ws/TORNEIOS.apw?WSDL" )
if !lOk
 MsgStop( oWsdl:cError , "ParseURL() ERROR")
 Return
endif
// Lista as operações disponíveis
// aOps := oWsdl:ListOperations()
// varinfo( "aOps", aOps )
/*
aOps -> ARRAY ( 1) [...]
aOps[1] -> ARRAY ( 2) [...]
aOps[1][1] -> C ( 7) [INCLUIR]
aOps[1][2] -> C ( 0) []
*/
// Seta a operação a ser utilizada
lOk := oWsdl:SetOperation( "INCLUIR" )
if !lOk
 MsgStop( oWsdl:cError , "SetOperation(INCLUIR) ERROR")
 Return
endif
// Agora vamos ver os parametros de chamada da inclusao
// primeiro, devemos verificar os complex types de
// tamanho variavel.
// aParC := oWsdl:ComplexInput()
// varinfo("aParC",aParC)
/*
aParC -> ARRAY ( 1) [...]
aParC[1] -> ARRAY ( 5) [...]
aParC[1][1] -> N ( 15) [ 3.0000] // ID da estrutura complexa variavel
aParC[1][2] -> C ( 6) [ATLETA]
aParC[1][3] -> N ( 15) [ 0.0000] // numero minimo de ocorrencias
aParC[1][4] -> N ( 15) [2147483647.0000] // numero maximo de ocorrencias
aParC[1][5] -> C ( 31) [INCLUIR#1.TORNEIOIN#1.ATLETAS#1] // lista de elementos "pai" desta estrutura
*/
// Como sabemos que vamos enviar 2 atletas,
// definimos esta quantidade usando o metodo SetComplexOccurs
oWSDL:SetComplexOccurs(3,2) // Id do complex type, quantidade a ser enviada
// Apenas depois de definirmos quantos tipos complexos queremos enviar,
// podemos listar os tipos simples.
// aParS := oWsdl:SimpleInput()
// varinfo("aParS",aParS)
/*
aParS -> ARRAY ( 13) [...]
aParS[1] -> ARRAY ( 5) [...]
aParS[1][1] -> N ( 15) [ 0.0000]
aParS[1][2] -> C ( 6) [ALTURA]
aParS[1][3] -> N ( 15) [ 0.0000]
aParS[1][4] -> N ( 15) [ 1.0000]
aParS[1][5] -> C ( 40) [INCLUIR#1.TORNEIOIN#1.ATLETAS#1.ATLETA#1]
aParS[2] -> ARRAY ( 5) [...]
aParS[2][1] -> N ( 15) [ 1.0000]
aParS[2][2] -> C ( 3) [CPF]
aParS[2][3] -> N ( 15) [ 1.0000]
aParS[2][4] -> N ( 15) [ 1.0000]
aParS[2][5] -> C ( 40) [INCLUIR#1.TORNEIOIN#1.ATLETAS#1.ATLETA#1]
aParS[3] -> ARRAY ( 5) [...]
aParS[3][1] -> N ( 15) [ 2.0000]
aParS[3][2] -> C ( 6) [NASCIM]
aParS[3][3] -> N ( 15) [ 1.0000]
aParS[3][4] -> N ( 15) [ 1.0000]
aParS[3][5] -> C ( 40) [INCLUIR#1.TORNEIOIN#1.ATLETAS#1.ATLETA#1]
aParS[4] -> ARRAY ( 5) [...]
aParS[4][1] -> N ( 15) [ 3.0000]
aParS[4][2] -> C ( 4) [NOME]
aParS[4][3] -> N ( 15) [ 1.0000]
aParS[4][4] -> N ( 15) [ 1.0000]
aParS[4][5] -> C ( 40) [INCLUIR#1.TORNEIOIN#1.ATLETAS#1.ATLETA#1]
aParS[5] -> ARRAY ( 5) [...]
aParS[5][1] -> N ( 15) [ 4.0000]
aParS[5][2] -> C ( 6) [PESOKG]
aParS[5][3] -> N ( 15) [ 0.0000]
aParS[5][4] -> N ( 15) [ 1.0000]
aParS[5][5] -> C ( 40) [INCLUIR#1.TORNEIOIN#1.ATLETAS#1.ATLETA#1]
aParS[6] -> ARRAY ( 5) [...]
aParS[6][1] -> N ( 15) [ 5.0000]
aParS[6][2] -> C ( 6) [ALTURA]
aParS[6][3] -> N ( 15) [ 0.0000]
aParS[6][4] -> N ( 15) [ 1.0000]
aParS[6][5] -> C ( 40) [INCLUIR#1.TORNEIOIN#1.ATLETAS#1.ATLETA#2]
aParS[7] -> ARRAY ( 5) [...]
aParS[7][1] -> N ( 15) [ 6.0000]
aParS[7][2] -> C ( 3) [CPF]
aParS[7][3] -> N ( 15) [ 1.0000]
aParS[7][4] -> N ( 15) [ 1.0000]
aParS[7][5] -> C ( 40) [INCLUIR#1.TORNEIOIN#1.ATLETAS#1.ATLETA#2]
aParS[8] -> ARRAY ( 5) [...]
aParS[8][1] -> N ( 15) [ 7.0000]
aParS[8][2] -> C ( 6) [NASCIM]
aParS[8][3] -> N ( 15) [ 1.0000]
aParS[8][4] -> N ( 15) [ 1.0000]
aParS[8][5] -> C ( 40) [INCLUIR#1.TORNEIOIN#1.ATLETAS#1.ATLETA#2]
aParS[9] -> ARRAY ( 5) [...]
aParS[9][1] -> N ( 15) [ 8.0000]
aParS[9][2] -> C ( 4) [NOME]
aParS[9][3] -> N ( 15) [ 1.0000]
aParS[9][4] -> N ( 15) [ 1.0000]
aParS[9][5] -> C ( 40) [INCLUIR#1.TORNEIOIN#1.ATLETAS#1.ATLETA#2]
aParS[10] -> ARRAY ( 5) [...]
aParS[10][1] -> N ( 15) [ 9.0000]
aParS[10][2] -> C ( 6) [PESOKG]
aParS[10][3] -> N ( 15) [ 0.0000]
aParS[10][4] -> N ( 15) [ 1.0000]
aParS[10][5] -> C ( 40) [INCLUIR#1.TORNEIOIN#1.ATLETAS#1.ATLETA#2]
aParS[11] -> ARRAY ( 5) [...]
aParS[11][1] -> N ( 15) [ 10.0000]
aParS[11][2] -> C ( 9) [DESCRICAO]
aParS[11][3] -> N ( 15) [ 1.0000]
aParS[11][4] -> N ( 15) [ 1.0000]
aParS[11][5] -> C ( 21) [INCLUIR#1.TORNEIOIN#1]
aParS[12] -> ARRAY ( 5) [...]
aParS[12][1] -> N ( 15) [ 11.0000]
aParS[12][2] -> C ( 5) [FINAL]
aParS[12][3] -> N ( 15) [ 1.0000]
aParS[12][4] -> N ( 15) [ 1.0000]
aParS[12][5] -> C ( 21) [INCLUIR#1.TORNEIOIN#1]
aParS[13] -> ARRAY ( 5) [...]
aParS[13][1] -> N ( 15) [ 12.0000]
aParS[13][2] -> C ( 6) [INICIO]
aParS[13][3] -> N ( 15) [ 1.0000]
aParS[13][4] -> N ( 15) [ 1.0000]
aParS[13][5] -> C ( 21) [INCLUIR#1.TORNEIOIN#1]
*/
// Analisando o array acima, vemos que os parametros de primeiro nivel
// sao INICIO, FINAL e DESCRICAO. Logo, podemos alimentar estes valores
// diretamente, inclusive pelo nome. Porem precisamos informar tambem o array contendo 
// a sequencia de elementos "pai" de cada valor. Na pratica, pasta pegar a 
// lista de elementos pai identificada no 5o elemento do array de simpleInput
// e criar um array com ele.
lOk := oWsdl:SetValPar("DESCRICAO",{"INCLUIR#1","TORNEIOIN#1"}, "Torneio de Testes")
if !lOk
 MsgStop( oWsdl:cError , procline())
 Return
endif
lOk := oWsdl:SetValPar("INICIO",{"INCLUIR#1","TORNEIOIN#1"}, '20150701')
if !lOk
 MsgStop( oWsdl:cError , procline())
 Return
endif
lOk := oWsdl:SetValPar("FINAL",{"INCLUIR#1","TORNEIOIN#1"}, '20150702')
if !lOk
 MsgStop( oWsdl:cError , procline())
 Return
endif
// Podemos ver tambem que o array de tipos simples foi criado para 2 atletas
// e agora temos IDs para cada um deles. Isto somente aconteceu pois 
// usamos o metodo SetComplexOccurs(). Caso nao tivessemos utilizado 
// este metodo, o array de estruturas simples viria apenas com os 
// identificadores para inserir um altleta.
// Para definir os tipos complexos, uma vez que seus valores
// já estão enumerados na lista de tipos simples, podemos fazer assim :
aParent := {"INCLUIR#1","TORNEIOIN#1","ATLETAS#1","ATLETA#1"}
oWsdl:SetValPar("NOME",aParent,"Romualdo da Silva")
oWsdl:SetValPar("CPF",aParent,"123456789-01")
oWsdl:SetValPar("NASCIM",aParent,"1974-05-08")
oWsdl:SetValPar("PESOKG",aParent,"77,5")
oWsdl:SetValPar("ALTURA",aParent,"1,85")
// Como os atletas são inseridos em sequencia, basta informarmos
// a que alteta a informação se destina, variando o ultimo
// elemento do array dos "pais" de cada informação.
aParent := {"INCLUIR#1","TORNEIOIN#1","ATLETAS#1","ATLETA#2"}
oWsdl:SetValPar("NOME",aParent,"Sinfronio da Silva")
oWsdl:SetValPar("CPF",aParent,"555555555-55")
oWsdl:SetValPar("NASCIM",aParent,"1976-03-12")
oWsdl:SetValPar("PESOKG",aParent,"66,5")
oWsdl:SetValPar("ALTURA",aParent,"1,65")
// Agora executamos a requisição ao WebService
lOk := oWsdl:SendSoapMsg()
if !lOk
 MsgStop( oWsdl:cError , "SendSoapMsg() ERROR")
 Return
endif
// mostra no console o XML Soap devolvido
conout( "--- SOAP RESPONSE ---" , oWsdl:GetSoapResponse() , "-------------------")
// Recupera os elementos de retorno, já parseados
cResp := oWsdl:GetParsedResponse()
/*
Como o retorno é apenas um numero, podemos obtelo diretamente 
parseando a string retornada em cResp
*/
varinfo("cResp",cResp)
Return

Conclusão

A classe tWSDLManager tem uma sequência de operações que precisa ser realizada antes de começar a alimentar as propriedades de envio de dados. Caso existam mais informações que possuem quantidades variáveis, é necessário definir a quantidade de cada uma delas antes de começar a popular os valores para realizar a requisição / chamada do WebService.

Para o próximo post sobre Web Services, eu vou pegar este exemplo didático, e fazer um método de consulta, onde o retorno do Web SErvices server vai ser as informações de um torneio. Esta etapa de tratamento de retorno de tipos complexos é muito simples usando a geração do fonte client em AdvPL, mas é um pouco mais complicada quando usamos a classe tWSDLManager(), e realmente tudo isso de uma vez dentro de apenas uma postagem, ficaria muito grande !

Até a próxima pessoal, e bons Web Services 😀