Boas Práticas de Programação – Código Simples, Resultados Rápidos

Introdução

Este tópico está entre “Dicas Valiosas” e “Boas Práticas de Programação”, de qualquer modo aborda um exemplo de código, ainda em desenvolvimento por um colega que está iniciando no “Mundo do AdvPL”. Partindo deste fonte de exemplo, vamos analisar o que o fonte faz, como faz, e inclusive avaliar algumas opções de escrever um algoritmo que faça a mesma coisa, usando funções diferentes ou escritos de uma outra forma, e se existe algum ganho ou perda, direto ou indireto ao optarmos por uma ou outra forma de resolução.

O Fonte em AdvPL – Primeira versão

#INCLUDE "PROTHEUS.CH"
#INCLUDE "TOTVS.CH"
#INCLUDE "FILEIO.CH"

USER FUNCTION TESTE()
  
        local nArquivo
        local i
        local nNumero
        local nNum := 7 

        msgAlert("Início.")

        nArquivo := fcreate("C:\devstudio\Melhorias\src\arquivo.txt")

        if ferror() != 0
                msgalert ("ERRO GRAVANDO ARQUIVO, ERRO: " + str(ferror()))
                return
        endif 
        for i:=1 to 500
                nNumero = randomize(100000,999999)
                if (mod(nNumero,nNum)) == 0 //dividendo e divisor respectivamente
                        fWrite(nArquivo, "O numero < " + alltrim(str(nNumero)) + " > é divisível por " + alltrim(str(nNum)) + chr(13) + chr(10))
                else
                        fwrite(nArquivo, "O numero <" + alltrim(str(nNumero)) + "> não é divisível " + alltrim(str(nNum)) + chr(13) + chr(10))
                Endif
        next    
        fclose(nArquivo)

        msgAlert("Fim.")
Return

Engenharia Reversa

Olhando o fonte linha por linha, podemos deduzir o que ele faz ao ser executado. Inicialmente, o fonte declara as variáveis utilizadas com escopo “Local”, mostra uma mensagem na tela do SmartClient informando que o programa está no “Início”, após pressionar OK ou o simplesmente fechar a janela a aplicação continua, criando um arquivo em um path específico na máquina onde está sendo executado o SmartClient –que pode ser a mesma máquina onde o SmartClient pode estar sendo executado, ou uma outra máquina conectando neste Protheus Server via REDE TCP/IP.  — Arquivo “C:\devstudio\Melhorias\src\arquivo.txt””.

A aplicação usa fCreate() para criar o arquivo, verifica se houve falha na criação verificando o retorno da função fError(), faz um loop de 500 iterações,  sorteia um número entre 100000 e 999999, e escreve no arquivo o número sorteado usando fWrite(), e antes de escrever determina se o número sorteado é múltiplo de 7 ou não, usando a função Mod().

Primeira Revisão

Logo nas primeiras linhas do arquivo, foram usados dois includes: “protheus.ch” e “totvs.ch”. Internamente, ambos são o mesmo arquivo. Na verdade, o include totvs.ch inclui internamente o arquivo protheus.ch. Foi criado um include com o nome de “totvs.ch” apenas para padronização de código. Logo, tanto faz qual deles for usado, precisamos somente de um deles.

O include fileio.ch possui algumas constantes que opcionalmente podem ser usadas pelas funções de baixo nível de arquivo, como a fCreate(), fOpen() e fSeek(). No caso do fonte acima, como nenhuma constante foi usada, fazer referência a este arquivo também é desnecessário.

Quanto a verificação de erro de criação de arquivo, normalmente verificamos se o resultado da função fCreate() é diferente de -1 (menos um), pois este é o valor retornado em caso de falha da função. Porém, não há nada de mais em usar a função fError() — desde que logo após a chamada da fCreate() — pois em caso de sucesso, fError() retorna 0 (zero).

Dento do laço for…next de 500 iterações, cada volta sorteia um número e verifica se ele é ou não múltiplo de 7. Quando queremos uma conversão de um valor numérico para string, sem espaços adicionais, podemos usar tranquilamente a expressão alltrim(str(nNumero)). De qualquer modo, no AdvPL temos uma função básica da linguagem que realiza exatamente este tipo de conversão, inclusive para outros tipos de dados de entrada, resultando em uma string — chama-se cValToChar(). A utilização dela neste cenário apenas economiza a chamada de funções — ao invés de duas, realizamos a conversão com apenas uma.

Na declaração de variáveis, foi usada corretamente a notação húngara — a primeira letra do nome da variável indica o seu tipo. Isto é “praxe” em AdvPL, ajuda bastante. E, outra coisa que ajuda é colocar nomes que tenham relação com o conteúdo. Olhando o fonte, sabemos que nNumero foi gerado por sorteio, e nNum é o número para verificar se o primeiro é múltiplo dele. Porém, ficaria mais “elegante” nomear nNum com, por exemplo “nDivTst” — divisor de teste.

Outros modos de fazer a mesma coisa

Existem duas formas de verificar se um número tem resto inteiro após uma divisão por outro. Podemos usar a função “mod()” ou o operador “%“, o resultado é o mesmo, ambos estão certos.

if ( mod(nNumero, nNum )  ==  0)
if ( ( nNumero % nNum ) == 0 )

 

Porém, existe também uma forma de redução de código, que eu particularmente acho feia, pois dificulta a legibilidade do código, e não há ganho NENHUM em desempenho, por exemplo:

if (mod(nNumero,nNum)) == 0 //dividendo e divisor respectivamente
   fWrite(nArquivo, "O numero < " + alltrim(str(nNumero)) + " > é divisível por " + alltrim(str(nNum)) + chr(13) + chr(10))
else
   fwrite(nArquivo, "O numero <" + alltrim(str(nNumero)) + "> não é divisível " + alltrim(str(nNum)) + chr(13) + chr(10))
Endif

O código acima poderia ser escrito de outra forma, com a mesma funcionalidade, porém com uma sintaxe totalmente diferente.

fWrite(nArquivo, ;
    "O numero <" + cValToChar(nNumero) + ">"+;
    IIF( mod(nNumero,nNum) == 0 , " é "," não é ") + ;
    "divisível por " + cValToChar(nNum) +chr(13)+chr(10) )

EXCEPCIONALMENTE NESSE EXEMPLO usando o recurso de quebrar linhas de código com ponto e vírgula no final, e tratando uma condição SIMPLES, com duas situações de retorno PEQUENO, escrever dessa forma não ficou tão “feio”. Usamos a função IIF() — ou “if em linha” — cujo comportamento é avaliar e retornar o segundo parâmetro informado caso a condição informada no primeiro argumento seja verdadeira, ou processar e retornar o terceiro parâmetro caso a condição informada seja falsa.

