Algoritmos – Parte 01 – Loterias

01/12/201801/12/2018 Júlio Wittwer ADVPL, Orientação a Objeto Performance, Programação, Soluções

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

22/11/2018 Júlio Wittwer ADVPL, Infraestrutura, Interface, Orientação a Objeto FTP, Interface, Internet

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.

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.

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.

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.

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

09/09/201811/11/2018 Júlio Wittwer ADVPL, Orientação a Objeto ADVPL, Orientação a Objetos

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

12/07/201511/11/2018 Júlio Wittwer ADVPL, Orientação a Objeto, Web Services ADVPL, Classes, Orientação a Objetos, Programação, WebServices

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 😀

Web Services em AdvPL – Parte 01

28/03/201511/11/2018 Júlio Wittwer ADVPL, Orientação a Objeto, Web Services ADVPL, Avançado, Exemplos, WebServices

Introdução

Quem não conhece, já ouviu falar de Web Services. Traduzindo em pouquíssimas palavras, Web Services é um padrão de comunicação entre sistemas, onde o provedor ( ou “servidor” ) de um Web Service, possui uma camada de publicação de classes e métodos, descritos em um documento baseado em XML, chamado de WSDL ( Web Services Description Language ), através do qual uma linguagem ou plataforma de desenvolvimento pode criar uma classe ou camada de “proxy” para acessar as funcionalidades descritas no WSDL. Normalmente os Web Services utilizam o protocolo HTTP para trocas de mensagens entre a aplicação cliente e o servidor, e são utilizados entre sistemas que podem ou não ser baseados na mesma plataforma ou tecnologia, e as aplicações client e server podem estar na mesma rede ( intranet ) ou na Internet.

WSDL

A especificação da descrição de um Web Service é bem ampla, ela prevê a descrição detalhada das classes e métodos disponíveis, descrição das estruturas de parâmetros e retornos, até mesmo a documentação textual de cada método pode ser especificada dentro do WSDL. Normalmente uma plataforma de desenvolvimento que trabalha com orientação a objetos e é compatível nativamente com Web Services, provê um tipo de classe diferenciada para permitir a publicação de uma classe implementada no formato nativo da linguagem para ser acessada como um Web Service.

SOAP

Soap é um acrônimo para Simple Object Access Protocol, trata-se de uma especificação para troca de informações estruturadas, baseado em XML. O WSDL fornecido descreve como devem ser os pacotes SOAP de envio e retorno de informações de um Web Service. A especificação das mensagens normalmente são simples, porém a especificação permite criar camadas complexas, chegando até mesmo ao nível de declaração de mensagens com herança e utilização de mais de um arquivo de definições, especificados como “includes” ou “imports” dentro dos WSDL(s).

Vantagens

Quando você usa uma plataforma ou ambiente de desenvolvimento que cria uma classe “proxy” para você consumir um Web Service, o mundo é maravilhoso, o céu é azul, tudo é lindo. Você não precisa saber ou entender o que vai dentro do XML, a classe monta tudo para você, basta alimentar os dados nas estruturas de parâmetro e consumir o serviço, e em caso de sucesso a(s) estrutura(s) de retorno estarão preenchidas. Com o detalhamento do WSDL, a classe proxy gerada pode até já vir documentada. A utilização do protocolo HTTP para envio de requisições torna mais fácil a criação de integrações de sistemas baseados em SOA (Service-Oriented Architecture), ou Arquitetura Orientada a Serviços.

Desvantagens

Quando falamos de transações curtas, requisições pequenas, Web Services é ótimo. Mas se você vai enfiar em uma única requisição um caminhão de dados, ou mesmo arquivos, a natureza de parser de XML — que normalmente exige que o documento inteiro seja parseado ou analisado antes do método chamado ser efetivamente executado — ou mesmo qualquer instabilidade no HTTP, ou picos de latência, podem tornar o processamento mais lento, devido ao overhead das camadas utilizadas, e com isso deixar o cliente do serviço esperando por muito tempo, o que não é uma boa prática. Como toda a solução tecnológica, seu uso deve ser mediante a necessidade, quando aplicável ao cenário proposto. Se você precisa transferir arquivos grandes para um processamento, faça-o via FTP, e utilize um WebService apenas para solicitar a requisição de processamento, informando o arquivo a ser utilizado. Lembrando que esta é uma prerrogativa que o desenvolvedor da parte “Server” do Web Service deve ser responsável.

Web Services no AdvPL

Desde 2002, o Protheus permite a criação de Web Services Server no repositório, bastando para isso escrever uma classe do tipo WSSERVER, e um FrameWork da LIB do ERP Microsiga provê a camada WEB de publicação ( WSDL ) e consumo. E, para a geração de uma classe proxy de um WebService, o IDE e o TDS possuem uma ferramenta de geração de código, que gera a classe client AdvPL ( WSCLIENT ), também utilizando um FrameWork da LIB do ERP Microsiga, para consumir o serviço.

A implementação dos Web Services em AdvPL (client-side) não consegue atender a especificação inteira de todas as versões de SOAP, mas atende a maioria das partes mais utilizadas das especificações. Existem algumas dificuldades com o uso de WebServices onde o WSDL “mescla” namespaces distintos nos serviços, e às vezes alguma propriedade específica da especificação é utilizada, e exige um pacote diferenciado. Uma vez que a classe proxy seja gerada em AdvPL, é possível customizá-la para atender estas necessidades, mas o desenvolvedor deve lembrar-se de que: Se ele precisar re-gerar a classe proxy, as alterações feitas por ele no código serão perdidas, portanto quando isso for mesmo necessário, cabe ao desenvolvedor manter um histórico do que ele precisou mexer na classe client, para ele refazer as mesmas alterações caso a classe client venha a ser re-gerada.

No TDN, existe uma árvore de tópicos sobre Web Services, dispinível a partir do Link http://tdn.totvs.com/display/tec/Web+Services+–+23597, onde inclusive é abordado um outro tipo de Web Service, chamado REST, que não usa XML para a troca de dados entre a aplicação cliente e servidora. Este post não substitui a documentação da TDN, apenas procura colocar alguns detalhes a mais, em uma linguagem um pouco mais informal, sobre a tecnologia envolvida.

Nova classe Client no AdvPL

Nas builds do TOTVS|Application Server, a partir da 7.00.121227P, foi publicada uma nova classe client de Web Services na linguagem AdvPL, chamada “tWSDLManager“. Ela é uma classe proxy dinâmica, onde você fornece para ela o WSDL do serviço, ela identifica na hora todas as classes e métodos disponíveis para serem consumidas, e provê métodos para que você consuma o serviço diretamente pela classe, ou utilize a classe como “core” de WebSErvices, para montar o pacote com a requisição, e o desenvolvedor poder utilizar outro meio de transporte além do HTTP para a transmissão dos dados.

Ela não é tão prática quanto a implementação anterior, onde uma classe proxy em AdvPL era gerada e compilada no repositório de objetos do ERP, porém ela foi construída com um núcleo mais robusto, e compatível com elementos não suportados pela classe proxy WSCLIENT. Então, este tópico vamos ver como usar esta classe para, por exemplo, consumir um Web Service publico na Internet.

Usando um Web Service na Internet