De qualquer modo, eu recomendo fortemente que esse tipo de redução seja usada com muita cautela, escrever um código todo rebuscado cheio de operadores e expressões “MegaZórdicas” não quer dizer que você é um bom programador. Escrever o IF — ELSE — ENDIF tradicional e colocar exatamente o que você quer fazer, mesmo que em alguns casos possa repetir um pouco de código, é preferível para dar LEGIBILIDADE ao código.

“Codifique sempre como se o cara que for dar manutenção seja um psicopata violento que sabe onde você mora.” – Martin Golding

“Qualquer um pode escrever um código que o computador entenda. Bons programadores escrevem códigos que os humanos entendam.” – Martin Fowler

 

Desempenho

Para realizar um teste de desempenho, eu removi as chamadas de MsgAlert(), e inseri uma contagem de tempo, declarando uma variável nTempo como “Local”, atribuindo nesta variável imediatamente antes da instrução “For” o retorno da função seconds(), e depois na instrução “Next”, eu mostro na tela uma MsgAlert() com o tempo que a função demorou para executar o loop de geração de números e de gravação em disco, com precisão de 3 casas decimais.  O fonte após a revisão ficou desta forma:

#INCLUDE "PROTHEUS.CH"

USER Function TESTE()
Local nArquivo , nNumero
Local nDiv := 7 
Local i, nTempo

nArquivo := fcreate("c:\Temp\arquivo.txt")
If ferror() != 0
   MsgAlert("ERRO GRAVANDO ARQUIVO, ERRO: " + cValToChar(ferror()))
   return
EndIf
nTempo := seconds()
For i:=1 to 5000
   nNumero = randomize(100000,999999)
   If (mod(nNumero,nDiv)) == 0
      fWrite(nArquivo, "O numero < " + cValToChar(nNumero) + " > é divisível por " + cValToChar(nDiv) + chr(13) + chr(10))
   Else
      fwrite(nArquivo, "O numero <" + cValToChar(nNumero) + "> não é divisível " + cValToChar(nDiv) + chr(13) + chr(10))
   EndIf
Next
MsgAlert("Tempo Total = "+str(seconds()-nTempo,12,3)+' s.')
fclose(nArquivo)
Return

Para uma métrica de tempo mais apurada, 500 iterações era muito pouco. Aumentei para 5000 iterações, e no meu equipamento a execução deste código demora entre 500 e 600 milissegundos (0.5 a 0.6 segundos).

Pontos de Atenção

Após olhar o arquivo com as informações geradas, reparei em um comportamento interessante. Os números gerados randomicamente começavam em 100000 , mas nunca eram maiores que 132000. Após consultar a documentação da função Randomize() na TDN, reparei que ela têm uma observação sobre seu funcionamento.

A função Randomize(), trabalha com um intervalo interno de 32767 números, a partir do número inicial informado, inclusive se o número inicial for negativo.

Logo, embora eu possa especificar um número inicial e final, se a diferença entre ambos for maior que 32767, ela considera o limite final igual ao limite inicial + 32767 menos uma unidade, e não o limite informado. Neste caso, precisamos usar um outro algoritmo para chegar a um número tão grande —  veremos como contornar isto mais para frente, em um próximo post.

Pontos de Melhoria

Sempre têm alguma coisinha que podemos fazer para melhorar o código, direta ou indiretamente. No caso do programa de exemplo acima, por uma mera questão circunstancial o arquivo a ser criado e que receberá os dados a serem gravados foi passado para a função contendo o que chamados de “path completo”, desde a unidade de disco, diretório e nome do arquivo com extensão. A maioria das funções de baixo nível de arquivo do AdvPL entende que, se um arquivo possui a letra da unidade de disco informada, este arquivo deve ser criado e manipulado pelo SmartClient.

Isto significa que, quando o Servidor roda a instrução fCreate(), ele envia uma mensagem ao SmartClient para que ele crie o arquivo, não importa se o SmartClient e o Protheus Server estão rodando na mesma máquina. E, cada instrução fWrite() executada faz o Protheus Server enviar uma linha com as informações para o SmartClient acrescentar no arquivo.

Os tempos de execução deste programa no meu ambiente, inserindo 5 mil linhas, estava em torno de 0.5 a 0.6 segundos. Vamos criar dentro da pasta do ambiente atual em uso (RootPath especificado na configuração de ambiente do appserver.ini) uma pasta chamada “Temp”, e no fonte AdvPL, vamos passar a criar este arquivo a partir do Servidor, mais precisamente dentro da pasta “Temp”.

nArquivo := fcreate("c:\Temp\arquivo.txt")

Deve ser trocado para

nArquivo := fcreate("\Temp\arquivo.txt")

Agora, executamos o programa novamente, e … surpresa, o tempo de execução CAIU  para 0,170 a 0,200 segundos. Isso é quase três vezes mais rápido, e olhe que no meu ambiente o SmartClient e o Application Server estão no mesmo equipamento. Logo, este tempo a mais — que chamamos de “overhead” — envolve a aplicação montar a mensagem de gravação para o SmartClient, enviar pela rede, o SmartClient receber a mensagem, decodificar a mensagem, processar a mensagem e informar que a operação foi executada com sucesso. Esta diferença de desempenho é mais acentuada ainda quando o SmartClient e o Application Server estão realmente sendo executados em duas máquinas diferentes, com uma rede TCP entre elas.

É possível melhorar esse tempo no SmartClient ?

Sim, é possível sim, melhorar significativamente. Repare que cada iteração no fonte gera uma linha de aproximadamente 41 bytes quando o número não é divisível por 7, e 37 bytes quando é divisível. Um pacote único de rede TCP normalmente suporta até 1500 bytes. Logo, se ao invés de escrever 36 linhas de 41 bytes, uma para cada fWrite(), a gente acumulasse na memória essas 36 linhas em uma variável caractere, gerando uma string de aproximadamente 1476 bytes, e enviasse essa string na função fWrite(), podemos reduzir bem o tempo de transmissão de dados na rede, pois é mais rápido transmitir um pacote de 1476 bytes do que transmitir 36 pacotes de 41 bytes. Neste caso, o fonte ficaria assim:

USER Function TESTE()
Local nArquivo , nNumero
Local nNum := 7 
Local i, nTempo
Local nX
Local cTemp := ''

nArquivo := fcreate("c:\Temp\arquivo.txt")
If ferror() != 0
   msgalert ("ERRO GRAVANDO ARQUIVO, ERRO: " + str(ferror()))
   return
EndIf
nTempo := seconds()
For i:=1 to 5000
   nNumero = Randomize(100000,999999)
   If ( nNumero % nNum ) == 0
      cTemp += "O numero <" + cValToChar(nNumero) + "> é divisível por " + cValToChar(nNum) + chr(13) + chr(10)
   Else
      cTemp += "O numero <" + cValToChar(nNumero) + "> não é divisível por " + cValToChar(nNum) + chr(13) + chr(10)
   EndIf
   IF i % 36 == 0 
      fWrite(nArquivo,cTemp)
      cTemp := ''
   Endif
Next 
if !empty(cTemp)
   fWrite(nArquivo,cTemp)
Endif
conout("Tempo Total = "+str(seconds()-nTempo,12,3)+' s.')
fclose(nArquivo)
return

Conclusão

Para meu espanto, na máquina local (APPServer e SmartClient no mesmo equipamento), os tempos ficaram praticamente iguais, gravando o arquivo no path “c:\Temp” através do SmartClient, ou gravando dentro da pasta “\temp\” a partir do RootPath do ambiente no APPServer.

Espero que este post agregue conhecimento para quem está começando no AdvPL, e para quem já têm alguma experiência com a linguagem e com o ambiente. Afinal, conhecimento nunca é demais. Desejo a todos TERABYTES DE SUCESSO. 

Agradecimentos

Agradeço o colaborador Hussyvel Ribeiro, que me concedeu um fonte de testes para usar neste post. Hussyvel, seja bem vindo ao AdvPL !!! 😀 

Referências

 

 

Algoritmos – Parte 02 – Permutações

Introdução

No post anterior (Algoritmos – Parte 01 – Loterias), vimos a criação de um algoritmo para realizar combinações simples, que pode ser usado na maioria das loterias numéricas. Agora, vamos ver um algoritmo de permutação — Algoritmo de Heap — e ver como fazer a portabilidade de um pseudo-código para AdvPL.

Algoritmo de Heap

O Algoritmo de Heap é até hoje a forma mais optimizada de gerar todas as possibilidades de permutações em um conjunto de elementos. A permutação é um processo pelo qual podemos criar sequências não repedidas dos elementos de um conjunto, alterando a sua ordem. Por exemplo, partindo de um conjunto de três números (1, 2 e 3), podemos criar as seguintes permutações:

1 2 3 
1 3 2 
2 1 3
2 3 1 
3 1 2
3 2 1

Calcula-se o número total de possibilidades de permutação de um conjunto com a fórmula P(m) = m! –> Onde P é o número de possibilidades de permutação e m é o número de elementos do conjunto, e  “!” é o símbolo da operação fatorial. Por exemplo, em um conjunto de 3 elementos, temos 3! ( 3! = 3*2 = 6) conjuntos ordenados resultantes.

Pseudocódigo

A partir da Wikipedia, por exemplo, podemos obter o pseudocódigo do algoritmo — uma representação em linguagem quase natural da sequência de operações nos conjuntos de dados para se chegar ao resultado. Esta versão do pseudo-código é a não-recursiva.

procedure generate(n : integer, A : array of any):
    c : array of int

    for i := 0; i < n; i += 1 do
        c[i] := 0
    end for

    output(A)

    i := 0;
    while i < n do
        if  c[i] < i then
            if i is even then
                swap(A[0], A[i])
            else
                swap(A[c[i]], A[i])
            end if
            output(A)
            c[i] += 1
            i := 0
        else
            c[i] := 0
            i += 1
        end if
    end while

Agora, vamos converter isso para AdvPL, primeiro de uma forma bem simples, depois de uma forma mais elaborada. Inicialmente, vamos fazer uma tradução “crua” para o AdvPL, porém funcional.

STATIC Function Generate( n , A )
Local c := {} , i
For i := 1 to n
  aadd(c,0)
Next
output(A)
i := 0 
While i < n
  If  c[i+1] < i
    if ( i % 2 ) == 0 
      swap(A, 1 , i+1)
    else
      swap(A, c[i+1]+1, i+1)
    end if
    output(A)
    c[i+1]++
    i := 0
  Else
    c[i+1] := 0
    i++
  EndIf
Enddo


STATIC Function swap(aData,nPos1,nPos2)
Local nTemp := aData[nPos1]
aData[nPos1] := aData[nPos2] 
aData[nPos2] := nTemp
Return

STATIC Function output(A)
Local i, R := ''
For i := 1 to len(A)
  If !empty(R)
    R += ', '
  Endif
  R += cValToChaR(A[i])
Next
conout(R)
Return

Diferenças na Implementação

A primeira diferença nós vemos logo de início ao usar os Arrays em AdvPL. O pseudo-código parte da premissa que um Array de N posições é endereçado de 0 a N-1 — Isto é, o primeiro elemento do Array é o elemento 0 (zero.) Já em AdvPL, o primeiro elemento do array é 1 (um). Logo, nós mantemos toda a lógica do programa inicial, inclusive as variáveis como se o array fosse base 0 (zero), porém na hora de endereçar os elementos do array, somamos uma unidade. Logo:

if c[i] < i

foi transformado para

if c[i+1] < i

A função swap() tem como objetivo trocar os elementos do array, um pelo outro. Como em AdvPL os arrays são passados por referência, podemos implementar a função de troca guardando o valor do elemento informado em uma variável local, depois atribuímos o conteúdo do segundo elemento informado sobre o primeiro, e então atribuímos o conteúdo salvo do primeiro elemento no segundo — vide função swap(). O diferencial dela em relação ao pseudocódigo é que eu passo para ela em AdvPL três parâmetros: O Array, e as duas posições a serem trocadas.

No pseudo-código, para verificar se um determinado numero é par (even em inglês), pode ser em AdvPL verificando  se o resto da divisão por dois é zero. Para isso, poderíamos usar a função mod(), ou de forma mais prática, o operador “%”.

if ( i % 2 ) == 0

Outro ponto de atenção é justamente a chamada da função swap() quando o número não for par. Veja no pseudocódigo:

swap(A[c[i]], A[i])

Agora, em AdvPL, a implementação ficou assim:

swap(A, c[i+1]+1, i+1)

Reparem que o array c[] guarda uma posição de um array. Como estamos trabalhando com array em base 1, eu devo somar 1 para recuperar o elemento do array c, e como o seu resultado será usado para indicar uma posição do array A[], eu também preciso somar 1.

Já a função output(), cujo entendimento óbvio é mostrar um dos conjuntos obtidos na permutação, implementamos simplesmente recebendo o Array , e criando uma string com o conteúdo de seus elementos separados por vírgula. Para testar o fonte acima, vamos usar a seguinte função:

User Function Permuta()
Generate( 4 , {'A' ,'B' ,'C' ,'D' } )
Return

Após salvarem, compilarem e executarem o programa acima, o resultado no log de console do Protheus Server deve ser:

A, B, C, D
B, A, C, D
C, A, B, D
A, C, B, D
B, C, A, D
C, B, A, D
D, B, A, C
B, D, A, C
A, D, B, C
D, A, B, C
B, A, D, C
A, B, D, C
A, C, D, B
C, A, D, B
D, A, C, B
A, D, C, B
C, D, A, B
D, C, A, B
D, C, B, A
C, D, B, A
B, D, C, A
D, B, C, A
C, B, D, A
B, C, D, A

Conclusão

Vendo o fonte assim, prontinho, parece fácil. Porém, eu comecei resolvendo trocar o nome das variáveis da implementação em AdvPL ao transcrever o pseudocódigo, e o programa não gerava os números corretamente. Joguei fora a primeira versão e parti do código original, mantendo o nome das variáveis, então funcionou.

Novamente agradeço a todos pela audiência e 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

 

Protheus e FTP Client – Parte 02

Introdução

No post anterior (Protheus e FTP Client), vimos um exemplo básico de identificação da existência de um arquivo, e como fazer para baixar o arquivo do FTP em uma pasta local a partir do RootPath do ambiente Protheus. Agora, vamos ver com mais detalhes algumas propriedades interessantes da classe TFTPClient.

Propriedades da classe TFTPClient

Todas as propriedades e métodos da classe estão documentadas na TDN, vide link nas referências, no final do post, porém vamos ver algumas delas uma riqueza maior de detalhes, para entender onde é preciso utilizá-las.

bFireWallMode

Esta propriedade indica se a conexão com o FTP será Ativa ou Passiva. Para esta propriedade ter efeito, ela deve ser setada antes de estabelecermos a conexão com o FTP Server.

Em poucas palavras, o FTP usa duas conexões entre o Cliente e o Servidor FTP, uma conexão de dados e outra de controle. Quando usado o modo Ativo (bFireWallMode = .F.  — DEFAULT) , o FTP Server estabelece a conexão de dados em uma porta aberta e indicada pelo Cliente, que abre primeiro a conexão de controle na porta 21 do FTP Server. Pela perspectiva do Firewall do Cliente FTP, uma sistema externo está tentando conectar-se com um cliente interno, o que normalmente é restrito.

Quando habilitamos a propriedade bFireWallMode para .T., indicamos ao Cliente de FTP que ele deve estabelecer a conexão em “Modo Passivo”. Uma vez que o FTP Server seja capaz de trabalhar com a conexão em modo passivo, o Cliente de FTP abre as duas conexões — controle e dados — no FTP Server, na seguinte sequência: Após abrir a conexão de controle no FTP Server, o cliente informa ao FTP Server que a conexão deve ser passiva, então o FTP Server retorna um número de uma segunda porta — acima de 1024 — para o Cliente abrir a conexão de dados, sem precisar abrir um range de portas no Cliente FTP.

— Observação – O Protheus como FTP Server não suporta o modo passivo.  —

bUsesIPConnection

Esta configuração pode ser necessária quando o servidor onde o Protheus Server está sendo executado possua mais de uma interface de rede. Quando o FTP Client não está em modo passivo, e deve receber a conexão de dados de “volta”do FTP Server, normalmente o FTP Client busca o IP da máquina atual para enviar ao FTP Server, porém quando a máquina têm mais de uma interface de rede, não é garantido que o IP retornado seja por exemplo o IP “Externo”, que aceite a conexão. Quando habilitamos a propriedade bUsesIPConnection para .T., o FTP Client pega o IP da Interface de rede que estabeleceu a conexão de controle com o FTP, para informar ao FTP Server onde ele deve fazer a conexão de dados.

cErrorString

Esta é uma propriedade de consulta. Normalmente os métodos da classe cliente de FTP retornam “0” (zero) em caso de sucesso, e em caso de falha um código de erro. A lista de código de erros está documentada neste link da TDN, porém quando um método retorna erro, a propriedade cErrorString é alimentada com a descrição do erro retornado. Isto facilita a montagem de uma mensagem ou LOG de erro com mais detalhes.

nConnectTimeout

Por default, o time-out de tentativa de conexão com o FTP Server é de 5 segundos. Para alterar este tempo (em segundos) antes de estabelecer a conexão, defina o valor desejado nesta propriedade. Alguns servidores — dependendo da velocidade e latência de rede — podem precisar de um tempo um pouco maior.

nControlPort

Caso já exista uma conexão estabelecida com o FTP Server, esta propriedade informa a porta que foi usada para a conexão de controle (DEFAULT=21). Se esta propriedade for setada antes da conexão estabelecida, ela define a porta default de conexão com o FTP Server. O método FTPConnect(), usado para estabelecer a conexão, permite opcionalmente receber a porta de conexão no segundo parâmetro. Caso este não seja informado, será usada a porta definida na propriedade nControlPort.

nDataPort

Caso já exista uma conexão estabelecida com o FTP Server, esta propriedade informa qual é a porta TCP do FTP Client usada para estabelecer a conexão de dados. Quando não usamos o modo passivo, o FTP Client usa uma porta randomicamente sorteada entre 10 e 30 mil.

nDirInfo

Esta propriedade, quando consultada, realiza uma busca da lista de arquivos da pasta atual setada na conexão com o FTP Server. retornando em caso de sucesso o valor 0 (zero), caso contrário retorna o código do erro ocorrido. Normalmente realizamos a busca dos arquivos disponíveis na pasta atual usando o método Directory(), que internamente também realiza a busca de arquivos da pasta atual do FTP Server, permitindo inclusive um retorno filtrado por um arquivo específico ou o uso de máscaras (* e ?).

nDirInfoCount

Após uma consulta à propriedade nDirInfo,  a propriedade nDirInfoCount informa quantos arquivos foram encontrados na pasta atual do FTP Server.

nTransferMode

Esta propriedade indica e permite alterar o modo interno de transferência de dados entre o FTP Client e o FTP Server. Este valor deve ser setado após estabelecida a conexão com o FTP Server. Existem três modos de transferência: 0=Stream, 1=Block e 2=Compressed. O modo Stream é o DEFAULT. A RFC 959 explica em detalhes cada um dos modos, porém vejamos uma síntese de cada um.