Vamos usar um serviço de conversão de moedas, disponível no endereço http://www.webservicex.net/CurrencyConvertor.asmx. Ao acessar esta página,
vemos que não se trata de um Web Site tradicional, mas uma página de publicação com detalhes do serviço. O provedor deste serviço utilizou o ASP .NET para fazê-lo. O que nos interessa para consumir o serviço é o WSDL, disponivel no link da página onde é mostrado em destaque “Service Description”. Clique neste link, e o WSDL será mostrado no seu Browser. Agora, pegue a URL mostrada no Browse ( http://www.webservicex.net/CurrencyConvertor.asmx?WSDL ) e copie para a área de transferência do Windows ( o famoso Control+C ).

Gerando a classe Client em AdvPL

Pelo método tradicional, usando o TDS, vamos gerar a classe client em AdvPL para consumir este serviço. Antes de mais nada, após abrir o TDS, entre na perspectiva de “Administrador TOTVS”, e na aba “Servidor”, configure ou selecione um servidor do TOTVS Application Server previamente configurado e conecte nele. Sem a conexão com um Application Server, a geração de código AdvPL para WebServices não funciona.

Utilizando o TDS 11.3, na perspectiva “Desenvolvedor Totvs”, localize a janela “Explorador de Projetos”, normalmente do lado esquerdo do vídeo, escolha ou crie uma pasta no projeto para acomodar o fonte gerado, e clicando com o botão direito sobre a pasta, escolha a opção Novo -> Outras, e na tela apresentada, escolha Advpl -> Novo fonte WSDL AdvPL.

Clique em “avançar”, e será mostrado uma tela perguntando os dados pertinentes do serviço. Na primeira informação (local), é mostrada a pasta do projeto onde o fonte será criado. Pode ser mantida a informação lá existente. Na segunda informação (nome do fonte), devemos informar o nome do fonte AdvPL que será criado com a classe client. No nosso exemplo, informe “ConvMoedas”, e no campo “url”, cole a URL do WSDL do serviço, anteriormente copiada para a área de transferência do Windows na etapa anteriormente descrita. Então, clique no botão “Concluir”.

Se não houver nenhum problema com a conexão com a Internet, o fonte “ConvMoedas.prw” deverá ser criado, e adicionado automaticamente ao Projeto aberto no TDS. PAra compilar o fonte, basta estar com o foco na janela do editor de código deste fonte, e pressionar as teclas Control+F9. Vamos ver o fonte gerado no meu ambiente de testes:

#INCLUDE "PROTHEUS.CH"
#INCLUDE "APWEBSRV.CH"

/* ===============================================================================
WSDL Location http://www.webservicex.net/CurrencyConvertor.asmx?WSDL
Gerado em 03/27/15 21:22:35
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 _HKRQIVL ; Return // "dummy" function - Internal Use

/* -------------------------------------------------------------------------------
WSDL Service WSCurrencyConvertor
------------------------------------------------------------------------------- */

WSCLIENT WSCurrencyConvertor

WSMETHOD NEW
 WSMETHOD INIT
 WSMETHOD RESET
 WSMETHOD CLONE
 WSMETHOD ConversionRate

WSDATA _URL AS String
 WSDATA _HEADOUT AS Array of String
 WSDATA _COOKIES AS Array of String
 WSDATA oWSFromCurrency AS CurrencyConvertor_Currency
 WSDATA oWSToCurrency AS CurrencyConvertor_Currency
 WSDATA nConversionRateResult AS double

ENDWSCLIENT

WSMETHOD NEW WSCLIENT WSCurrencyConvertor
::Init()
If !FindFunction("XMLCHILDEX")
 UserException("O Código-Fonte Client atual requer os executáveis do Protheus Build [7.00.131227A-20150220] ou superior. Atualize o Protheus ou gere o Código-Fonte novamente utilizando o Build atual.")
EndIf
If val(right(GetWSCVer(),8)) < 1.040504
 UserException("O Código-Fonte Client atual requer a versão de Lib para WebServices igual ou superior a ADVPL WSDL Client 1.040504. Atualize o repositório ou gere o Código-Fonte novamente utilizando o repositório atual.")
EndIf
Return Self

WSMETHOD INIT WSCLIENT WSCurrencyConvertor
 ::oWSFromCurrency := CurrencyConvertor_CURRENCY():New()
 ::oWSToCurrency := CurrencyConvertor_CURRENCY():New()
Return

WSMETHOD RESET WSCLIENT WSCurrencyConvertor
 ::oWSFromCurrency := NIL 
 ::oWSToCurrency := NIL 
 ::nConversionRateResult := NIL 
 ::Init()
Return

WSMETHOD CLONE WSCLIENT WSCurrencyConvertor
Local oClone := WSCurrencyConvertor():New()
 oClone:_URL := ::_URL 
 oClone:oWSFromCurrency := IIF(::oWSFromCurrency = NIL , NIL ,::oWSFromCurrency:Clone() )
 oClone:oWSToCurrency := IIF(::oWSToCurrency = NIL , NIL ,::oWSToCurrency:Clone() )
 oClone:nConversionRateResult := ::nConversionRateResult
Return oClone

// WSDL Method ConversionRate of Service WSCurrencyConvertor

WSMETHOD ConversionRate WSSEND oWSFromCurrency,oWSToCurrency WSRECEIVE nConversionRateResult WSCLIENT WSCurrencyConvertor
Local cSoap := "" , oXmlRet

BEGIN WSMETHOD

cSoap += ''
cSoap += WSSoapValue("FromCurrency", ::oWSFromCurrency, oWSFromCurrency , "Currency", .T. , .F., 0 , NIL, .F.) 
cSoap += WSSoapValue("ToCurrency", ::oWSToCurrency, oWSToCurrency , "Currency", .T. , .F., 0 , NIL, .F.) 
cSoap += ""

oXmlRet := SvcSoapCall( Self,cSoap,; 
 "http://www.webserviceX.NET/ConversionRate",; 
 "DOCUMENT","http://www.webserviceX.NET/",,,; 
 "http://www.webservicex.net/CurrencyConvertor.asmx")

::Init()
::nConversionRateResult := WSAdvValue( oXmlRet,"_CONVERSIONRATERESPONSE:_CONVERSIONRATERESULT:TEXT","double",NIL,NIL,NIL,NIL,NIL,NIL)

END WSMETHOD

oXmlRet := NIL
Return .T.

// WSDL Data Enumeration Currency

WSSTRUCT CurrencyConvertor_Currency
 WSDATA Value AS string
 WSDATA cValueType AS string
 WSDATA aValueList AS Array Of string
 WSMETHOD NEW
 WSMETHOD CLONE
 WSMETHOD SOAPSEND
 WSMETHOD SOAPRECV
ENDWSSTRUCT

WSMETHOD NEW WSCLIENT CurrencyConvertor_Currency
 ::Value := NIL
 ::cValueType := "string"
 ::aValueList := {}
 aadd(::aValueList , "AFA" )
 aadd(::aValueList , "ALL" )
 aadd(::aValueList , "DZD" )
 aadd(::aValueList , "ARS" )
 aadd(::aValueList , "AWG" )
 aadd(::aValueList , "AUD" )
 aadd(::aValueList , "BSD" )
 aadd(::aValueList , "BHD" )
 aadd(::aValueList , "BDT" )
 aadd(::aValueList , "BBD" )
 aadd(::aValueList , "BZD" )
 aadd(::aValueList , "BMD" )
 aadd(::aValueList , "BTN" )
 aadd(::aValueList , "BOB" )
 aadd(::aValueList , "BWP" )
 aadd(::aValueList , "BRL" )
 aadd(::aValueList , "GBP" )
 aadd(::aValueList , "BND" )
 aadd(::aValueList , "BIF" )
 aadd(::aValueList , "XOF" )
 aadd(::aValueList , "XAF" )
 aadd(::aValueList , "KHR" )
 aadd(::aValueList , "CAD" )
 aadd(::aValueList , "CVE" )
 aadd(::aValueList , "KYD" )
 aadd(::aValueList , "CLP" )
 aadd(::aValueList , "CNY" )
 aadd(::aValueList , "COP" )
 aadd(::aValueList , "KMF" )
 aadd(::aValueList , "CRC" )
 aadd(::aValueList , "HRK" )
 aadd(::aValueList , "CUP" )
 aadd(::aValueList , "CYP" )
 aadd(::aValueList , "CZK" )
 aadd(::aValueList , "DKK" )
 aadd(::aValueList , "DJF" )
 aadd(::aValueList , "DOP" )
 aadd(::aValueList , "XCD" )
 aadd(::aValueList , "EGP" )
 aadd(::aValueList , "SVC" )
 aadd(::aValueList , "EEK" )
 aadd(::aValueList , "ETB" )
 aadd(::aValueList , "EUR" )
 aadd(::aValueList , "FKP" )
 aadd(::aValueList , "GMD" )
 aadd(::aValueList , "GHC" )
 aadd(::aValueList , "GIP" )
 aadd(::aValueList , "XAU" )
 aadd(::aValueList , "GTQ" )
 aadd(::aValueList , "GNF" )
 aadd(::aValueList , "GYD" )
 aadd(::aValueList , "HTG" )
 aadd(::aValueList , "HNL" )
 aadd(::aValueList , "HKD" )
 aadd(::aValueList , "HUF" )
 aadd(::aValueList , "ISK" )
 aadd(::aValueList , "INR" )
 aadd(::aValueList , "IDR" )
 aadd(::aValueList , "IQD" )
 aadd(::aValueList , "ILS" )
 aadd(::aValueList , "JMD" )
 aadd(::aValueList , "JPY" )
 aadd(::aValueList , "JOD" )
 aadd(::aValueList , "KZT" )
 aadd(::aValueList , "KES" )
 aadd(::aValueList , "KRW" )
 aadd(::aValueList , "KWD" )
 aadd(::aValueList , "LAK" )
 aadd(::aValueList , "LVL" )
 aadd(::aValueList , "LBP" )
 aadd(::aValueList , "LSL" )
 aadd(::aValueList , "LRD" )
 aadd(::aValueList , "LYD" )
 aadd(::aValueList , "LTL" )
 aadd(::aValueList , "MOP" )
 aadd(::aValueList , "MKD" )
 aadd(::aValueList , "MGF" )
 aadd(::aValueList , "MWK" )
 aadd(::aValueList , "MYR" )
 aadd(::aValueList , "MVR" )
 aadd(::aValueList , "MTL" )
 aadd(::aValueList , "MRO" )
 aadd(::aValueList , "MUR" )
 aadd(::aValueList , "MXN" )
 aadd(::aValueList , "MDL" )
 aadd(::aValueList , "MNT" )
 aadd(::aValueList , "MAD" )
 aadd(::aValueList , "MZM" )
 aadd(::aValueList , "MMK" )
 aadd(::aValueList , "NAD" )
 aadd(::aValueList , "NPR" )
 aadd(::aValueList , "ANG" )
 aadd(::aValueList , "NZD" )
 aadd(::aValueList , "NIO" )
 aadd(::aValueList , "NGN" )
 aadd(::aValueList , "KPW" )
 aadd(::aValueList , "NOK" )
 aadd(::aValueList , "OMR" )
 aadd(::aValueList , "XPF" )
 aadd(::aValueList , "PKR" )
 aadd(::aValueList , "XPD" )
 aadd(::aValueList , "PAB" )
 aadd(::aValueList , "PGK" )
 aadd(::aValueList , "PYG" )
 aadd(::aValueList , "PEN" )
 aadd(::aValueList , "PHP" )
 aadd(::aValueList , "XPT" )
 aadd(::aValueList , "PLN" )
 aadd(::aValueList , "QAR" )
 aadd(::aValueList , "ROL" )
 aadd(::aValueList , "RUB" )
 aadd(::aValueList , "WST" )
 aadd(::aValueList , "STD" )
 aadd(::aValueList , "SAR" )
 aadd(::aValueList , "SCR" )
 aadd(::aValueList , "SLL" )
 aadd(::aValueList , "XAG" )
 aadd(::aValueList , "SGD" )
 aadd(::aValueList , "SKK" )
 aadd(::aValueList , "SIT" )
 aadd(::aValueList , "SBD" )
 aadd(::aValueList , "SOS" )
 aadd(::aValueList , "ZAR" )
 aadd(::aValueList , "LKR" )
 aadd(::aValueList , "SHP" )
 aadd(::aValueList , "SDD" )
 aadd(::aValueList , "SRG" )
 aadd(::aValueList , "SZL" )
 aadd(::aValueList , "SEK" )
 aadd(::aValueList , "CHF" )
 aadd(::aValueList , "SYP" )
 aadd(::aValueList , "TWD" )
 aadd(::aValueList , "TZS" )
 aadd(::aValueList , "THB" )
 aadd(::aValueList , "TOP" )
 aadd(::aValueList , "TTD" )
 aadd(::aValueList , "TND" )
 aadd(::aValueList , "TRL" )
 aadd(::aValueList , "USD" )
 aadd(::aValueList , "AED" )
 aadd(::aValueList , "UGX" )
 aadd(::aValueList , "UAH" )
 aadd(::aValueList , "UYU" )
 aadd(::aValueList , "VUV" )
 aadd(::aValueList , "VEB" )
 aadd(::aValueList , "VND" )
 aadd(::aValueList , "YER" )
 aadd(::aValueList , "YUM" )
 aadd(::aValueList , "ZMK" )
 aadd(::aValueList , "ZWD" )
 aadd(::aValueList , "TRY" )
Return Self

WSMETHOD SOAPSEND WSCLIENT CurrencyConvertor_Currency
 Local cSoap := "" 
 cSoap += WSSoapValue("Value", ::Value, NIL , "string", .F. , .F., 3 , NIL, .F.) 
Return cSoap

WSMETHOD SOAPRECV WSSEND oResponse WSCLIENT CurrencyConvertor_Currency
 ::Value := NIL
 If oResponse = NIL ; Return ; Endif 
 ::Value := oResponse:TEXT
Return

WSMETHOD CLONE WSCLIENT CurrencyConvertor_Currency
Local oClone := CurrencyConvertor_Currency():New()
 oClone:Value := ::Value
Return oClone

Agora, para consumir este serviço, precisamos dar uma olhada com calma na classe proxy gerada. Primeiro, vejamos os métodos disponíveis:

WSMETHOD NEW
 WSMETHOD INIT
 WSMETHOD RESET
 WSMETHOD CLONE
 WSMETHOD ConversionRate

Os quatro primeiros métodos fazem parte da manutenção da instância da classe client. Por hora o que nos interessa é o construtor (NEW), e o método ConversionRate, que é o único método disponibilizado por este serviço. Vamos procurar pela declaração deste método.

WSMETHOD ConversionRate WSSEND oWSFromCurrency,oWSToCurrency WSRECEIVE nConversionRateResult WSCLIENT WSCurrencyConvertor

Ao avaliarmos a implementação do método, vemos que ele têm dois parâmetros, do tipo Objeto, e um resultado numérico. Vamos procurar no fonte pela definição de cada um destes parâmetros (oWSFromCurrency e oWSToCurrency).

WSDATA oWSFromCurrency AS CurrencyConvertor_Currency
WSDATA oWSToCurrency AS CurrencyConvertor_Currency

Cada um dos parâmetros do WebService é declarado como uma propriedade da classe Proxy. Neste caso, ambos são objetos do mesmo tipo ( CurrencyConvertor_Currency ). Vamos ver definição deste objeto:

// WSDL Data Enumeration Currency

WSSTRUCT CurrencyConvertor_Currency
 WSDATA Value AS string
 WSDATA cValueType AS string
 WSDATA aValueList AS Array Of string
 WSMETHOD NEW
 WSMETHOD CLONE
 WSMETHOD SOAPSEND
 WSMETHOD SOAPRECV
ENDWSSTRUCT

Então, este objeto é um “Enumeration”, com base em uma String. Isto permite o código Client do Web Services verificar se o conteúdo informado é válido antes mesmo da requisição ser realizada.

Com estas informações, vamos montar o fonte Client em AdvPL que vai consumir esta classe.

#include "protheus.ch"

/* -------------------------------------------------------------------
Função U_MOEDAS
Autor Júlio Wittwer
Data 28/03/2015
Descrição Fonte de exemplo consumingo um Web Service publico
 de fator de conversão de moedas, utilizando a 
 geração de classe Client de Web Services do AdvPL
Url http://www.webservicex.net/CurrencyConvertor.asmx?WSDL
------------------------------------------------------------------- */
User Function Moedas()

Local oWS

// Cria a instância da classe client
oWs := WSCurrencyConvertor():New()

// Alimenta as propriedades de envio 
oWS:oWSFromCurrency:Value := 'BRL' // Real ( Brasil )
oWS:oWSToCurrency:Value := 'USD' // United States Dollar

// Habilita informações de debug no log de console
WSDLDbgLevel(3)

// Chama o método do Web Service
If oWs:ConversionRate()
 // Retorno .T. , solicitação enviada e recebida com sucesso
 MsgStop("Fator de conversão: "+cValToChar(oWS:nConversionRateResult),"Requisição Ok")
 MsgStop("Por exemplo, 100 reais compram "+cValToChar(100 * oWS:nConversionRateResult )+" Dólares Americanos.")
Else
 // Retorno .F., recupera e mostra string com detalhes do erro 
 MsgStop(GetWSCError(),"Erro de Processamento")
Endif

Return

Ao executar este fonte, o retorno esperado é uma sequência de duas janelas de informações, contendo o fator de conversão, e um exemplo de uso deste fator convertendo 100 reais para dólares americanos.

Agora, vamos ver como este exemplo seria escrito usando a classe tWSDLManager(), da forma mais minimalista possível.

#include "protheus.ch"

/* -------------------------------------------------------------------
Função U_MOEDAS2
Autor Júlio Wittwer
Data 28/03/2015
Descrição Fonte de exemplo consumingo um Web Service publico
 de fator de conversão de moedas, utilizando a 
 classe tWSDLManager()
Url http://www.webservicex.net/CurrencyConvertor.asmx?WSDL
------------------------------------------------------------------- */

User Function Moedas2()
Local oWSDL
Local lOk, cResp, aElem, nPos

oWSDL := tWSDLManager():New()

// Seta o modo de trabalho da classe para "verbose"
oWSDL:lVerbose := .T.

// Primeiro faz o parser do WSDL a partir da URL
lOk := oWsdl:ParseURL( "http://www.webservicex.net/CurrencyConvertor.asmx?WSDL" )
if !lOk 
 MsgStop( oWsdl:cError , "ParseURL() ERROR")
 Return
endif

// Seta a operação a ser utilizada
lOk := oWsdl:SetOperation( "ConversionRate" )
if !lOk
 MsgStop( oWsdl:cError , "SetOperation(ConversionRate) ERROR")
 Return
endif

// Setar um valor para conversão

lOk := oWsdl:SetFirst('FromCurrency','BRL')
if !lOk
 MsgStop( oWsdl:cError , "SetFirst(FromCurrency) ERROR")
 Return
endif

lOk := oWsdl:SetFirst('ToCurrency','USD')
if !lOk
 MsgStop( oWsdl:cError , "SetFirst (ToCurrency) ERROR")
 Return
endif/

// Faz a requisição ao WebService 
lOk := oWsdl:SendSoapMsg()
if !lOk
 MsgStop( oWsdl:cError , "SendSoapMsg() ERROR")
 Return
endif

// Recupera os elementos de retorno, já parseados
cResp := oWsdl:GetParsedResponse()

// Monta um array com a resposta parseada, considerando
// as quebras de linha ( LF == Chr(10) ) 
aElem := StrTokArr(cResp,chr(10))

nPos := ascan(aElem,{|x| left(x,21) == 'ConversionRateResult:'}) 
If nPos > 0 
 nFator := val( substr(aElem[nPos],22) )
 MsgStop("Fator de conversão: "+cValToChar(nFator),"Requisição Ok")
 MsgStop("Por exemplo, 100 reais compram "+cValToChar(100 * nFator )+" Dólares Americanos.")
Else
 MsgStop("Resposta não encontrada ou inválida.")
Endif

Return

Para utilizar este exemplo, é necessário criar um arquivo para conter o Fonte Client da classe AdvPL gerada, e outro para compilar o fonte que consome esta classe client, e para executar, basta chamar os fontes U_Moedas e U_Moedas2 a partir do SmartClient.

A classe tWSDLManager, embora seja superior em relação ao SOAP, ainda precisa de algumas informações adicionais para se tornar mais prática para uso. Para montar o exemplo acima, foi necessário codificar um fonte um pouco maior, chamando os métodos adicionais da classe para obter os nomes dos serviços publicados, os nomes dos elementos de parâmetro e retorno do serviço desejado, e verificar o formato de retorno parseado para extrair o valor retornado pelo Web Service.

Nos próximos tópicos sobre Web Services, vamos abordar entre outras coisas a utilização de serviços que requerem autenticação e/ou conexão segura (SSL) utilizando chaves criptográficas, e como tratar de forma adequada as falhas que podem ocorrer no lado de uma aplicação client de Web Services.

Conclusão

Este post foi só pra abrir o apetite, têm muito mais a ser explorado neste universo. Mais uma vez, agradeço a todos pela audiência do Blog, e espero vê-los por aqui mais vezes. Até o próximo post, pessoal 😉

Tetris Orientado a Objetos em AdvPL

23/03/201511/11/2018 Júlio Wittwer ADVPL, Jogos, Orientação a Objeto ADVPL, Exemplos, Games, Interface, Orientação a Objetos

Introdução

Nada mais providencial do que ter em mãos um fonte relativamente complexo, escrito utilizando funções e variáveis estáticas e construído totalmente amarrado à camada de interface, para usar de exemplo para aplicar a orientação a objetos.

Tetris em AdvPL

No post sobre o clone do jogo Tetris escrito em AdvPL, ao analisarmos o código-fonte, percebemos que ele se encaixa perfeitamente na introdução deste tópico.

Embora o núcleo do jogo trabalhe com um array de strings contento a representação da tela do jogo, onde cada caractere dentro do array representa um espaço em branco ou um espaço ocupado pela parte de uma peça de uma determinada cor, as funções do jogo que lidam com os eventos de atualização de interface estão amarrados às características e objetos de interface, tanto os resources para a pintura da tela, quando o objeto tTimer, usado para movimentar a peça em jogo uma linha para baixo em intervalos de um segundo.

Utilizando a orientação a objetos, e segmentando um pouco o código, é possível separar boa parte das variáveis e funçoes estáticas em propriedades e métodos de uma classe ApTetris, que será responsável pelo processamento do “core” (ou núcleo) do jogo. E, indo um pouco mais além, podemos desamarrar a interface do jogo, fornecendo algumas propriedades para a classe, para esta ser capaz de chamar as funções apropriadas para compor a interface do jogo quando e como necessário.

Segmentação e refatoração

A primeira parte da refatoração do código foi criar a classe APTetris, transformando todas as variáveis STATIC em propriedades da classe, e praticamente todas as funções STATIC em métodos. Neste primeiro momento, em 10 minutos o jogo já estava operacional novamente, porém as propriedades da classe armazenavam e lidavam diretamente com a pintura da interface.

Num segundo momento, este um pouco mais demorado, os métodos que lidavam estritamente com as tarefas de pintar o grid, score, timer e mensagens do jogo, bem como as mudanças de estado (running, pause, game over), passaram a chamar CodeBlocks para estas tarefas. Cada code-block é chamado em um momento distinto, para atender a um tipo de evento disparado pelo Core do Jogo. Todos os CodeBlocks foram implementados como propriedades da classe principal, e devem ser alimentados após a construção da instância. E, os métodos ligados diretamente a interface voltaram a ser STATIC FUNCTIONS do código, que recebem como parâmetro informações do core do jogo e da interface em uso, para interagir com ela.

Vamos ao código

Após estas duas etapas completas com sucesso, algumas correções na lógica do jogo inicial foram realizadas, commo por exemplo a funçao de “Pause” agora apaga a tela do jogo, para o jogador não se aproveitar da pausa para ficar estudando onde melhor encaixar a peça, entre outros ajustes menores. A última etapa foi isolar as constantes usadas para alguns elementos de arrays e status do core do jogo para um arquivo de #include separado, e a classe do jogo, totalmente desamarrada de interface ser isolada em um código-fonte separado.

O projeto final está no GitHub https://github.com/siga0984/Tetris-OO, que contém os resources (imagens) das pedras, e os fontes “Tetris-OO.PRW” (fonte da interface do jogo para SmartClient), e o fonte “Tetris-Core.prw”, que agora contém apenas o núcleo do jogo, sem a interface. Da mesma forma que o jogo anterior, basta criar um projeto AdvPL no IDE ou TDS, acrescentar os fontes e imagens, compilar e executar. a função U_TetrisOO diretamente a partir do SmartClient.

Segue abaixo o fonte client, responsável pela interface e utilização da classe ApTetris.

#include 'protheus.ch'
#include 'tetris-core.ch'

/* ========================================================
Função U_TETRISOO
Autor Júlio Wittwer
Data 21/03/2015
Versão 1.150321
Descriçao Réplica do jogo Tetris, feito em AdvPL

Remake reescrito a partir do Tetris.PRW, utiliando Orientação a Objetos

Para jogar, utilize as letras :

A ou J = Move esquerda
D ou L = Move Direita
S ou K = Para baixo
W ou I = Rotaciona sentido horario
Barra de Espaço = Dropa a peça

======================================================== */
 
// =======================================================

USER Function TetrisOO()

Local oDlg, oBGGame , oBGNext
Local oFont , oLabel 
Local oScore , oTimer
Local nC , nL
Local oTetris 
Local aBMPGrid 
Local aBMPNext 
Local aResources

// Arrays de componentes e recursos de Interface
aBMPGrid := array(20,10) // Array de bitmaps de interface do jogo 
aBMPNext := array(4,5) // Array de bitmaps da proxima peça
aResources := { "BLACK","YELOW2","LIGHTBLUE2","ORANGE2","RED2","GREEN2","BLUE2","PURPLE2" }

// Fonte default usada na caixa de diálogo 
// e respectivos componentes filhos
oFont := TFont():New('Courier new',,-16,.T.,.T.)

// Interface principal do jogo
DEFINE DIALOG oDlg TITLE "Object Oriented Tetris AdvPL" FROM 10,10 TO 450,365 ;
 FONT oFont COLOR CLR_WHITE,CLR_BLACK PIXEL

// Cria um fundo cinza, "esticando" um bitmap
@ 8, 8 BITMAP oBGGame RESOURCE "GRAY" ;
 SIZE 104,204 Of oDlg ADJUST NOBORDER PIXEL

// Desenha na tela um grid de 20x10 com Bitmaps
// para desenhar o Game

For nL := 1 to 20
 For nC := 1 to 10
 
 @ nL*10, nC*10 BITMAP oBmp RESOURCE "BLACK" ;
 SIZE 10,10 Of oDlg ADJUST NOBORDER PIXEL
 
 aBMPGrid[nL][nC] := oBmp
 
 Next
Next
 
// Monta um Grid 4x4 para mostrar a proxima peça
// ( Grid deslocado 110 pixels para a direita )

@ 8, 118 BITMAP oBGNext RESOURCE "GRAY" ;
 SIZE 54,44 Of oDlg ADJUST NOBORDER PIXEL

For nL := 1 to 4
 For nC := 1 to 5
 
 @ nL*10, (nC*10)+110 BITMAP oBmp RESOURCE "BLACK" ;
 SIZE 10,10 Of oDlg ADJUST NOBORDER PIXEL
 
 aBMPNext[nL][nC] := oBmp
 
 Next
Next

// Label fixo, Pontuação do Jogo 
@ 80,120 SAY oLabel1 PROMPT "[Score]" SIZE 60,20 OF oDlg PIXEL
 
// Label para Mostrar score
@ 90,120 SAY oScore PROMPT " " SIZE 60,120 OF oDlg PIXEL

// Label fixo, Tempo de Jogo
@ 110,120 SAY oLabel2 PROMPT "[Time]" SIZE 60,20 OF oDlg PIXEL
 
// Label para Mostrar Tempo de Jogo
@ 120,120 SAY oElapTime PROMPT " " SIZE 60,120 OF oDlg PIXEL

// Label para Mostrar Status do Jogo 
@ 140,120 SAY oGameMsg PROMPT " " SIZE 60,120 OF oDlg PIXEL

// Botões com atalho de teclado
// para as teclas usadas no jogo
// colocados fora da area visivel da caixa de dialogo

@ 480,10 BUTTON oDummyB0 PROMPT '&A' ACTION ( oTetris:DoAction('A') ) SIZE 1, 1 OF oDlg PIXEL
@ 480,20 BUTTON oDummyB1 PROMPT '&S' ACTION ( oTetris:DoAction('S') ) SIZE 1, 1 OF oDlg PIXEL
@ 480,20 BUTTON oDummyB2 PROMPT '&D' ACTION ( oTetris:DoAction('D') ) SIZE 1, 1 OF oDlg PIXEL
@ 480,20 BUTTON oDummyB3 PROMPT '&W' ACTION ( oTetris:DoAction('W') ) SIZE 1, 1 OF oDlg PIXEL
@ 480,20 BUTTON oDummyB4 PROMPT '&J' ACTION ( oTetris:DoAction('J') ) SIZE 1, 1 OF oDlg PIXEL
@ 480,20 BUTTON oDummyB5 PROMPT '&K' ACTION ( oTetris:DoAction('K') ) SIZE 1, 1 OF oDlg PIXEL
@ 480,20 BUTTON oDummyB6 PROMPT '&L' ACTION ( oTetris:DoAction('L') ) SIZE 1, 1 OF oDlg PIXEL
@ 480,20 BUTTON oDummyB7 PROMPT '&I' ACTION ( oTetris:DoAction('I') ) SIZE 1, 1 OF oDlg PIXEL
@ 480,20 BUTTON oDummyB8 PROMPT '& ' ACTION ( oTetris:DoAction(' ') ) SIZE 1, 1 OF oDlg PIXEL
@ 480,20 BUTTON oDummyB9 PROMPT '&P' ACTION ( oTetris:DoPause() ) SIZE 1, 1 OF oDlg PIXEL

// Inicializa o objeto do core do jogo 
oTetris := APTetris():New()

// Define um timer, para fazer a peça em jogo
// descer uma posição a cada um segundo
// ( Nao pode ser menor, o menor tempo é 1 segundo )
// A ação '#' é diferente de "S" ou "K", pois nao atualiza 
// o score quando a peça está descento "sozinha" por tempo 
oTimer := TTimer():New(1000, {|| oTetris:DoAction('#') }, oDlg )

// Registra evento para atualização de score
// Apos uma ação ser processada pelo objeto Tetris, caso o score 
// tenha mudado, este codeclobk será disparado com o novo score 
oTetris:bShowScore := {|cMsg| oScore:SetText(cMsg) }

// Registra evento para atualização do tempo decorrido de jogo 
// Apos uma ação ser processada pelo objeto Tetris, caso o tempo 
// de jogo tenha mudado, este codeclobk será disparado com o tempo 
// decorrido de jogo atualizado. 
oTetris:bShowElap := {|cMsg| oElapTime:SetText(cMsg) }

// Registra evento de mudança de estado do jogo 
// Running , Pause, Game Over. Caso seja disparado um
// pause ou continue, ou mesmo a última peça nao caber 
// na TEla ( Game Over ), este bloco é disparado, informando o novo 
// estado de jogo 
oTetris:bChangeState := {|nStat| GameState( nStat , oTimer , oGameMsg ) }

// Registra evento de pintura do grid 
// Apos processamento de ação, caso o grid precise ser repintado, 
// este bloco de código será disparado
oTetris:bPaintGrid := {|aGameGrid| PaintGame( aGameGrid, aBmpGrid , aResources ) }

// Registra evento de pintura da proxima peça 
// Apos processamento de ação, caso seja sorteada uma nova próxima peça, 
// este bloco de código será disparado para pintar a proxima peça na interface
oTetris:bPaintNext := {|aNextPiece| PaintNext(aNextPiece, aBMPNext, aResources) }

// Na inicialização do Dialogo, começa o jogo 
oDlg:bInit := {|| oTetris:Start() }

ACTIVATE DIALOG oDlg CENTER

Return

/* -------------------------------------------------------
Notificação de mudança de estado de jogo
GAME_RUNNING, GAME_PAUSED ou GAME_OVER
------------------------------------------------------- */

STATIC Function GameState( nStat , oTimer , oGameMsg ) 
Local cMsg

If nStat == GAME_RUNNING

// Jogo em execuçao, ativa timer de interface
 oTimer:Activate()

cMsg := "*********"+CRLF+;
 "* PLAY *"+CRLF+;
 "*********"

ElseIf nStat == GAME_PAUSED

// Jogo em pausa
 // desativa timer de interface 
 oTimer:DeActivate()
 
 // e acrescenta mensagem de pausa
 cMsg := "*********"+CRLF+;
 "* PAUSE *"+CRLF+;
 "*********"

ElseIf nStat == GAME_OVER

// Game Over
 // desativa timer de interface 
 oTimer:DeActivate()

// e acresenta a mensagem de "GAME OVER"
 cMsg := "********"+CRLF+;
 "* GAME *"+CRLF+; 
 "********"+CRLF+;
 "* OVER *"+CRLF+;
 "********"

Endif

// Atualiza a mensagem na interface
oGameMsg:SetText(cMsg)

Return

/* ----------------------------------------------------------
Função PaintGame()
Pinta o Grid do jogo da memória para a Interface
Chamada pelo objeto Tetris via code-block
Optimizada para apenas trocar os resources diferentes
---------------------------------------------------------- */

STATIC Function PaintGame( aGameGrid, aBmpGrid , aResources ) 
Local nL, nc , cLine, nPeca

For nL := 1 to 20
 cLine := aGameGrid[nL+1]
 For nC := 1 to 10
 nPeca := val(substr(cLine,nC+2,1))
 If aBmpGrid[nL][nC]:cResName != aResources[nPeca+1]
 // Somente manda atualizar o bitmap se houve
 // mudança na cor / resource desta posição
 aBmpGrid[nL][nC]:SetBmp(aResources[nPeca+1])
 endif
 Next
Next

Return

/* -----------------------------------------------------------------
Pinta na interface a próxima peça a ser usada no jogo 
Chamada pelo objeto Tetris via code-block
Optimizada para apenas trocar os resources diferentes
----------------------------------------------------------------- */

STATIC Function PaintNext(aNext,aBMPNext,aResources) 
Local nL, nC, cLine , nPeca

For nL := 1 to 4
 cLine := aNext[nL]
 For nC := 1 to 5
 nPeca := val(substr(cLine,nC,1))
 If aBMPNext[nL][nC]:cResName != aResources[nPeca+1]
 aBMPNext[nL][nC]:SetBmp(aResources[nPeca+1])
 endif
 Next
Next

Return

E, agora segue abaixo o fonte Tetris-Core.PRW, que contém a classe core do clone do Tetris.

#include 'protheus.ch' 
#include 'tetris-core.ch'

// ============================================================================
// Classe "CORE" do Jogo Tetris
// ============================================================================

CLASS APTETRIS
 
 // Propriedades publicas
 
 DATA aGamePieces // Peças que compoe o jogo 
 DATA nGameStart // Momento de inicio de jogo 
 DATA nGameTimer // Tempo de jogo em segundos
 DATA nGamePause // Controle de tempo de pausa
 DATA nNextPiece // Proxima peça a ser usada
 DATA nGameStatus // 0 = Running 1 = PAuse 2 == Game Over
 DATA aNextPiece // Array com a definição e posição da proxima peça
 DATA aGameCurr // Array com a definição e posição da peça em jogo
 DATA nGameScore // pontuação da partida
 DATA aGameGrid // Array de strings com os blocos da interface representados em memoria

// Eventos disparados pelo core do Jogo 
 
 DATA bShowScore // CodeBlock para interface de score 
 DATA bShowElap // CodeBlock para interface de tempo de jogo 
 DATA bChangeState // CodeBlock para indicar mudança de estado ( pausa / continua /game over )
 DATA bPaintGrid // CodeBlock para evento de pintura do Grid do Jogo
 DATA bPaintNext // CodeBlock para evento de pintura da Proxima peça em jogo
 
 // Metodos Publicos
 
 METHOD New() // Construtor
 METHOD Start() // Inicio de Jogo
 METHOD DoAction(cAct) // Disparo de ações da Interface
 METHOD DoPause() // Dispara Pause On/Off

// Metodos privados ( por convenção, prefixados com "_" )

METHOD _LoadPieces() // Carga do array de peças do Jogo 
 METHOD _MoveDown() // Movimenta a peça corrente uma posição para baixo
 METHOD _DropDown() // Movimenta a peça corrente direto até onde for possível
 METHOD _SetPiece(aPiece,aGrid) // Seta uma peça no Grid em memoria do jogo 
 METHOD _DelPiece(aPiece,aGrid) // Remove uma peça no Grid em memoria do jogo 
 METHOD _FreeLines() // Verifica e eliminha linhas totalmente preenchidas 
 METHOD _GetEmptyGrid() // Retorna um Grid em memoria inicializado vazio

ENDCLASS

/* ----------------------------------------------------------
Construtor da classe
---------------------------------------------------------- */

METHOD NEW() CLASS APTETRIS

::aGamePieces := ::_LoadPieces()
::nGameTimer := 0
::nGameStart := 0
::aNextPiece := {}
::aGameCurr := {}
::nGameScore := 0
::aGameGrid := {}
::nGameStatus := GAME_RUNNING

Return self

/* ----------------------------------------------------------
Inicializa o Grid na memoria
Em memoria, o Grid possui 14 colunas e 22 linhas
Na tela, são mostradas apenas 20 linhas e 10 colunas
As 2 colunas da esquerda e direita, e as duas linhas a mais
sao usadas apenas na memoria, para auxiliar no processo
de validação de movimentação das peças.
---------------------------------------------------------- */

METHOD Start() CLASS APTETRIS
Local aDraw, nPiece, cScore

// Inicializa o grid de imagens do jogo na memória
// Sorteia a peça em jogo
// Define a peça em queda e a sua posição inicial
// [ Peca, rotacao, linha, coluna ]
// e Desenha a peça em jogo no Grid
// e Atualiza a interface com o Grid

// Inicializa o grid do jogo "vazio"
::aGameGrid := aClone(::_GetEmptyGrid())

// Sorteia peça em queda do inicio do jogo
nPiece := randomize(1,len(::aGamePieces)+1)

// E coloca ela no topo da tela
::aGameCurr := {nPiece,1,1,6}
::_SetPiece(::aGameCurr,::aGameGrid)

// Dispara a pintura do Grid do Jogo
Eval( ::bPaintGrid , ::aGameGrid)

// Sorteia a proxima peça e desenha
// ela no grid reservado para ela
::aNextPiece := array(4,"00000")
::nNextPiece := randomize(1,len(::aGamePieces)+1)

aDraw := {::nNextPiece,1,1,1}
::_SetPiece(aDraw,::aNextPiece)

// Dispara a pintura da próxima peça
Eval( ::bPaintNext , ::aNextPiece )

// Marca timer do inicio de jogo
::nGameStart := seconds()

// Chama o codeblock de mudança de estado - Jogo em execução
Eval(::bChangeState , ::nGameStatus )

// E chama a pintura do score inicial 
cScore := str(::nGameScore,7)
Eval( ::bShowScore , cScore )

Return

/* ----------------------------------------------------------
Recebe uma ação de movimento de peça, e realiza o movimento
da peça corrente caso exista espaço para tal.
---------------------------------------------------------- */
METHOD DoAction(cAct) CLASS APTETRIS
Local aOldPiece
Local cScore, cElapTime 
Local cOldScore, cOldElapTime

If ::nGameStatus != GAME_RUNNING
 // Jogo não está rodando, nao aceita ação nenhuma
 Return .F. 
Endif

// Pega pontuação e tempo decorridos agora 
cOldScore := str(::nGameScore,7)
cOldElapTime := STOHMS(::nGameTimer)

// Clona a peça em queda
aOldPiece := aClone(::aGameCurr)

if cAct $ 'AJ'
 
 // Movimento para a Esquerda (uma coluna a menos)
 // Remove a peça do grid
 ::_DelPiece(::aGameCurr,::aGameGrid)
 ::aGameCurr[PIECE_COL]--
 If !::_SetPiece(::aGameCurr,::aGameGrid)
 // Se nao foi feliz, pinta a peça de volta
 ::aGameCurr := aClone(aOldPiece)
 ::_SetPiece(::aGameCurr,::aGameGrid)
 Endif
 
Elseif cAct $ 'DL'
 
 // Movimento para a Direita ( uma coluna a mais )
 // Remove a peça do grid
 ::_DelPiece(::aGameCurr,::aGameGrid)
 ::aGameCurr[PIECE_COL]++
 If !::_SetPiece(::aGameCurr,::aGameGrid)
 // Se nao foi feliz, pinta a peça de volta
 ::aGameCurr := aClone(aOldPiece)
 ::_SetPiece(::aGameCurr,::aGameGrid)
 Endif
 
Elseif cAct $ 'WI'
 
 // Movimento para cima ( Rotaciona sentido horario )
 
 // Remove a peça do Grid
 ::_DelPiece(::aGameCurr,::aGameGrid)
 
 // Rotaciona a peça 
 ::aGameCurr[PIECE_ROTATION]--
 If ::aGameCurr[PIECE_ROTATION] < 1
 ::aGameCurr[PIECE_ROTATION] := len(::aGamePieces[::aGameCurr[PIECE_NUMBER]])-1
 Endif
 
 If !::_SetPiece(::aGameCurr,::aGameGrid)
 // Se nao consegue colocar a peça no Grid
 // Nao é possivel rotacionar. Pinta a peça de volta
 ::aGameCurr := aClone(aOldPiece)
 ::_SetPiece(::aGameCurr,::aGameGrid)
 Endif
 
ElseIF cAct $ 'SK#'
 
 // Desce a peça para baixo uma linha intencionalmente
 ::_MoveDown()
 
 If cAct $ 'SK'
 // se o movimento foi intencional, ganha + 1 ponto
 ::nGameScore++
 Endif
 
ElseIF cAct == ' '
 
 // Dropa a peça - empurra para baixo até a última linha
 // antes de bater a peça no fundo do Grid. Isto vai permitir
 // movimentos laterais e roração, caso exista espaço

If !::_DropDown()
 // Se nao tiver espaço para o DropDown, faz apenas o MoveDown 
 // e "assenta" a peça corrente
 ::_MoveDown()
 Endif
 
Else

UserException("APTETRIS:DOACTION() ERROR: Unknow Action ["+cAct+"]")
 
Endif

// Dispara a repintura do Grid
Eval( ::bPaintGrid , ::aGameGrid)

// Calcula tempo decorrido
::nGameTimer := seconds() - ::nGameStart
 
If ::nGameTimer < 0
 // Ficou negativo, passou da meia noite
 ::nGameTimer += 86400
Endif

// Pega Score atualizado e novo tempo decorrido
cScore := str(::nGameScore,7)
cElapTime := STOHMS(::nGameTimer)

If ( cOldScore <> cScore ) 
 // Dispara o codeblock que atualiza o score
 Eval( ::bShowScore , cScore )
Endif

If ( cOldElapTime <> cElapTime ) 
 // Dispara atualizaçao de tempo decorrido
 Eval( ::bShowElap , cElapTime )
Endif

Return .T.

/* ----------------------------------------------------------
Coloca e retira o jog em pausa
Este metodo foi criado isolado, pois é o unico 
que poderia ser chamado dentro de uma pausa
---------------------------------------------------------- */
METHOD DoPause() CLASS APTETRIS
Local lChanged := .F.
Local nPaused
Local cElapTime 
Local cOldElapTime

cOldElapTime := STOHMS(::nGameTimer)

If ::nGameStatus == GAME_RUNNING
 // Jogo em execução = Pausa : Desativa o timer
 lChanged := .T.
 ::nGameStatus := GAME_PAUSED
 ::nGamePause := seconds()
ElseIf ::nGameStatus == GAME_PAUSED
 // Jogo em pausa = Sai da pausa : Ativa o timer
 lChanged := .T.
 ::nGameStatus := GAME_RUNNING
 // Calcula quanto tempo o jogo ficou em pausa
 // e acrescenta esse tempo do start do jogo
 nPaused := seconds()-::nGamePause
 If nPaused < 0
 nPaused += 86400
 Endif
 ::nGameStart += nPaused
Endif

If lChanged
 
 // Chama o codeblock de mudança de estado - Entrou ou saiu de pausa
 Eval(::bChangeState , ::nGameStatus )
 
 If ::nGameStatus == GAME_PAUSED
 // Em pausa, Dispara a pintura do Grid do Jogo vazio
 Eval( ::bPaintGrid , ::_GetEmptyGrid() )
 Else
 // Game voltou da pausa, pinta novamente o Grid
 Eval( ::bPaintGrid , ::aGameGrid)
 Endif
 
 // Calcula tempo de jogo sempre ao entrar ou sair de pausa
 ::nGameTimer := seconds() - ::nGameStart
 
 If ::nGameTimer < 0
 // Ficou negativo, passou da meia noite
 ::nGameTimer += 86400
 Endif

// Pega novo tempo decorrido
 cElapTime := STOHMS(::nGameTimer)

If ( cOldElapTime <> cElapTime ) 
 // Dispara atualizaçao de tempo decorrido
 Eval( ::bShowElap , cElapTime )
 Endif

Endif

Return

/* ----------------------------------------------------------
Metodo SetGridPiece
Aplica a peça informada no array do Grid.
Retorna .T. se foi possivel aplicar a peça na posicao atual
Caso a peça não possa ser aplicada devido a haver
sobreposição, a função retorna .F. e o grid não é atualizado
Serve tanto para o Grid do Jogo quando para o Grid da próxima peça
---------------------------------------------------------- */

METHOD _SetPiece(aPiece,aGrid) CLASS APTETRIS
Local nPiece := aPiece[PIECE_NUMBER] // Numero da peça
Local nRotate := aPiece[PIECE_ROTATION] // Rotação
Local nRow := aPiece[PIECE_ROW] // Linha no Grid
Local nCol := aPiece[PIECE_COL] // Coluna no Grid
Local nL , nC
Local aTecos := {}
Local cTecoGrid, cPeca , cPieceId

conout("_SetPiece on COL "+cValToChar(nCol))

cPieceId := str(nPiece,1)

For nL := nRow to nRow+3
 cPeca := ::aGamePieces[nPiece][1+nRotate][nL-nRow+1]
 If nL > len(aGrid) 
 // Se o grid acabou, verifica se o teco 
 // da peça tinha alguma coisa a ser ligada
 // Se tinha, nao cabe, se não tinha, beleza
 If '1' $ cPeca 
 Return .F.
 Else
 EXIT
 Endif
 Endif
 cTecoGrid := substr(aGrid[nL],nCol,4)
 For nC := 1 to 4
 If Substr(cPeca,nC,1) == '1'
 If SubStr(cTecoGrid,nC,1) != '0'
 // Vai haver sobreposição,
 // a peça nao cabe ...
 Return .F.
 Endif
 cTecoGrid := Stuff(cTecoGrid,nC,1,cPieceId)
 Endif
 Next
 // Array temporario com a peça já colocada
 aadd(aTecos,cTecoGrid)
Next

// Aplica o array temporario no array do grid
For nL := nRow to nRow+len(aTecos)-1
 aGrid[nL] := stuff(aGrid[nL],nCol,4,aTecos[nL-nRow+1])
Next

// A peça "coube", retorna .T.
Return .T.

/* -----------------------------------------------------------------
Carga do array de peças do jogo
Array multi-dimensional, contendo para cada
linha a string que identifica a peça, e um ou mais
arrays de 4 strings, onde cada 4 elementos
representam uma matriz binaria de caracteres 4x4
para desenhar cada peça

Exemplo - Peça "O"

aLPieces[1][1] C "O"
aLPieces[1][2][1] "0000"
aLPieces[1][2][2] "0110"
aLPieces[1][2][3] "0110"
aLPieces[1][2][4] "0000"

----------------------------------------------------------------- */

METHOD _LoadPieces() CLASS APTETRIS
Local aLPieces := {}

// Peça "O" , uma posição
aadd(aLPieces,{'O', { '0000','0110','0110','0000'}})

// Peça "I" , em pé e deitada
aadd(aLPieces,{'I', { '0000','1111','0000','0000'},;
 { '0010','0010','0010','0010'}})

// Peça "S", em pé e deitada
aadd(aLPieces,{'S', { '0000','0011','0110','0000'},;
 { '0010','0011','0001','0000'}})

// Peça "Z", em pé e deitada
aadd(aLPieces,{'Z', { '0000','0110','0011','0000'},;
 { '0001','0011','0010','0000'}})

// Peça "L" , nas 4 posições possiveis
aadd(aLPieces,{'L', { '0000','0111','0100','0000'},;
 { '0010','0010','0011','0000'},;
 { '0001','0111','0000','0000'},;
 { '0110','0010','0010','0000'}})

// Peça "J" , nas 4 posições possiveis
aadd(aLPieces,{'J', { '0000','0111','0001','0000'},;
 { '0011','0010','0010','0000'},;
 { '0100','0111','0000','0000'},;
 { '0010','0010','0110','0000'}})

// Peça "T" , nas 4 posições possiveis
aadd(aLPieces,{'T', { '0000','0111','0010','0000'},;
 { '0010','0011','0010','0000'},;
 { '0010','0111','0000','0000'},;
 { '0010','0110','0010','0000'}})

Return aLPieces

/* ----------------------------------------------------------
Função _MoveDown()

Movimenta a peça em jogo uma posição para baixo.
Caso a peça tenha batido em algum obstáculo no movimento
para baixo, a mesma é fica e incorporada ao grid, e uma nova
peça é colocada em jogo. Caso não seja possivel colocar uma
nova peça, a pilha de peças bateu na tampa -- Game Over

---------------------------------------------------------- */

METHOD _MoveDown() CLASS APTETRIS
Local aOldPiece
Local nMoved := 0

If ::nGameStatus != GAME_RUNNING
 Return
Endif

// Clona a peça em queda na posição atual
aOldPiece := aClone(::aGameCurr)

// Primeiro remove a peça do Grid atual
::_DelPiece(::aGameCurr,::aGameGrid)

// Agora move a peça apenas uma linha pra baixo
::aGameCurr[PIECE_ROW]++

// Recoloca a peça no Grid
If ::_SetPiece(::aGameCurr,::aGameGrid)
 
 // Nao bateu em nada, beleza. 
 // Retorna aqui mesmo 
 Return
 
Endif

// Opa ... Esbarrou em alguma peça ou fundo do grid
// Volta a peça pro lugar anterior e recoloca a peça no Grid
::aGameCurr := aClone(aOldPiece)
::_SetPiece(::aGameCurr,::aGameGrid)

// Encaixou uma peça .. Incrementa o score em 4 pontos
// Nao importa a peça ou como ela foi encaixada
::nGameScore += 4

// Verifica apos a pea encaixada, se uma ou mais linhas
// foram preenchidas e podem ser eliminadas
::_FreeLines()

// Pega a proxima peça e coloca em jogo
nPiece := ::nNextPiece
::aGameCurr := {nPiece,1,1,6} // Peca, direcao, linha, coluna

If !::_SetPiece(::aGameCurr,::aGameGrid)
 
 // Acabou, a peça nova nao entra (cabe) no Grid
 // "** GAME OVER** "
 ::nGameStatus := GAME_OVER
 
 // Chama o codeblock de mudança de estado - Game Over
 Eval(::bChangeState , ::nGameStatus )
 
 // E retorna aqui mesmo
 Return
 
Endif

// Inicializa proxima peça em branco
::aNextPiece := array(4,"00000")

// Sorteia a proxima peça que vai cair
::nNextPiece := randomize(1,len(::aGamePieces)+1)
::_SetPiece( {::nNextPiece,1,1,1} , ::aNextPiece)

// Dispara a pintura da próxima peça
Eval( ::bPaintNext , ::aNextPiece )

// e retorna para o processamento de ações

Return

METHOD _DropDown() CLASS APTETRIS
Local aOldPiece
Local nMoved := 0

If ::nGameStatus != GAME_RUNNING
 Return .F.
Endif

// Clona a peça em queda na posição atual
aOldPiece := aClone(::aGameCurr)

// Dropa a peça até bater embaixo
// O Drop incrementa o score em 1 ponto
// para cada linha percorrida. Quando maior a quantidade
// de linhas vazias, maior o score acumulado com o Drop

// Remove a peça do Grid atual
::_DelPiece(::aGameCurr,::aGameGrid)

// Desce uma linha pra baixo
::aGameCurr[PIECE_ROW]++

While ::_SetPiece(::aGameCurr,::aGameGrid)
 
 // Peça desceu mais uma linha
 // Incrementa o numero de movimentos dentro do Drop
 nMoved++

// Incrementa o Score
 ::nGameScore++

// Remove a peça da interface
 ::_DelPiece(::aGameCurr,::aGameGrid)
 
 // Guarda a peça na posição atual
 aOldPiece := aClone(::aGameCurr)
 
 // Desce a peça mais uma linha pra baixo
 ::aGameCurr[PIECE_ROW]++
 
Enddo

// Volta a peça na última posição válida, 
::aGameCurr := aClone(aOldPiece)
::_SetPiece(::aGameCurr,::aGameGrid)
 
// Se conseguiu mover a peça com o Drop
// pelo menos uma linha, retorna .t. 
Return (nMoved > 0)

/* -----------------------------------------------------------------------
Remove a peça informada do grid informado
----------------------------------------------------------------------- */
METHOD _DelPiece(aPiece,aGrid) CLASS APTETRIS

Local nPiece := aPiece[PIECE_NUMBER]
Local nRotate := aPiece[PIECE_ROTATION]
Local nRow := aPiece[PIECE_ROW]
Local nCol := aPiece[PIECE_COL]
Local nL, nC
Local cTecoGrid, cTecoPeca

// Como a matriz da peça é 4x4, trabalha em linhas e colunas
// Separa do grid atual apenas a área que a peça está ocupando
// e desliga os pontos preenchidos da peça no Grid.
// Esta função não verifica se a peça que está sendo removida
// é a correta, apenas apaga do grid os pontos ligados que
// a peça informada ocupa nas coordenadas especificadas

For nL := nRow to nRow+3
 cTecoPeca := ::aGamePieces[nPiece][1+nRotate][nL-nRow+1]
 If nL > len(aGrid)
 // O Grid acabou, retorna
 Return
 Endif
 cTecoGrid := substr(aGrid[nL],nCol,4)
 For nC := 1 to 4
 If Substr(cTecoPeca,nC,1)=='1'
 cTecoGrid := Stuff(cTecoGrid,nC,1,'0')
 Endif
 Next
 aGrid[nL] := stuff(aGrid[nL],nCol,4,cTecoGrid)
Next

Return

/* -----------------------------------------------------------------------
Verifica e elimina as linhas "completas"
após uma peça ser encaixada no Grid
----------------------------------------------------------------------- */
METHOD _FreeLines() CLASS APTETRIS
Local nErased := 0
Local cTecoGrid

For nL := 21 to 2 step -1
 
 // Sempre varre de baixo para cima
 cTecoGrid := substr(::aGameGrid[nL],3)
 
 If !('0'$cTecoGrid)
 // Se a linha nao tem nenhum espaço em branco
 // Elimina esta linha e acrescenta uma nova linha
 // em branco no topo do Grid
 adel(::aGameGrid,nL)
 ains(::aGameGrid,1)
 ::aGameGrid[1] := GRID_EMPTY_LINE
 nL++
 nErased++
 Endif
 
Next

// Pontuação por linhas eliminadas
// Quanto mais linhas ao mesmo tempo, mais pontos
If nErased == 4
 ::nGameScore += 100
ElseIf nErased == 3
 ::nGameScore += 50
ElseIf nErased == 2
 ::nGameScore += 25
ElseIf nErased == 1
 ::nGameScore += 10
Endif

Return

/* ------------------------------------------------------
Retorna um grid de jogo vazio / inicializado
O Grid no core do tetris contem 21 linhas por 14 colunas
As limitações nas laterais esquerda e direita para 
facilitar os algoritmos para fazer a manutenção no Grid 
A área visivel nas colunas do Grid está indicada usando 
"." Logo, mesmo que o grid em memoria 
tenha 21x14, o grid de bitmaps de interface tem apenas 20x10, 
a partir da coordenada 2,3 ( linha,coluna ) do Grid do Jogo

"11000000000011" -- Primeira linha, não visivel 
"11..........11" -- demais 20 linhas, visiveis da coluna 2 a 11

------------------------------------------------------ */
METHOD _GetEmptyGrid() CLASS APTETRIS
Local aEmptyGrid 
aEmptyGrid := array(21,GRID_EMPTY_LINE)
Return aEmptyGrid

/* ------------------------------------------------------
Função auxiliar de conversão de segundos para HH:MM:SS
------------------------------------------------------ */

STATIC Function STOHMS(nSecs)
Local nHor
Local nMin

nHor := int(nSecs/3600)
nSecs -= (3600*nHor)

nMin := int(nSecs/60)
nSecs -= (60*nMin)

Return strzero(nHor,2)+':'+Strzero(nMin,2)+':'+strzero(nSecs,2)

Conclusão

A implementação realizada poderia ser mais refinada ou flexível, mas atende a esta necessidade. Uma outra alternativa interessante, ao invés de criar vários CodeBlocks, um para cada evento, seria criar apenas um CodeBlock e passar ele em uma propriedade da classe, e através dele fazer todas as chamadas de interface, passando como parâmetros a instância do jogo (self), um código para indicar qual evento está sendo disparado, e um ou mais parâmetros especificos do evento. Neste caso, o fonte de interface teria que construir uma função única de “CallBack”, onde dentro dela cada evento seria tratado em um DO CASE…END CASE, por exemplo.

Agora, dêem uma olhada no código antigo, todo “amarrado”, e no código novo. Pra mim é visivelmente mais fácil dar manutenção no código orientado a objetos do que no código procedural, pois cada coisa está visivelmente em seu lugar, e cada parte do código têm a sua responsabilidade e atribuições bem definidas. Espero que vocês tirem proveito da orientação a objeto, com tanta satisfação como a que eu tenho em escrever estes códigos !!

Até o próximo post, pessoal 😉 E obrigado pela audiência 😀

Classes em Advpl – Parte 04

06/12/201411/11/2018 Júlio Wittwer ADVPL, Orientação a Objeto ADVPL, Boas Práticas, Classes, Orientação a Objetos

E, para finalizar a a introdução do tópico “Classes em Advpl”, hoje vamos abordar algumas boas práticas da orientação a objeto, com foco no uso com ADVPL.

Simplicidade

A correta representação do domínio do problema deve ser simples, mesmo para um problema complexo. Por exemplo, fazer um jogo de damas ou xadrez no computador pode parecer algo muito complexo, certo ? Com apenas uma classe de tabuleiro, uma classe de jogador, uma classe base (ou abstrata) para uma peça genérica, e uma classe para cada peça do tabuleiro, onde a instância de tabuleiro é responsável por fazer a interface com o usuário e permitir ele mover uma peça de um lugar de origem para um lugar de destino, eu garanto que fica mais simples. A interface recebe o input do jogador, e aciona o método de mover peça do tabuleiro, que verifica se tem uma peça na posição de origem, e chama um método da peça para listar as posições válidas para onde a peça pode ser movida. Cada objeto tem a sua camada de inteligência (métodos) e validações.

A implementação feita desta forma fica isolada em cada peça, afinal você precisa escrever apenas um método para cada peça para determinar as posições possiveis de movimento a partir do tabuleiro em um determinado estado, onde um metodo do tabuleiro se encarrega de varrer a lista de peças em jogo de um dos jogadores e perguntar para cada uma para onde ela pode mover-se. Com isso é mais fácil implementar a mecânica dos movimentos das peças, e até um mecanismo de projeção de movimentos possíveis do adversário.

Nível de abstração e herança adequadas

Quanto maior o detalhamento que você precisa, maior será a quantidade de classes e propriedades necessárias para lhe atender. Atenha-se ao que você precisa, e de forma ordenada. Por exemplo, ao prototipar três classes, A , B, e C, onde B e C herdam A, na classe superior (A) você deve colocar propriedades que são comuns a todas as classes da herança, e nas classes filhas apenas as propriedades e métodos específicos que somente caberiam na instância da classe filha, permanecendo os métodos comuns na classe pai. Muitas vezes implementamos uma herança sem ter propriedades específicas, mas implementações de métodos com comportamentos diferenciados por instância.

Destrutores e limpeza de memória

Uma instância de uma classe na linguagem ADVPL não possui declaração explícita de métodos destrutores, porém o kernel do ADVPL realiza um controle de reaproveitamento de memória da instância da classe, e mantém a instância na memória, mesmo que ela não seja mais referenciável, apenas eliminando a memória consumida pela instância quando a função que cria a instância da classe é chamado e cria uma nova instância. A memória ocupada pela instância envolve todas as propriedades da instância.

Logo, é elegante e saudável para a memória você criar um método “CleanUp” na classe para limpar as propriedades que não estão sendo mais referenciadas desta instância, uma vez que a mesma não seja mais necessária, e após chamar o CleanUp() da instância, você executa a função FreeObj(), passando a variável que contém a instância como parâmetro.

Se você executar um FreeObj() em uma instância de classe ADVPL, mas ela ainda estava sendo referenciada em uma ou mais varíaveis ou propriedades de outras classes, automaticamente estas referências tornam-se nulas (NIL). Caso algum programa tente acessá-las, será gerada uma ocorrência de erro “Variable is not an object”.

A função FreeObj() também serve para eliminar uma classe da interface visual do Advpl. Neste caso, muito cuidado com o seu uso, pois se você por exemplo executar um FreeObj() em uma instância de tWindow, tDialog, tPanel, ou qualquer instância de container de interface, que está ativa na tela e na pilha de execuções, você pode provocar uma invasão de memória ( Access Violation ou Segment Fault ).

A dica de limpeza vale também para funções em Advpl, onde as variáveis locais daquela execução permanecem alocadas na memória, somente sendo desalocadas em uma próxima execução da função. Por exemplo, uma função de processamento intermediário cria um array local dentro do fonte, e popula este array para fazer um cálculo. Se o retorno desta função não for o próprio array, o conteúdo alocado na memória pelos elementos não será necessário e nem acessível quando a função retornar o valor calculado, mas a área de memória ocupada vai permanecer alocada. Neste caso, você deve limpar o array, usando a função de redimensionamento de array da seguinte forma: aSize(aVarArray,0) — onde aVarArray é a variável que contém o array a ser limpo.

Caso as propriedades da classe apontem para arrays de outros objetos, que estão compartilhados com outros componentes e não exatamente devem ser destruídos, é interessante e elegante que você atribua NIL nestas propriedades, para elas deixarem de referenciar os arrays e objetos em questão.

Performance

Existe um overhead na performance na chamada de um método, em comparação com a chamada de uma função. Fiz um teste de performance de chamadas de uma função e de um método de classe, onde a função e a classe realizam um processamento – o retorno de um valor constante. O loop de processamento demorou em média 1,5 segundos para chamar um milhão de vezes uma função, e demorou 3,8 segundos para chamar um milhão de vezes um método. Parece uma grande diferença, certo ? Bem, estamos falando aqui de 666 mil RPS(requisições por segundo) de função, contra 263 mil RPS em chamadas de método, usando uma CPU de 1.8 GHZ.

Lembre-se da Lei de Amdahl, já mencionada aqui em outra postagem sobre escalabilidade e performance: “O ganho de desempenho que pode ser obtido melhorando uma determinada parte do sistema é limitado pela fração de tempo que essa parte é utilizada pelo sistema durante a sua operação.” Logo, a relevância do tempo em uma etapa específica de um processo somente é perceptível caso ela seja representativa no tempo total do processo.

Por exemplo, em uma rotina de processamento onde os métodos realizam tarefas, decisões e manipulações de dados e propriedades, e podem acessar banco de dados ou informações no disco, o tempo de processamento do método vai ser muito maior do que o tempo da chamada. Ao calcularmos o tempo total de processamento de 1 milhão de requisições de um determinado método, onde cada requisição demora em média 1/10 de segundo, serão 166 minutos (duas horas e 46 minutos) de processamento, mais quatro segundos do tempo gasto com as chamadas dos métodos. Se este loop fosse feito com chamadas de função, acrescentaríamos ao tempo total apenas 1,5 segundo. Esta diferença de tempo, em um processo de 166 minutos, não quer dizer nada.

Este overhead somente torna-se significativo quando os métodos são extremamente curtos, como por exemplo operações aritméticas ou apenas encapsulamento para retorno de propriedades. E mesmo assim, são necessárias milhões de requisições para isso tornar-se perceptível.

Conclusão

A orientação a objetos é um paradigma muito interessante de ser explorado, mas como toda a solução em tecnologia da informação, existem casos onde uma abordagem com funções pode ser mais interessante, até mesmo dentro do mesmo aplicativo. Prevalece sempre a análise de caso, use um paradigma ou abordagem para resolver os problemas onde ela apresenta a melhor relação custo x benefício.

Posteriormente eu devo voltar no tema de orientação a objetos, focando mais em exemplos práticos e casos de uso em ADVPL.

Até o próximo post, pessoal 😉