Stream significa que os dados do arquivo são transmitidos em um modo contínuo, usando algumas sequencias de escape internas de controle, é o modo mais comum de transmissão; Block indica o uso de uma sequência de blocos de dados formatados em cabeçalho e conteúdo; e Compressed indica o uso de um algoritmo simples de controle para transmissão de bytes repetidos — economizando no tráfego de rede quando existem sequências do mesmo byte repetidas no arquivo a ser transmitido — veja mais detalhes sobre Run-length Encoding.

nTransferStruct

Permite alterar o modo como os dados são tratados na transferência. Os modos disponíveis são: 0=File (DEFAULT), 1=Record e 2=Page. A implementação de arquivo (File) é normalmente a mais utilizada, pois não interfere em seu conteúdo. Já as estruturas de transferência orientadas a registro (Record) e página (Page) podem ter interferências e sofrerem ajustes em uma das pontas da conexão, dependendo da plataforma em uso. Recomenda-se o uso da opção default (0=File), salvo em necessidades de integrações específicas.

nTransferType

Permite definir o tipo de transferência de dados usada na conexão. Por padrão, a transferência é do tipo 1=Image. Isto significa que os dados do arquivo são transmotidos em modo binário, isto é, a sqeuência de Bytes que compõe o arquivo, independente de seu conteúdo, é transmitida e recebida sem alteração.

Quando usado o tipo 0=ASCII, feito exclusivamente para a transmissão de arquivos texto (Texto Simples, sem UTF-8 ou caracteres especiais), podem haver alterações do conteúdo do arquivo entre plataformas, inclusive em casos onde isto seja desejável. Por exemplo, um arquivo texto puro no Windows usa dois bytes (CRLF) para indicar final de linha. Ao ser transmitido por FTP para uma estação Linux, usando o modo 0=ascii, as quebras de linha serão salvas no linux apenas com LF. Porém, se você setar o modo ascii e acidentalmente transmitir um arquivo de imagem ou outro arquivo de conteúdo binário, fatalmente ele vai ser “corrompido” no processo de gravação de quem estiver recebendo o arquivo.

Conclusão

Por hora, este post fica apenas como referência destas propriedades. No próximo sobre este assunto, vamos montar algo um pouco “maior” com a classe client de FTP.

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

Referências

Protheus e FTP Client

Introdução

No post Protheus como Servidor de FTP, vimos como configurar um Servidor Protheus como FTP Server. Agora, vamos ver uma classe AdvPL que permite estabelecer uma conexão com um servidor FTP, e fazer operações como Download e Upload de arquivos — a classe tFtpClient.

Protocolos FTP, FTPS e SFTP

FTP, acrônimo de File Transfer Protocol, é um protocolo criado com a finalidade de transferência de arquivos entre estações. Para isso, uma estação atua como Cliente, estabelecendo uma conexão TCP/IP com a estação servidora. A porta padrão para os servidores de FTP é a porta 21.

O FTPS nada mais é do que uma extensão do protocolo FTP, que acrescenta o suporte a conexão criptografada usando TLS e/ou SSL.

O SFTP normalmente é confundido com o FTPS.  Na verdade seu nome vêm apenas da finalidade de transferência de arquivos, porém sua origem e natureza de implementação é bem diferente do FTP. Acrônimo de SSH File Transfer Protocol, na verdade é uma extensão do protocolo SSH (Secure Shell Protocol)  versão 2.0, concebido para transferência segura de arquivos.

Classe TFTPClient

Através da classe TFTPClient() do AdvPL, podemos criar uma conexão com um servidor FTP, bastando ter em mãos no mínimo o IP — ou nome do host — e a porta do servidor. Caso o servidor exija autenticação, precisamos ter um nome de usuário e uma senha para ser autenticada pelo servidor e realizar as operações.

Vale mencionar que, por hora, a classe TFTPClient() suporta apenas o protocolo FTP. Não há (ainda) suporte nativo em AdvPL para conexão cliente com FTPS e/ou SFTP. Quando existe a necessidade de uma integração automatizada com um servidor de arquivos implementado sobre um destes protocolos, a alternativa atual é executar uma aplicação externa mediante script ou similar, que faça a conexão e as tarefas necessárias.

Funcionalidades

Basicamente, as operações de um Cliente de FTP são as equivalentes a uma navegação em uma estrutura de pastas ou diretórios. Ao estabelecer a conexão com um servidor de FTP, normalmente o nosso diretório de trabalho remoto é a pasta “raiz” de publicação do FTP Server. A partir desse ponto, podemos executar operações como “listar arquivos da pasta atual”, “entrar em uma pasta”, “voltar para a pasta anterior”, “copiar um arquivo da pasta do FTP para a estação atual”, “copiar um arquivo da estação atual para a pasta atual do FTP”, “apagar um arquivo” e assim por diante.

Através das propriedades e métodos da classe TFTPClient(), podemos consultar ou parametrizar — de acordo com as capacidades do Servidor de FTP — o modo de transferência de arquivos, o tipo de transferência, o modo de conexão (Ativo ou Passivo), entre outras particularidades. Será mais fácil entender o funcionamento da classe partindo de um exemplo.

Exemplo AdvPL

O primeiro exemplo de uso será bem simples. Sua função é identificar a existência de um determinado arquivo na pasta Raiz de um servidor de FTP, e caso o arquivo exista, a aplicação AdvPL fará o download deste arquivo para uma pasta local do ambiente (environment) a partir do rootpath, chamada “downloads”. O Servidor de FTP utilizado foi um IIS em um Windows 10, com um site de FTP configurado para permitir acesso anônimo.

#include 'protheus.ch'

User Function TSTFTP()
Local oFtp, nStat
Local aFtpFile 
Local cFtpSrv := 'note-juliow-ssd'
Local nFTPPort := 21

SET DATE BRITISH
SET CENTURY ON

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

// Estabelece a conexão com o FTP Server 
nStat := oFtp:FtpConnect(cFtpSrv,nFTPPort)
If nStat != 0
  conout("FTPClient - Erro de Conexao "+cValToChar(nStat))
  QUIT
Endif

// Procura pelo arquivo leiame.txt
aFtpFile := oFtp:Directory( "leiame.txt", .T. )

if len(aFtpFile) > 0
  // Arquivo encontrado - Mostra os detalhes do arquivo 
  conout( cValToChar(aFtpFile[1][1])+" | "+; // nome
    cValToChar(aFtpFile[1][2])+" | "+; // tamanho
    cValToChar(aFtpFile[1][3])+" | "+; // data
    cValToChar(aFtpFile[1][4])+" | "+; // horario
    cValToChar(aFtpFile[1][5]) ) // Atributo . D = Diretorio
  // Faz o download do arquivo para a pasta local de downloads
  nStat := oFtp:ReceiveFile('leiame.txt','\downloads\leiame.txt' ) 
  If nStat != 0 
    conout("*** Falha no recebimento do arquivo - Erro "+cValToChar(nStat))
  Else
    conout("Arquivo recebido com sucesso.")
  Endif
Else
  conout("*** Arquivo nao encontrado.")
Endif
oFtp:Close()
Return

Caso ocorra falha de conexão, o programa não continua. Ao determinar a existência do arquivo no Servidor de FTP — através do método ::Directory() — fazemos o download do arquivo usando o método ::ReceiveFile(). Caso o arquivo na pasta local já exista, ele será sobrescrito.

Nas referências deste post, verifiquem todas as propriedades e métodos disponíveis na classe TFTPClient() na documentação dela na TDN. Para uma primeira versão, nosso exemplo será bem “arroz com feijão” mesmo, acredito que somente com um programa mais extenso, ou com mais programas de tamanho reduzido, será possível exemplificar as demais funcionalidades da classe TFTPClient()

Observações

Os primeiros testes das funcionalidades básicas foram feitos configurando o programa Cliente de exemplo usando o Protheus como FTP Server. E, para meu espanto, o método ::Directory()  não encontrava o arquivo, na verdade mesmo que a máscara de busca informada fosse  “*”  — para identificar todos os arquivos e sub-pastas a partir da pasta atual, não localizavam nada. Em um dos testes, eu resolvi acessar — para consulta — a propriedade chamada nDirInfo da engine Client de FTP, e para minha surpresa, após acessar esta propriedade, o método ::Directory(“leiame.txt”) localizou o arquivo, e o download / recebimento foi feito com sucesso. Como houveram falhas também em outras funcionalidades da API client, porém somente quando usado o Protheus como FTP Server, por hora os exemplos usados para demonstração das funcionalidades da classe TFTPClient serão testados com o FTP do Microsoft IIS, e posteriormente com um FTP Server no Linux,

Conclusão

Ainda vamos explorar mais esta classe, inclusive acessando um FTP Server na Internet. Porém, esta abordagem fica para o próximo post.

Agradeço novamente a audiência, curtidas, compartilhamentos, comentários e sugestões, e desejo a todos TERABYTES DE SUCESSO 😀

Referências

 

 

CRUD em AdvPL – Parte 15

Introdução

No post anterior, foi feito um Controle de Acesso para a Agenda, certo? Porém, o controle ainda não funciona, pois não foi feita a rotina de manutenção do cadastro de usuários. Logo, vamos criar esta rotina, mas antes disso vamos ver um pouco sobre reaproveitamento de código. Assim, quando partirmos para a rotina de manutenção de usuários não vamos precisar de tantas linhas de código como foi necessário na Agenda.

Reaproveitamento de Código

Quando você programa de modo segmentado, deixando claro o papel de cada função, mesmo que você não use OO (Orientação a Objetos), é relativamente fácil reaproveitar uma função para uma mesma tarefa, feita por entidades do programa diferentes.

Vamos começar pelo acesso aos dados. No programa AGENDA.PRW, existem duas funções, chamadas de OpenDB() e CloseDB(). Ambas, como foram inicialmente projetadas para serem chamadas apenas de dentro do fonte AGENDA.PRW, foram declaradas como STATIC FUNCTION. De fato, o uso de uma STATIC FUNCTION inicialmente limita a chamada desta função para outras funções ou mesmo métodos de classes, desde que eles sejam escritos dentro do mesmo arquivo fonte.

Porém, quando utilizamos o Protheus como plataforma de desenvolvimento, sem uma autorização especial fornecida pela TOTVS, você não consegue declarar uma FUNCTION no código, que poderia ser chamada de outros arquivos fonte. Quando não temos nenhuma autorização diferenciada de compilação, o ambiente Protheus permite a compilação de CLASSES ADVPL,  STATIC FUNCTION(s) e USER FUNCTION(s).

Escopo e Chamada de Funções

Quando declaramos uma USER FUNCTION, por exemplo USER FUNCTION AGENDA(), na verdade a função compilada no repositório de objetos chama-se U_AGENDA — É inserido o prefixo “U_” no nome da função. Uma USER FUNCTION pode ser chamada entre fontes distintos, porém reduz ainda mais a parte útil do nome da função. Exceto quando programamos em TL++ (ainda vamos falar disso em outro post), o AdvPL padrão permite a declaração de funções com até 10 caracteres em seu nome. Logo, quando usamos uma USER FUNCTION, o prefixo “U_” já usa dois caracteres, sobrando apenas 8 caracteres para identificar a função.

Você pode inclusive declarar a função com mais de 10 caracteres, e chamar ela com mais de 10 caracteres, PORÉM somente os 10 primeiros caracteres serão considerados, tanto na declaração quanto na chamada. Por exemplo, declare uma função chamada USER FUNCTION MEUTESTEOK(), e agora, de dentro de outra função, chame U_MEUTESTEX() — a função U_MEUTESTEOK será chamada. A função real compilada no Repositório vai se chamar U_MEUTESTE — com apenas os 10 caracteres significativos — então, se você chamar a função como U_MEUTESTE1 ou U_MEUTESTEX, são considerados apenas os 10 caracteres iniciais do nome da função, inclusive os dois caracteres do prefixo “U_”.

Quando utilizado TL++, onde existe suporte para funções, variáveis, classes, proriedades e métodos com mais de 10 caracteres — acho que vai até 250 — um fonte escrito assim daria erro, pois a chamada da função deve conter o nome inteiro igual a declaração da mesma.

Escopo de Classes AdvPL

Como as classes no AdvPL têm um fator de dinamismo bem alto, e não é necessário possuir um arquivo auxiliar ou #include com a definição da classe para ser possível consumir a classe em AdvPL, basta saber o nome da classe, seus métodos e propriedades para chamar seus construtores, métodos e propriedades, de qualquer arquivo fonte compilado no repositório.

De volta ao reaproveitamento

Se eu quiser usar as funções OpenDB() e CloseDB(), hoje declaradas como STATIC FUNCTION, em mais de um código ou programa fonte do projeto, eu preciso redefinir esta função.

A primeira alternativa poderia ser alterar a declaração de STATIC FUNCTION OPENDB() para USER FUNCTION OPENDB(), e trocar no fonte atual todas as chamadas dela, que originalmente usavam apenas OpenDb(), para o novo nome da função, que passou a se chamar U_OPENDB()

Outra alternativa — mais elegante — seria criar uma classe para agrupar estas funcionalidades — conexão com um Banco de Dados relacional através do DBAccess — e declarar estas funções como métodos da classe, para então criar uma instância da classe no início da execução do código, e fazer a chamada dos seus métodos no lugar das funções.

Embora ambas atendam a nossa necessidade, vamos optar pela mais elegante, vamos criar uma classe, em um novo fonte AdvPL, que deverá ser compilado no Projeto, para então utilizá-lo onde for necessário, em qualquer fonte do projeto.

Funções OpenDB() e CloseDB()

Vamos ver como eram estas funções:

STATIC Function OpenDB()
// Conecta com o DBAccess configurado no ambiente
nH := TCLink()
If nH < 0
  MsgStop("DBAccess - Erro de conexao "+cValToChar(nH))
  QUIT
Endif
// Liga o filtro para ignorar registros deletados na navegação ISAM 
SET DELETED ON
Return

STATIC Function CloseDB()
DBCloseAll()   // Fecha todas as tabelas
Tcunlink()     // Desconecta do DBAccess
Return

Agora, vamos ver como elas ficariam sendo escritas como métodos de uma classe — que vamos chamar de DBDriver,  criada no novo fonte DBDRIVER.PRW:

CLASS DBDriver
   DATA nHnd as INTEGER 
   METHOD New() CONSTRUCTOR 
   METHOD OpenDB()
   METHOD CloseDB()
ENDCLASS

METHOD New() CLASS DBDriver
::nHnd := -1
return self

METHOD OpenDB() CLASS DBDriver
If ::nHnd > 0 
  // Já estou conectado, torna esta conexão ativa 
  TCSetConn(::nHnd) 
  Return .T. 
Endif
// Conecta com o DBAccess configurado no ambiente
::nHnd := TCLink()
If ::nHnd < 0
  MsgStop("DBAccess - Erro de conexao "+cValToChar(::nHnd))
  Return .F.
Endif
// Liga o filtro para ignorar registros deletados na navegação ISAM 
SET DELETED ON
Return .T.

METHOD CloseDB() CLASS DBDriver
If ::nHnd > 0 
   DBCloseAll() // Fecha todas as tabelas e alias 
   Tcunlink(::nHnd) // Encerra a conexao atual com o DBAccess
   ::nHnd := -1 
Endif
Return .T.

Reparem no que houve, Eu criei um novo código fonte, chamado DBDRIVER.PRW, e dentro dele transformei as funções OpenDB() e CloseDB() em dos métodos. Depois, nos pontos do código onde as antigas funções eram chamadas, eu passsei a criar uma instância do Driver em uma variável local, chamada oDBSrv, chamando o construtor do Driver — DBDriver():New() — e nas chamadas das funções OpenDB() e CloseDB() , eu passei a chamar elas como métodos da classe, usando oDBSrv:OpenDB() e oDBSrv:CloseDB(). Dessa forma, eu estou isolando estas funcionalidades em um fonte separado, para ser chamado por outros fontes que precisem realizar as mesmas tarefas, como o fonte da Agenda e o fonte do Cadastro de Usuários.

Reaproveitando mais …

Ao implementar o cadastro de usuários na Agenda, a função OpenUsers() foi praticamente uma cópia da OpenAgenda(), trocando o nome da tabela e dos campos. Que tal fazermos dela apenas um método na nova classe DBDRiver?

METHOD OpenTable(cFile,aStru,cIdxUnq,aIndex) CLASS DBDriver
Local cLockId , aDbStru
Local nI , nIndex, cIndex

// Ajusta nome da tabela e cria 
// identificador de Bloqueio de operação
cFile := Upper(cFile)
cLockId := cFile+"_DB"

If empty(aIndex)
   aIndex := {}
Endif
// Quantos indices permanentes tem esta tabela 
nIndex := len(aIndex)

While !GlbNmLock(cLockId)
  If !MsgYesNo("Existe outro processo abrindo a tabela "+cFile+". "+;
               "Deseja tentar novamente ?")
    MsgStop("Abertura da tabela "+cLockId+" em uso -- "+;
           "tente novamente mais tarde.")
    Return .F. 
  Endif
Enddo

If !TCCanOpen(cFile)
  // Se o arquivo nao existe no banco, cria
  DBCreate(cFile,aStru,"TOPCONN")
Endif

// O Arquivo já existe, vamos comparar as estruturas
USE (cFile) ALIAS (cFile) SHARED NEW VIA "TOPCONN"
IF NetErr()
  MsgSTop("Falha ao abrir a tabela "+cFile+" em modo compartilhado. "+;
          "Tente novamente mais tarde.")
  Return .F.
Endif
// Obtêm a estrutura do banco de dados 
aDbStru := DBStruct()
USE

If len(aDbStru) != len(aStru)
  // O tamanho das estruturas mudou ?
  // Vamos alterar a estrutura da tabela
  // Informamos a estrutura atual, e a estrutura esperada
  If !TCAlter(cFile,aDbStru,aStru)
    MsgSTop(tcsqlerror(),"Falha ao alterar a estrutura da tabela "+cFile)
    Return .F. 
  Endif
  MsgInfo("Estrutura do arquivo "+cFile+" atualizada.")
Endif

// Se esta tabela deve ter indice unico
// Cria caso nao exista 
If !empty(cIdxUnq)
  If !TCCanOpen(cFile,cFile+'_UNQ')
    // Se o Indice único da tabela nao existe, cria
    USE (cFile) ALIAS (cFile) EXCLUSIVE NEW VIA "TOPCONN"
    IF NetErr()
      MsgSTop("Falha ao abrir a tabela "+cFile+" em modo EXCLUSIVO. "+;
              "Tente novamente mais tarde.")
      Return .F.
    Endif
    nRet := TCUnique(cFile,cIdxUnq)
    If nRet < 0
      MsgSTop(tcsqlerror(),;
              "Falha ao criar índice único ["+cIdxUnq+"] "+;
              "para a tabela ["+cFile+"]")
      Return .F.
    Endif
    USE
  EndIf
Endif

// Cria os indices que nao existem para a tabela \
// a Partir do Array de indices informado
For nI := 1 to nIndex
  // Determina o Nome do Indice
  cIndex := cFile+cValToChar(nIndex)
  // Pega a expressão de indexação
  cIdxExpr := aIndex[nI]
  If !TCCanOpen(cFile,cIndex)
    // Se o Indice nao existe, cria 
    USE (cFile) ALIAS (cFile) EXCLUSIVE NEW VIA "TOPCONN"
    IF NetErr()
      MsgSTop("Falha ao abrir a tabela "+cFile+" em modo EXCLUSIVO. "+;
              "Tente novamente mais tarde.")
      Return .F.
    Endif
    INDEX ON &cIdxExpr TO (cIndex)
    USE
  Endif
EndIf

// Abra o arquivo em modo compartilhado
USE (cFile) ALIAS (cFile) SHARED NEW VIA "TOPCONN"

If NetErr()
  MsgSTop("Falha ao abrir a tabela "+cFile+" em modo compartilhado. "+;
          "Tente novamente mais tarde.")
  Return .F.
Endif

// Abre os indices, seleciona o primeiro
// e posiciona o arquivo no topo

For nI := 1 to nIndex
  cIndex := cFile+cValToChar(nIndex)
  DbSetIndex(cIndex)
Next

DbSetOrder(1)
DbGoTop()

// Solta o MUTEX
GlbNmUnlock(cLockId)

Return .T.

Reparem que tudo o que estava pré-definido em código (ou “CHUMBADO”) agora é recebido por parâmetro. cFile recebe o nome do arquivo, aStru recebe o array com a estrutura da tabela no formato AdvPL, cIdxUnq quando informado deve conter os campos a serem usados para a criação de índice único no SGDB separados por vírgula, e aIndex deve ser um Array de Strings, onde cada elemento corresponde a expressão de indexação para cada índice que deve ser criado para esta tabela.

Vamos ver agora como ficaria a nova função OpenAgenda(), usando o método OpenTable() da classe DBDriver?

STATIC Function OpenAgenda(oDbDrv)
Local cFile := "AGENDA"
Local aStru := {}
Local cIdxUnq 
Local aIndex := {}
Local lOk

// Define a estrutura do arquivo 
aadd(aStru,{"ID"    ,"C",06,0})
aadd(aStru,{"NOME"  ,"C",50,0})
aadd(aStru,{"ENDER" ,"C",50,0})
aadd(aStru,{"COMPL" ,"C",20,0})
aadd(aStru,{"BAIRR" ,"C",30,0})
aadd(aStru,{"CIDADE","C",40,0})
aadd(aStru,{"UF"    ,"C",02,0})
aadd(aStru,{"CEP"   ,"C",08,0})
aadd(aStru,{"FONE1" ,"C",20,0})
aadd(aStru,{"FONE2" ,"C",20,0})
aadd(aStru,{"EMAIL" ,"C",40,0})
aadd(aStru,{"IMAGE" ,"M",10,0})

// Índice único pelo campo ID 
cIdxUnq := "ID"

// Define a estrutura de índices
aadd(aIndex,"ID") // Indice 01 por ID 
aadd(aIndex,"NOME") // Indice 02 por NOME

// Pede para o Driver de Dados abrir a tabela 
lOk := oDbDrv:OpenTable(cFile,aStru,cIdxUnq,aIndex)

Return lOk

Reparem que eu passei tudo como parâmetro para o Driver. Sim, eu também passei a receber como parâmetro o Driver de Dados da aplicação como parâmetro. Mas meu código, com mais de 100 linhas, caiu para 32 linhas ou menos. Ao fazer a mesma coisa com a função OpenUsers(), economizamos mais um montão de linhas e reaproveitamos o código de criação e abertura de tabelas e índices.

STATIC Function OpenUsers(oDbDrv)
Local cFile := "USUARIOS"
Local aStru := {}
Local cIdxUnq 
Local aIndex := {}
Local lOk

// Cria o array com os campos do arquivo 
aadd(aStru,{"IDUSR" ,"C",06,0})
aadd(aStru,{"LOGIN" ,"C",50,0})
aadd(aStru,{"SENHA" ,"C",32,0})

// Índice único pelo campo LOGIN
cIdxUnq := "LOGIN"

// Definição de índices
aadd(aIndex,"IDUSR") // Indice 01 por ID de Usuario 
aadd(aIndex,"LOGIN") // Indice 02 por Login

// Pede para o Driver de Dados abrir a tabela 
lOk := oDbDrv:OpenTable(cFile,aStru,cIdxUnq,aIndex)

Return lOk

Não ficou bem mais simples? O código apenas preencheu as definições necessárias, e a responsabilidade de fazer a mágica é do Driver. De qualquer modo, a simplicidade dos argumentos informados parte de algumas premissas e comportamentos da versão atual deste fonte:

  1. O Método OpenTable() vai criar os índices usando o nome da tabela informado como parâmetro, seguido por um número, iniciando em “1”, para os índices informados, na ordem em que foram informados.
  2. O índice único segue a nomenclatura padrão do DBACCESS — Nome da tabela mais o sufixo “_UNQ”.
  3. A análise realizada na abertura da tabela comparando a diferença entre a estrutura da tabela definida pelo código e a estrutura atual do banco de dados — na versão atual — apenas verifica se o tamanho delas está diferente, não levando em conta a possibilidade de haver alteração de propriedades de campos existentes.
  4. A verificação dos índices limita-se a criar índices inexistentes. Caso seja necessária uma alteração de alguma expressão de indexação, ainda não há verificação para isso na aplicação, devendo o índice ser removido do SGDB para ser recriado pela aplicação.

E, por mais bonito que tenha ficado o fonte desta classe, ele ainda têm uma característica indesejável: Ele ainda faz comunicação direta com a interface, através de funções como MsgInfo(), MsgStop() e afins. Mas não criemos pânico, logo logo vamos refatorar este código também…

Conclusão

Acho que o reaproveitamento do código atual vai precisar de mais uma etapa, antes de partirmos para a inclusão de um novo usuário. Porém, podemos fazer um AJUSTE PONTUAL na rotina, criando um usuário “Inicial”, caso você deseje usar e testar o mecanismo de LOGIN. Para isso, altere a função ChkUser() para ela fazer a inserção do ADMIN com senha em branco caso a tabela esteja fazia, e a partir de então sempre solicitar o login, veja a parte do fonte alterado abaixo:

// Vai para o topo do arquivo 
DbSelectarea("USUARIOS")
DBGoTOP()

If EOF()
   // Se nao tem usuarios , cria um "ADMIN", com senha em branco 
   DBAppend()   
   USUARIOS->IDUSR := '000000'
   USUARIOS->LOGIN := "ADMIN"
   USUARIOS->SENHA := MD5("",HEX_DIGEST)
   DBRUnlock()
Endif

// Faz a validação do usuário 
lOk := DoLogin(oDlg)

No próximo post, vamos continuar refatorando alguns pontos da Agenda para reaproveitar mais código, assim ao invés de COPIAR E COLAR — e replicar código DESNECESSARIAMENTE — usamos a refatoração para reaproveitar uma parte das funcionalidades já escritas, que serão comuns para novos componentes e tabelas da aplicação.

Desejo a todos um bom aproveitamento desse material, e TERABYTES DE SUCESSO 😀