Protheus e FTP Client – Parte 03

Introdução

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

O Programa

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

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

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

Entrada

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

aLList := GetLFiles(cLPath,@aLFiles)

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

oLbxLeft:ALIGN := CONTROL_ALIGN_ALLCLIENT

aRList := {}

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

oLbxRight:ALIGN := CONTROL_ALIGN_ALLCLIENT

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

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

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

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

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

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

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

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

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

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

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

// Insere as opções de Menu

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

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

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

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

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

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

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

// Posiciona no primeiro arquivo
oLbxLeft:Gotop()

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

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

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

Return

Estrutura da Interface

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

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

FTP Client 1

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

FTP Client 2

Menu Local

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

FTP Client 3

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

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

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

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

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

Return

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

Menu FTP

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

FTP Client 4

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

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

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

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

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

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

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

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

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

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

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

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

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

ACTIVATE DIALOG oDlgConn CENTER

If lGo

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

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

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

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

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

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

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

  Else

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

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

  oLbxRight:GoTop()
  oPRight:Refresh()

Endif

Return

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

Navegação e Funções

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

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

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

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

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

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

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

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

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

Pulos do Gato

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

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

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

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

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

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

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

Return

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

hHndFocus := GETFOCUS()

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

If hHndFocus == oLbxLeft:HWND

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

Detalhes dos Arquivos em Foco

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

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

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


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

Conclusão

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

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

Referências

 

Protheus e FTP Client

Introdução

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

Protocolos FTP, FTPS e SFTP

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

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

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

Classe TFTPClient

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

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

Funcionalidades

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

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

Exemplo AdvPL

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

#include 'protheus.ch'

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

SET DATE BRITISH
SET CENTURY ON

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

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

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

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

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

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

Observações

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

Conclusão

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

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

Referências

 

 

CRUD em AdvPL – Parte 15

Introdução

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

Reaproveitamento de Código

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

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

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

Escopo e Chamada de Funções

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

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

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

Escopo de Classes AdvPL

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

De volta ao reaproveitamento

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

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

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

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

Funções OpenDB() e CloseDB()

Vamos ver como eram estas funções:

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

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

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

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

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

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

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

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

Reaproveitando mais …

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

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

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

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

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

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

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

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

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

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

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

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

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

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

DbSetOrder(1)
DbGoTop()

// Solta o MUTEX
GlbNmUnlock(cLockId)

Return .T.

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

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

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

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

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

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

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

Return lOk

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

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

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

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

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

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

Return lOk

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

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

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

Conclusão

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

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

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

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

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

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

 

CRUD em AdvPL – Parte 14

Introdução

No post anterior, criamos um programa para servir de “Menu” para a Agenda e outras funcionalidades a serem criadas pela aplicação. Porém, não foi colocada nenhuma proteção para a execução do programa — Controle de Acesso ou similar. Vamos ver como fazer isso de forma segura e elegante, e ver alguns parágrafos sobre Segurança da Informação.

Controle de Acesso

Quando pensamos em restringir o acesso a uma determinada informação, precisamos avaliar o quão importante é a informação em si, e o quão desastroso seria se outra pessoa — além de você — tivesse acesso a esta informação. Determinado este fator, e ele sendo considerado de alta importância, precisamos ver quais são as formas ou caminhos de acesso a informação que podem ser utilizadas, e não apenas como protegê-las, mas o custo disso.

Quando me refiro a custo, não necessariamente estou falando de dinheiro, mas em custo de implementação — em horas — e custo de acesso a informação — desempenho da aplicação ser diminuída em virtude das barreiras de segurança. Um outro fator também importante é “Quanto vai me custar se eu perder a informação ?!” — já este aspecto também é tratado na Segurança da Informação, pois mesmo que a informação não tenha valor para outra pessoa, para você ela deve ter.

E você está sujeito a perder seus dados de várias formas — desde um ataque intencional para prejudicar você ou a sua Empresa, até mesmo um incidente com um ou mais equipamentos … por exemplo, a sala dos servidores ficava no subsolo da empresa, e devido a uma enchente, a água alagou a sala até o teto … danificando permanentemente os computadores  e os discos de dados. Então você lembra que têm um BACKUP (cópia) dos dados, feito no dia anterior — que infelizmente estava em outro servidor, NA MESMA SALA 😐 Mas esse aspecto de segurança contra desastres a gente aborda em outro tópico … risos …

Usuário e Senha

Pensando inicialmente como um usuário da Agenda, e eu quero que somente pessoas que eu autorize tenham acesso para ler e mexer na minha Agenda, exigir na entrada do programa o fornecimento de um nome ou identificador do operador/usuário e uma senha já é um bom começo.

Se, por outro lado, eu quero definir que, um determinado usuário não pode ver ou alterar determinados contatos, ou não pode excluir ninguém da agenda, mas outro usuário pode, podem ser criados mais controles — como direitos de acesso e operação — que podem ser definidos por usuário ou ainda por grupos de usuários, e por operação. Quando trabalhamos com muitos usuários e direitos, torna-se vantajoso criar grupos de usuários e dar os direitos comuns ao grupo, e depois adicionar ou relacionar o usuário a um ou mais grupos. Por definição, um usuário que pertence a um grupo herda os direitos do grupo. Esta abordagem é muito comum em sistemas operacionais (Windows, Linux, Unix, etc.)

Restrições e/ou Liberações

Normalmente partimos de duas abordagens básicas: Restringir ou Liberar. Podemos partir de um sistema de segurança aberto — onde tudo é permitido — e inserir restrições — usuário pode tudo, exceto operações X e Y — ou partir de um sistema de segurança fechado — onde nada é permitido — e as operações ou recursos devem ser explicitamente liberados para um operador ter acesso as operações.

Ainda podemos trabalhar de forma mista, onde por exemplo as operações de um determinado recurso — cadastro de usuários, por exemplo — por padrão é bloqueado para todos, exigindo liberação para acesso, e o acesso aos dados da agenda — liberado por padrão — mas que, mediante a inserção de restrições, podem ter algumas operações ou mesmo o próprio acesso a rotina bloqueados.

Via de regra, um controle de acesso visa tratar a exceção. Logo, se a maioria dos operadores deve ter acesso a agenda, é mais fácil e custa menos inserir restrições quando e onde necessário. Por outro lado, se ter acesso a um determinado recurso é a exceção — via de regra a maioria não deveria ter acesso — então optamos por trabalhar com uma liberação.

Acesso externo (por fora da aplicação)

Eu posso não ter acesso ao programa de Agenda, porém o programa usa um Banco de Dados para armazenar as informações. Se o operador da máquina estiver usando o meu terminal, e o meu Banco de Dados tiver uma relação de confiança com o meu usuário local, eu abro a ferramenta de administração do Banco de Dados, e posso fazer o que eu quiser com os dados, desde consultar até excluir. Uma alternativa é criar o banco com um usuário diferente, com senha forte, e com autenticação explícita por usuário e senha.

Se eu tenho acesso ao computador onde a Agenda está instalada, mesmo que eu não tenha acesso ao Banco de Dados por dentro de uma ferramenta, eu posso tentar parar o serviço do Banco, copiar os arquivos de dados e logs do SGBD, e montar o banco em outro computador. A alternativa para proteger um acesso aos dados mediante cópia é habilitar uma criptografia dos dados no próprio Banco de Dados. Assim, mesmo que alguém consiga copiar o Banco inteiro, sem a chave de segurança ninguém vai entender o que está gravado ali. Alternativas como essa exigem planejamento e controle, pois se você mesmo perder a chave, nem você mais acessa os dados.

Se o seu equipamento está conectado na Internet, e você não tomou medidas de segurança, desde o procedimento de não instalar qualquer coisa de qualquer lugar no equipamento, e não bloqueou alguns acessos e serviços normalmente visados e com brechas conhecidas de ataque, ou colocou uma senha fraca em um usuário com direitos administrativos no seu equipamento, um acesso remoto na máquina tem praticamente o mesmo efeito como se o intruso estivesse realmente na frente do equipamento — quando ele pode estar a 2 quadras ou 50 mil quilômetros de distância.

RANSOMWARE

Um adendo especial, sobre um novo tipo de ataque, que já fez algumas vítimas pelo mundo, é o RANSOMWARE — uma aplicação nociva, que não visa roubar dados do equipamento, mas “sequestrá-los”. O aplicativo age como um Vírus ou Trojan, mas uma vez infectado o equipamento, ele se mete no acesso aos dados do disco, e criptografa arquivos, pastas, o que ele acha que deve ou os dados para o qual ele foi programado para criptografar. Em um determinado momento, ele pode simplesmente restringir o acesso às pastas e arquivos, ou mesmo apagar os arquivos originais, e exigir um pagamento para o fornecimento da chave capaz de voltar os dados que ele criptografou na sua forma original, ou exige uma senha para o próprio programa malicioso desfazer e restaurar os dados dos arquivos originais — normalmente com o pagamento de alguma importância em dinheiro não rastreável, como cripto-moedas.

Estudo de caso – Agenda

Por hora a ideia de controle de acesso na Agenda, além de fins didáticos, é começar de forma simples, por exemplo, para tratar um cenário onde eu quero que apenas minha esposa e eu possamos abrir a Agenda, mas sem bloquear nenhuma operação ou contato da agenda. Nós dois podemos ver todas as informações de todos os contatos da Agenda, não importa quem cadastrou o contato, e podemos fazer todas as operações com os contatos — como alterar dados, alterar foto, excluir o contato, enfim.

Neste caso, precisamos inicialmente de uma nova tabela, com pelo menos dois campos, um para o nome ou identificação do usuário ou operador — pode ser um nome, ou um e-mail, e outro campo para a autenticação de acesso, como por exemplo uma senha. Antes de implementar isso, vamos avaliar nossa necessidade e as possibilidades de se implementar esta solução.

Usuário ou e-Mail ?

Por ser um sistema local, um nome único de usuário já resolveria a questão de identificação. Porém, pensando um pouco além do óbvio, eu bem que poderia usar um e-mail. Afinal, lembra do que acontece quando você “perde a chave”? Nem você entra mais na sua casa.

Vantagens do e-Mail

  • Se o próprio operador esquece da senha, e a aplicação é capaz de enviar um e-mail ao usuário, ele pode usar um recurso como por exemplo “Password Reset”, onde a aplicação gera uma chave temporária de acesso para aquele usuário, e envia a chave no e-mail dele. Somente ele deve ter acesso ao e-mail, logo, uma vez que ele acesse o sistema com a chave que o sistema gerou, a aplicação tenta garantir que é de fato aquele usuário que está realizando o acesso, e permite a ele redefinir sua senha de acesso.
  • Dificilmente um usuário se esquece do próprio endereço de e-mail.
  • Sem o e-mail, o usuário precisaria entrar em contato com o Administrador do Sistema, de alguma forma provar sua identidade, e pedir para ele uma troca de senha. Quando falamos de um sistema local de Agenda, pra usar em casa, sem problemas.  Mas, pensando em algo um pouco maior, algo como a Agenda disponível na Internet, é um desperdício criar um suporte para atender usuário que perdeu senha, se você pode dar a ele um procedimento seguro de provar sua identidade e restaurar sozinho e com segurança seu acesso ao sistema.

Autenticando por Senha

Antes de mais nada, a respeito de qualquer tipo de senha em um sistema informatizado: Nunca grave a senha em um sistema de controle de acesso. Sim, é isso mesmo: NÃO GRAVE A SENHA.

Certo, então como vêm a pergunta: Se eu não gravar a senha, como eu vou conseguir validar a senha que o operador digitou na entrada do sistema está certa ?! Bem, primeiro vamos aos riscos: Uma tabela de usuários e senhas vale muito para pessoas mal-intencionadas. Muitos usuários na internet usam senhas fortes para diversos recursos, mas acabam usando a mesma senha para outros recursos. Logo, mesmo que você grave a senha que o operador digitou usando algum tipo de criptografia, se alguém descobre o algoritmo de descriptografia, ele terá acesso a todas as senhas de todos os usuários.

Uma alternativa bastante segura é gerar um hash (ou dispersão criptográfica) unidirecional. Na prática, você usa um algoritmo que é capaz de gerar uma sequência de dados a partir de uma informação fornecida, mas o algoritmo não é capaz de restaurar o dado original a partir da sequência de dados (hash) gerado. Um bom exemplo disso é o MD5 — vide referências no final do post. A partir de uma informação fornecida, o algoritmo MD5 gera uma sequência hexadecimal de 128 BITS, mas a partir desta sequência ele não é capaz de desfazer a operação e informar qual foi a informação que gerou aquele hash.

Logo, quando o usuário informar a senha de acesso que ele gostaria de usar, a aplicação gera um MD5 desta senha, e grava o resultado no banco de dados, atrelado a este usuário. No momento que este usuário for entrar no sistema, e fornecer o e-Mail e Senha, você localiza ele no cadastro pelo e-Mail, e gera novamente o MD5 da senha que ele informou. Se ele informou a mesma senha, o resultado do MD5 será o mesmo. Assim, nem você sabe a senha original, nem quem conseguir roubar ou copiar esta tabela vai saber.

Existe a possibilidade de colisão, isto é, duas senhas diferentes gerarem o mesmo hash. Porém, como estamos falando de um hash de 128 bits, sabe quantas são as possíveis combinações? 2^128 (dois elevado a potência 128), algo em torno de 3.40e+38 combinações diferentes — imagine que 64 bits = 18.446.744.073.709.551.615 ( dezoito quintilhões, quatrocentos e quarenta e seis quatrilhões, setecentos e quarenta e quatro trilhões, setenta e três bilhões, setecentos e nove milhões, quinhentos e cinqüenta e um mil, seiscentas e quinze possibilidades), agora multiplica esse número por dois, sessenta e quatro vezes seguidas 😛 

Vamos ao AdvPL

Primeiro, vamos criar a função responsável pela criação e abertura da tabela de usuários. Ela é praticamente uma cópia com alterações da função de criação da tabela de Agenda.

// --------------------------------------------------------------
// Abertura da Tabela de USUARIOS da Agenda
// Cria uma tabela chamda "USUARIOS" no Banco de dados atual
// configurado no Environment em uso pelo DBAccess
// Cria a tabela caso nao exista, cria os índices caso nao existam
// Abre e mantém a tabela aberta em modo compartilhado
// --------------------------------------------------------------
STATIC Function OpenUsers()
Local cFile := "USUARIOS"
Local aStru := {}
Local aDbStru := {}
Local nRet

While !GlbNmLock("USUARIOS_DB")
  If !MsgYesNo("Existe outro processo abrindo a tabela USUARIOS. Deseja tentar novamente ?")
    MSgStop("Abertura da tabela USUARIOS em uso -- tente novamente mais tarde.")
    QUIT
  Endif
Enddo

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

If !TCCanOpen(cFile)
  // Se o arquivo nao existe no banco, cria
  DBCreate(cFile,aStru,"TOPCONN")
  Else
  // O Arquivo já existe, vamos comparar as estruturas
  USE (cFile) ALIAS (cFile) SHARED NEW VIA "TOPCONN"
  IF NetErr()
    MsgSTop("Falha ao abrir a tabela USUARIOS em modo compartilhado. Tente novamente mais tarde.")
    QUIT
  Endif
  aDbStru := DBStruct()
  USE

  If len(aDbStru) != len(aStru)
    // Estao faltando campos no banco ? 
    // Vamos alterar a estrutura da tabela
    // Informamos a estrutura atual, e a estrutura esperada
    If !TCAlter(cFile,aDbStru,aStru)
      MsgSTop(tcsqlerror(),"Falha ao alterar a estrutura da tabela USUARIOS")
      QUIT
    Endif
    MsgInfo("Estrutura do arquivo USUARIOS atualizada.")
  Endif

Endif

If !TCCanOpen(cFile,cFile+'_UNQ')
  // Se o Indice único da tabela nao existe, cria 
  USE (cFile) ALIAS (cFile) EXCLUSIVE NEW VIA "TOPCONN"
  IF NetErr()
    MsgSTop("Falha ao abrir a tabela USUARIOS em modo EXCLUSIVO. Tente novamente mais tarde.")
    QUIT
  Endif
  nRet := TCUnique(cFile,"LOGIN")
  If nRet < 0 
    MsgSTop(tcsqlerror(),"Falha ao criar índice único")
    QUIT
  Endif
  USE
EndIf

If !TCCanOpen(cFile,cFile+'1')
  // Se o Indice por ID nao existe, cria
  USE (cFile) ALIAS (cFile) EXCLUSIVE NEW VIA "TOPCONN"
  IF NetErr()
    MsgSTop("Falha ao abrir a tabela USUARIOS em modo EXCLUSIVO. Tente novamente mais tarde.")
    QUIT
  Endif
  INDEX ON IDUSR TO (cFile+'1')
  USE
EndIf

If !TCCanOpen(cFile,cFile+'2')
  // Se o indice por LOGIN nao existe, cria
  USE (cFile) ALIAS (cFile) EXCLUSIVE NEW VIA "TOPCONN"
  IF NetErr()
    MsgSTop("Falha ao abrir a tabela USUARIOS em modo EXCLUSIVO. Tente novamente mais tarde.")
    QUIT
  Endif
  INDEX ON LOGIN TO (cFile+'2')
  USE
EndIf

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

If NetErr()
  MsgSTop("Falha ao abrir a tabela USUARIOS em modo compartilhado. Tente novamente mais tarde.")
  QUIT
Endif

// Abre os indices, seleciona ordem por ID
// E Posiciona no primeiro registro 
DbSetIndex(cFile+'1')
DbSetIndex(cFile+'2')
DbSetOrder(1)
DbGoTop()

// Solta o MUTEX 
GlbNmUnlock("USUARIOS_DB")

Return .T.

Para quem ainda está usando um binário 7.00.131227, que não têm as funções GlbNmLock() e GlbNmUnlock(), pode temporariamente substituí-las por GlbLock() e GlbUnlock() — a diferença é que o Lock realizado é global, isto é, desconsidera o nome informado como parâmetro.

Agora, vamos fazer a função de LOGIN, porém vamos atentar a um detalhe: Se eu não quiser habilitar o controle de usuários na minha agenda, eu simplesmente deixo o cadastro de usuários vazio.

// ---------------------------------------------------
// Função responsável pelo controle de acesso - Login
// Somente exige autenticação se o cadastro de usuários tiver 
// pelo menos um usuário 
// ---------------------------------------------------
STATIC Function ChkUser(oDlg)
Local lOk := .T.
// Abre cadastro de usuarios
OpenUsers()
// Vai para o topo do arquivo 
DbSelectarea("USUARIOS")
DBGoTOP()
If !EOF()
  // Se existem usuarios na tabela de usuarios, 
  // o login foi habilitado . 
  lOk := DoLogin(oDlg)
Endif
// Fecha o cadastro de usuarios 
DbSelectarea("USUARIOS")
USE 
If !lOk
  MsgStop("Usuário não autenticado.","Controle de Acesso")
  QUIT
Endif
Return

// Definições para uso da função AdvPL MD5()
#define RAW_DIGEST 1 
#define HEX_DIGEST 2

// Função responsável pelo diálogo e validação do Login
STATIC Function DoLogin(oDlg)
Local cTitle := 'Controle de Acesso'
Local oDlgLogin
Local oGetLogin
Local cLogin := space(50)
Local cPassW := space(16)
Local oBtnOk
Local lGo,lOk

While .T.
  lGo := .F.
  lOk := .F. 
  cLogin := space(50)
  cPassW := space(16)
  DEFINE DIALOG oDlgLogin TITLE (cTitle) ;
    FROM 0,0 TO 90,450 PIXEL;
    FONT oDlg:oFont ; // Usa a mesma fonte do diálogo anterior
    OF oDlg ;
    COLOR CLR_WHITE, CLR_RED

  @ 05+3,05 SAY oSay1 PROMPT "Login" RIGHT SIZE 20,12 OF oDlgLogin PIXEL
  @ 05,30 GET oGetLogin VAR cLogin PICTURE "@!" SIZE CALCSIZEGET(45) ,12 OF oDlgLogin PIXEL

  @ 25+3,05 SAY oSay1 PROMPT "Senha" RIGHT SIZE 20,12 OF oDlgLogin PIXEL
  @ 25,30 GET oGetPassw VAR cPassW SIZE CALCSIZEGET(16) ,12 OF oDlgLogin PIXEL
  oGetPassw:LPASSWORD := .T.

  @ 25,155 BUTTON oBtnOk PROMPT "Ok" SIZE 60,15 ;
    ACTION (lGo := .T. , oDlgLogin:End()) OF oDlgLogin PIXEL

  ACTIVATE DIALOG oDlgLogin CENTER

  If !lGo
    // SE a janela foi fechada, desiste 
    EXIT
  Endif

  DbSelectarea("USUARIOS")
  DBSetOrder(2) // Indice por LOGIN

  If DBSeek(cLogin)
    // Encontrou o Login informado
    If MD5(alltrim(cPassW),HEX_DIGEST) == USUARIOS->SENHA
      // A senha informada "bate" com a senha original
      // Seta que está OK, sai do Login
      lOk := .T.
      EXIT
    Endif 
  Endif

  // Chegou aqui, o login nao existe ou a senha nao confere 
  MsgStop("Login ou senha inválidos. "+;
    "Confirme os dados e repita a operação.", ;
    "Falha de Autenticação")

Enddo

Return lOk

Feito isso dessa forma, conseguimos implementar um controle de acesso simples e eficiente, e bastante seguro, pois a senha original nunca é armazenada. A tela, após implementado um usuário, deve ficar assim:

CRUD - Controle de Acesso

Conclusão

Por hora, sem a inclusão de um usuário, não há autenticação na Agenda. As partes de código publicadas aqui ainda exigem alguns ajustes em outros pontos, por exemplo inserir o Login na inicialização da Agenda. Para pegar o fonte completo, acesse o GITHUB!

Agradeço novamente a audiência, as curtidas e os comentários, e desejo novamente a todos TERABYTES DE SUCESSO 😀 

Referências

 

CRUD em AdvPL – Parte 13

Introdução

Nos tópicos anteriores, funcionalidades e recursos foram adicionados ao programa de Agenda. Agora, vamos criar uma “casca” de acesso sobre este fonte, e futuras funcionalidades? Que tal uma aplicação com uma MAIN WINDOW?

Criando o AdvPLSuite

Vamos criar um fonte AdvPL, que vai criar uma WINDOW, ao invés de uma DIALOG. Como somente pode haver uma janela do tipo WINDOW na aplicação AdvPL, ela será a base para ter um Menu de Opções, para chamar os demais programas que serão publicados aqui no Blog, seguindo a linha do CRUD, com o programa Agenda. Segue abaixo o fonte ADVPLSUITE.PRW

#include "protheus.ch"

#define CALCSIZESAY( X ) (( X * 4 ) + 4)

// --------------------------------------------------------------
// Programa principal AdvPLSuite
//
// Autor Júlio Wittwer
// Data 28/10/2018
//
// Serve de Menu para os demais programas de exemplo do Blog 
// Primeiro programa acrescentado : U_AGENDA
// --------------------------------------------------------------

User Function AdvPLSuite()
Local oMainWnd
Local cTitle := "AdvPL Suite 1.00"
Local oFont

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

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

// Seta que esta é a fonte DEFAULT para Interface
SETDEFFONT(oFont)

DEFINE WINDOW oMainWnd FROM 0,0 to 768,1024 PIXEL ; 
TITLE (cTitle) COLOR CLR_WHITE, CLR_BLUE

// Monta o menu superior da aplicaçáo 
BuildMenu(oMainWnd)

// Executa rotina de entrada 
oMainWnd:bStart := {|| WndStart(oMainWnd) }

// Ativa a janela principal maximizada 
ACTIVATE WINDOW oMainWnd MAXIMIZED

Return


// --------------------------------------------------------------
// Montagem do Menu do AdvPLSuite 
// --------------------------------------------------------------
STATIC Function BuildMenu(oMainWnd)
Local oMenuBar
Local oTMenu1, oTMenu2

conout('BuildMenu - IN')

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

// Cria o menu de Programas e acrescenta os itens
oTMenu1 := TMenu():New(0,0,0,0,.T.,,oMainWnd,CLR_BLACK,CLR_WHITE)
oMenuBar:AddItem('Programas' , oTMenu1, .T.)

oTMenu1:Add(TMenuItem():New(oMainWnd,'&Agenda',,,,{||U_AGENDA()},,,,,,,,,.T.))
oTMenu1:Add(TMenuItem():New(oMainWnd,'Sai&r',,,,{||oMainWnd:End()},,,,,,,,,.T.))

// Cria o Menu de Ajuda e acrescenta Itens
oTMenu2 := TMenu():New(0,0,0,0,.T.,,oMainWnd,CLR_WHITE,CLR_BLACK)
oMenuBar:AddItem('Ajuda', oTMenu2, .T.)

oTMenu2:Add(TMenuItem():New(oMainWnd,'&TDN - AdvPL',,,,{||OpenURL("http://tdn.totvs.com/display/tec/AdvPL")},,,,,,,,,.T.))
oTMenu2:Add(TMenuItem():New(oMainWnd,'&Sobre',,,,{||HlpAbout()},,,,,,,,,.T.))

Return

// --------------------------------------------------------------
// Tela de inicialização -- Mensagem de Entrada
// --------------------------------------------------------------
STATIC Function WndStart(oMainWnd)
Local oDlg
Local cTitle
Local cMsg

cTitle := "Bem vindo ao AdvPL Suite 1.00"

DEFINE DIALOG oDlg TITLE (cTitle) ;
FROM 0,0 TO 100,400 ;
COLOR CLR_WHITE, CLR_RED PIXEL

@ 05,05 SAY "APPServer Build .... "+GetBuild() SIZE CALCSIZESAY(50),12 OF oDlg PIXEL 
@ 18,05 SAY "Smartclient Build .. "+GetBuild(.T.) SIZE CALCSIZESAY(50),12 OF oDlg PIXEL

cMsg := "SERVER "

If IsSrvUnix()
  cMsg += 'LINUX '
Else
  cMsg += 'WINDOWS '
Endif

if ISSRV64()
  cMsg += '64 BITS'
Else
  cMsg += '32 BITS'
Endif

@ 31,05 SAY cMsg SIZE CALCSIZESAY(50),12 OF oDlg PIXEL

ACTIVATE DIALOG oDlg CENTER

Return

// --------------------------------------------------------------
// Mensagem informativa sobre o autor
// --------------------------------------------------------------

STATIC Function HlpAbout()
MsgInfo("<html><center>AdvPL Suite V1.00<hr>Júlio Wittwer<br><b>Tudo em AdvPL</b>")
return

// --------------------------------------------------------------
// Encapsulamento de abertura de URL
// Abre a URL informada como parametro no navegador padrão
// da máquina onde está sendo executado o SmartClient
// --------------------------------------------------------------
STATIC Function OpenURL(cUrl)
shellExecute("Open", cUrl, "", "", 1 )
return

Após compilar este código, e executá-lo diretamente pelo SmartClient, chamando a função U_ADVPLSUITE, o resultado esperado é ser aberta uma janela na tela, com o título “AdvPL Suite 1.00“, com fundo azul, e dentro dela uma caixa de diálogo com fundo vermelho, mostrando algumas informações.

Suite - Splash

Após pressionar a tecla [ESC] ou clicar no “X” para encerrar o diálogo, vamos acessar o menu no canto superior esquerdo, e ir na opção Programas –> Agenda. A aplicação de agenda deve ser aberta na tela, centralizada.

Suite - Agenda

Reparem que a Agenda está com o alinhamento diferente dos botões de navegação, resolvi fazer uma alteração no LayOut dos painéis, foi fácil fazer isso e eu não precisei alterar nenhuma coordenada dos componentes de interface.

Os códigos atualizados do post atual e da agenda estão disponíveis para Download no GITHUB — https://github.com/siga0984/Blog/, pode entrar e baixar, compilar, alterar, etc!!!

Conclusão

Prevendo o crescimento da aplicação, agora já temos um “Menu” para acrescentar funcionalidades. Agenda será apenas uma delas, mas ao longo do tempo, novas serão inseridas e integradas. Aguardem as cenas do próximo capítulo.

Desejo novamente a todos TERABYTES DE SUCESSO 😀

Referências

 

 

 

CRUD em AdvPL – Parte 12,5

Introdução

No post anterior, foi inserido o recurso de inserir uma foro 3×4 para cada contato da agenda. Sabe o que faltou ? Sim, remover a foto! Tanto que nem compensa dizer que esta é a parte 13 do CRUD … risos … esta é a parte 12,5 😉

Ajustes na Rotina

Tão simples quanto isso, foi acrescentar o botão para remover a foto. A função alterada foi a ChgImage(). Antes de mais nada eu verifico se já tem uma foto para o contato atualmente posicionado. Caso exista, eu habilito o botão para apagar a foto atual. Caso a eliminação da foto seja confirmada, eu simplesmente gravo uma string em branco no campo IMAGE, limpo o arquivo de cache de visualização da pasta temporária, e mostro a foto padrão do sistema. Vejamos abaixo como ficou a rotina após estes ajustes, as partes inseridas ou alteradas estão em negrito.

STATIC Function ChgImage(oDlg,aBtns,aGets,oBmpFoto)
Local cTitle := 'Escolha uma imagem'
Local oDlgImg
Local cFile := space(50)
Local lOk := .F. , lErase := .F.
Local aFInfo
Local oGet1, oBtn1, oBtn2, oBtn3
Local cMemoImg := AGENDA->IMAGE

DEFINE DIALOG oDlgImg TITLE (cTitle) ;
  FROM 0,0 TO 120,425 PIXEL;
  FONT oDlg:oFont ; // Usa a mesma fonte do diálogo anterior 
  OF oDlg ; 
  COLOR CLR_BLACK, CLR_HBLUE

@ 05,05 GET oGet1 VAR cFile SIZE CALCSIZEGET(50),12 OF oDlgImg PIXEL

@ 25,05 BUTTON oBtn1 PROMPT "Buscar" SIZE 60,15 ;
  ACTION (BuscaFile(@cFile)) OF oDlgImg PIXEL

@ 25,70 BUTTON oBtn2 PROMPT "Ok" SIZE 60,15 ;
  WHEN File(alltrim(cFile)) ; 
  ACTION ( lOk := .T. , oDlgImg:End() ) OF oDlgImg PIXEL

@ 25,135 BUTTON oBtn3 PROMPT "Apagar" SIZE 60,15 ;
  ACTION ( lErase := .T. , oDlgImg:End() ) OF oDlgImg PIXEL

if Empty(cMemoImg)
  // Se o contato nao tem foto, não mostra o
  // botão para apagar a foto 
  oBtn3:Hide()
Endif

ACTIVATE DIALOG oDlgImg CENTER

If lErase
  If MsgYEsNo("Este contato tem uma foto. Deseja apagá-la ?")
    DBSelectArea("AGENDA")
    If DbrLock(recno())
      AGENDA->IMAGE := ""
      DBRUnlock()
      // Limpa ultima imagem desse ID do cache temporário 
      CleanImg(AGENDA->ID)
      // Carrega a imagem default para limpar 
      // o cache do componente de imagem 
      oBmpFoto:Load(,"\temp\tmp_photo_3x4.img")
    Else
      // Nao conseguiu bloqueio do registro
      // Mostra a mensagem e permanece no modo de alteração
      MsgStop("Registro não pode ser alterado, está sendo usado por outro usuário")
    Endif
  Endif
ElseIF lOk
  cFile := alltrim(cFile)
  aFInfo := Directory(cFile)
  If len(aFInfo) > 0 
    If aFInfo[1][2] > ( 128 * 1024) // Até 128 KB
      MsgStop("Arquivo muito grande ("+str(aFInfo[1][2]/2014,8,2)+" KB)","Imagem maior que 128 KB")
      return 
    Endif
  Else
    MsgStop('Arquivo não encontrado',cFile)
    return 
  Endif
  
  // Chegou ate aqui, atualiza o campo memo 
  If !empty(cMemoImg)
    lOk := MsgYEsNo("Este contato já tem uma foto. Deseja substituí-la ?")
  Endif

  If lOk
    // Lê a imagem do disco 
    cMemoImg := ReadFile(cFile)
    If empty(cMemoImg)
      // Imagem vazia, houve falha na leitura 
      Return
    Endif
    DBSelectArea("AGENDA")
    If DbrLock(recno())
      // Troca conteudo da imagem no Banco de Dados 
      AGENDA->IMAGE := cMemoImg
      DBRUnlock()
      // Limpa ultima imagem desse ID do cache temporário 
      CleanImg(AGENDA->ID)
      // Carrega a imagem default para limpar 
      // o cache do componente de imagem 
      oBmpFoto:Load(,"\temp\tmp_photo_3x4.img")
      // Agora Mostra a nova imagem do contato 
      ShowImg(oBmpFoto)
      // E Avisa que a imagem foi trocada com sucesso 
      MsgInfo("Imagem atualizada.")
    Else
      // Nao conseguiu bloqueio do registro
      // Mostra a mensagem e permanece no modo de alteração
      MsgStop("Registro não pode ser alterado, está sendo usado por outro usuário")
    Endif
  Endif
Endif
Return

Aproveitei para aumentar o campo para informar o nome do arquivo para 50 caracteres, com apenas uma alteração nos parâmetros da função cGetFile(), podemos escolher uma imagem em uma pasta do disco onde o SmartClient está sendo executado, sem alterar mais nenhuma linha de código.

Conclusão

Agora sim a manutenção da imagem dos contatos está completa. Agora, vou voltar pra “prancheta” e ver o que mais dá pra incrementar na Agenda! Daqui a pouco eu atualizo o GIRHUB com o código atualizado.

Agradeço desde já a audiência, curtidas e comentários, e desejo a todos TERABYTES DE SUCESSO 😀

 

CRUD em AdvPL – Parte 12

Introdução

No post anterior, colocamos mais um botão na interface para enviar e-mail. Agora, vamos colocar uma foto 3×4 para cada contato da agenda.

Novo campo na base

Inicialmente, vamos criar um novo campo na tabela da Agenda, para armazenar a imagem. No caso, vamos usar um campo do tipo “M” Memo do AdvPL, que por default aceita armazenar e recuperar conteúdos binários (bytes de valor 0 a 255, inclusive bytes que não têm representação no CP1252 — usado pelo Protheus).

// Cria o array com os campos do arquivo 
aadd(aStru,{"ID" ,"C",06,0})
aadd(aStru,{"NOME" ,"C",50,0})
aadd(aStru,{"ENDER" ,"C",50,0})
aadd(aStru,{"COMPL" ,"C",20,0})
aadd(aStru,{"BAIRR" ,"C",30,0})
aadd(aStru,{"CIDADE","C",40,0})
aadd(aStru,{"UF" ,"C",02,0})
aadd(aStru,{"CEP" ,"C",08,0})

// Novos campos inseridos em 07/10
aadd(aStru,{"FONE1" ,"C",20,0})
aadd(aStru,{"FONE2" ,"C",20,0})
aadd(aStru,{"EMAIL" ,"C",40,0})

// Novos campos inseridos em 21/10
aadd(aStru,{"IMAGE" ,"M",10,0})

Lembrando que o fonte original possui uma implementação para, caso detectada alguma diferença na estrutura da tabela no momento da abertura, a aplicação automaticamente vai executar um TC_ALTER() para inserir o novo campo.

Inserindo a imagem padrão no programa

A partir desse momento, no espaço reservado da interface onde vamos mostrar a foto do contato da agenda, caso o contato ainda não tenha foto, vamos mostrar uma imagem de 120 x 160 pixels — razão 3×4 — com fundo branco, e o texto “Photo 3×4”. Foi relativamente simples montar esta imagem e salvá-la no formato PNG, ela ocupou míseros 1090 bytes — menos que 1KB.

Para passar a usar esta imagem no programa, podemos proceder de várias formas. Uma delas é distribuir a imagem junto do programa, criar uma pasta ou diretório chamado “images” (por exemplo) a partir do RootPath, e salvar a imagem nesta pasta.

Outra forma seria acrescentar a imagem dentro do Repositório de Objetos (RPO) da aplicação como um “resource”. E, de dentro do programa, fazer a carga deste resource diretamente como uma imagem.

Existe ainda a terceira forma, que seria criar um fonte AdvPL que fosse capaz de criar esta imagem. Esta é a forma mais interessante, e que foi adotada neste exemplo:

STATIC Function RAW3x4()
Local cRaw := ''
cRaw += HEx2Bin('89504E470D0A1A0A0000000D4948445200000078000000A00802000000486B3FC700000001735247')
cRaw += HEx2Bin('4200AECE1CE90000000467414D410000B18F0BFC61050000000970485973000012740000127401DE')
cRaw += HEx2Bin('661F78000003D749444154785EEDDC6D5AEA30140061F7D3F5B01FD7C37AD88F3760494E3E8A14CB')
cRaw += HEx2Bin('542E33BF34C4206F43451FEAC79721090D253494D0504243090D253494D0504243090D253494D050')
cRaw += HEx2Bin('4243090D253494D0504243090D253494D0504243090D253494D0504243090D253494D0504243090D')
cRaw += HEx2Bin('253494D0504243090D253494D0504243090D253494D0504243090D253494D0504243ED097D3A1E3E')
cRaw += HEx2Bin('BE9B3E4FF3D87FDB33A0B35F6C9AA6C3E7B1F23C7D4ED71B857EA0E2372A983E0DBA2C7C38CE43BB')
cRaw += HEx2Bin('8743A7AE8F5EE8DF15A0F3E33C1DA3FE3C2CF4EF1A41A7C2F0EC5A43A71F8D53FEBC3D9DCF9DD201')
cRaw += HEx2Bin('2BB352DF27FE3075F8F321558BFFBCCEE671D0C1A0874ECD1F96DADD980EC47C4BD794E72E4187E7')
cRaw += HEx2Bin('CC5DEB6CDEDFD8D1E302CE8F73AF77F5D38EBE779DCDC3CED1611B5D01EB079DF50B55910E7E69D7')
cRaw += HEx2Bin('5D4787ABA6CAC22DDBBA75B6ECB9D0C38A7E99181F5D19CEA3DD5927375C63117AE53A5B4643C747')
cRaw += HEx2Bin('31103DD70F2F4CBC14EE6D70046BE8B5EB6C19053DF8C570E971F7C36523F60623A03256CF5FBBCE')
cRaw += HEx2Bin('96713F0CFB7AD14BFDF0F2337EBC48195B82BE6F9D2D7B09E8B062AB30BCB332587F036BD7D9B297')
cRaw += HEx2Bin('808E4BA6C1F1AB85705FD57770993CFF2EB2729D2D7B0DE8F8AC1F57EFD07EF6F5F675EB6CD8AB40')
cRaw += HEx2Bin('9F89F2B26DFD2F749D67596AD53ADBF554E8F4EC9CC786A5676C9E18F7D1C270FA82157FA2389F0E')
cRaw += HEx2Bin('F2CC342D4EDAE14F1DCF80B6514243090D253494D0504243090D253494D0504243090D253494D050')
cRaw += HEx2Bin('4243090D253494D0504243090D253494D0504243090D253494D0504243090D253494D0504243ED07')
cRaw += HEx2Bin('7D7EEBECA1BA6276703DD123D56F806EDFFABB573B41DF7AE3FDEFDE0DDEAEFCDED0E1A280518F53')
cRaw += HEx2Bin('F70750E874A2086FB2AFE91F940E970AE40B9DDFFCD43128525FA1CB068D97979499D501A98683B9')
cRaw += HEx2Bin('D07501BAE08C06C7868DBED0C3D22B900CDAECD3B2A9E7F13C10A7759B5CE85CD8ACA1E6FAA954BD')
cRaw += HEx2Bin('A9F36711B04CC9A342E746D0E357D26153E7E2761EA10A9D1BEFE84B1D4E4B1D270CF7B8D00B9DAA')
cRaw += HEx2Bin('CBB17B9E463AECE71BC72BB43FF71F81BE14352B991EB3DC2CF4FA16A00365F8D348DED4ED6965D8')
cRaw += HEx2Bin('9B429FE99AABAFD3CB8978EE08300532D946F49B76F9ABF627FE6E37E89B957370993A8B850D1C5F')
cRaw += HEx2Bin('79B4097DE9E6D33DD084239255EFDBD442CFCDFFC921EEECFE7F3994E311B9EE9216FA5D131A4A68')
cRaw += HEx2Bin('28A1A18486121A4A6828A1A18486121A4A6828A1A18486121A4A6828A1A18486121A4A6828A1A184')
cRaw += HEx2Bin('86121A4A6828A1A18486121A4A6828A1A18486121A4A6828A1A18486121A4A6828A1A18486121A4A')
cRaw += HEx2Bin('6828A1A18486121A4A6828A1A18486121A4A6828A1A18486121AE9EBEB1FDCCEA468FA802AA60000')
cRaw += HEx2Bin('000049454E44AE426082')

Return cRaw

STATIC function HEx2Bin(cHex)
Local cBin := ''
For nI := 1 to len(cHex) STEP 2
  cBin += chr(__HEXTODEC(substr(cHex,nI,2)))
Next
Return cBin

Usando um WebSite que gera o código Hexadecimal dos bytes de um arquivo, eu gerei um “Dump” em hexadecimal da imagem no formato PNG, e criei um fonte AdvPL capaz de remontar a imagem a partir destas informações, convertendo os valores hexadecimais em pares, para chegar ao valor do Byte original, e somando estes bytes em uma variável do tipo caractere no AdvPL.

A função que faz a conversão é a Hex2Bin(), que usa internamente a função __HexToDec() do binário, que converte um valor em String hexadecimal para numérico (decimal).

Acrescentando a imagem na tela

Vamos aproveitar a área abaixo do botão “Sair” para colocar a foto do contato. Para isso, acrescentamos as seguintes linhas no código, logo abaixo da criação do botão “Sair” — lembrando de declarar a variável oBmpFoto como “Local” no fonte da STATIC Function doInit(oDlg)

@ 65,05 BUTTON oBtn5 PROMPT "Sair" SIZE 60,15 ;
  ACTION oDlg:End() OF oPanelMenu PIXEL

@ 90,05 BITMAP oBmpFoto OF oPanelMenu PIXEL 

oBmpFoto:nWidth := 120
oBmpFoto:nHeight := 160
oBmpFoto:lStretch := .T.

Agora, vamos passar a variável oBmpFoto como último parâmetro para todas as chamadas da STATIC Function ManAgenda()., inclusive na declaração desta função, recebendo o objeto no parâmetro nomeado oBmpFoto. E, por fim, acrescentar o botão para alterar a imagem 3×4 do contato atual, logo abaixo do botão “G-Mail”:

@ 125,05 BUTTON oBtnImg PROMPT "Foto 3x4" SIZE 60,15 ; 
  WHEN ( nMode == 4 ) ; // Editar foto disponivel apenas durante a consulta
  ACTION ChgImage(oDlg,aBtns,aGets,oBmpFoto) OF oPanelNav PIXEL
aadd(aBtns,oBtnImg) // [15] Foto 3x4

Lembram-se da função SetNavBtn(), que habilitavam ou desabilitavam os botões de navegação do lado direito da tela, fazendo um SetEnable() diretamente no painel, habilitando ou desabilitando todos os botões? Bem, como vamos poder ter alguns botões com controle de habilitação independente, a função foi alterada para atuar apenas do botão 7 ao 14:

STATIC Function SetNavBtn(aBtns,lEnable)
Local nI
For nI := 7 to 13
  aBtns[nI]:SetEnable(lEnable)
Next
Return

Disparando a atualização da imagem

Como os dados sobre o contato mostrado na tela é carregado pela função ReadRecord(), vamos inserir manualmente após cada chamada da função ReadRecord() a chamada da função ShowImg(), responsável por atualizar a foto na tela.

 // Atualiza na tela o conteudo do registro atual 
ReadRecord(aGets)

// Mostra a imagem do contato 
ShowImg(oBmpFoto)

E, finalmente, vamos a função que faz a mágica, a função ShowImg():

STATIC Function ShowImg(oBmpFoto)
Local cTmpPath
Local nH
Local cRAWImage 
Local cId

// Lê o campo memo com o conteudo da imagem 
// e o ID do contato da agenda 
cId       := AGENDA->ID
cRAWImage := AGENDA->IMAGE

If empty(cRawImage)
  // Contato sem imagem, cria um cache em disco da imagem padrão
  cId := 'photo_3x4'
  cTmpPath := "\temp\tmp_"
  cTmpPath += cID
  cTmpPath += ".img"
  if !file(cTmpPath)
    nH := fCreate(cTmpPath)
    // grava no disco o conteúdo binário da imagem 
    fWrite(nH,RAW3x4()) 
    fclose(nH)
  Endif
Else
  // Contato com imagem, cria um cache da imagem usando o ID do contato
  cTmpPath := "\temp\tmp_"
  cTmpPath += cID
  cTmpPath += ".img"
  if !file(cTmpPath)
    nH := fCreate(cTmpPath)
    fWrite(nH,cRawImage)
    fclose(nH)
  Endif
Endif
oBmpFoto:Load(,cTmpPath)
Return 

A função é relativamente simples, e ainda está sujeita a melhorias. Ela depende apenas da criação da pasta “\temp\” a partir do RootPath do ambiente, pois ela será usada exatamente para fins temporários. Por hora o componente tBitmap aceita realizar a carga de uma imagem do disco, ou de um RESOURCE compilado no RPO. Como o conteúdo binário da imagem foi gravado no banco de dados, ao ser recuperado precisamos criar um arquivo em disco para ser carregado.

Neste caso, lemos a imagem do Banco de Dados, e caso o arquivo em disco ainda não exista , ele é criado na hora usando o conteúdo da imagem, e o nome do arquivo usa o código identificador do contato, para não precisar ficar criando e apagando o mesmo arquivo várias vezes, também servindo de “Cache” para as fotos armazenadas nesta tabela.

Atribuindo uma imagem ao contato

Quase que eu esqueço do principal, a função ChgImage(), para permitir atribuir ou remover uma imagem a um contato. Vejamos:

STATIC Function ChgImage(oDlg,aBtns,aGets)
Local cTitle := 'Escolha uma imagem'
Local oDlgImg
Local cFile := space(40)
Local lOk := .F.
Local aFInfo

DEFINE DIALOG oDlgImg TITLE (cTitle) ;
  FROM 0,0 TO 120,415 PIXEL;
  FONT oDlg:oFont ;
  OF oDlg ; 
  COLOR CLR_BLACK, CLR_HBLUE

@ 05,05 GET oGet1 VAR cFile SIZE CALCSIZEGET(40),12 OF oDlgImg PIXEL

@ 25,05 BUTTON oBtn1 PROMPT "Buscar" SIZE 60,15 ;
  ACTION (BuscaFile(@cFile)) OF oDlgImg PIXEL

@ 25,85 BUTTON oBtn2 PROMPT "Ok" SIZE 60,15 ;
  WHEN empty(cFile) .or. File(alltrim(cFile))  ; 
  ACTION ( lOk := .T. , oDlgImg:End() ) OF oDlgImg PIXEL

ACTIVATE DIALOG oDlgImg CENTER

IF lOk
  cFile := alltrim(cFile)
  aFInfo := Directory(cFile)
  If len(aFInfo) > 0 
    If aFInfo[1][2] > ( 128 * 1024) // Até 128 KB
      MsgStop("Arquivo muito grande ("+str(aFInfo[1][2]/1024,8,2)+" KB)","Imagem maior que 128 KB")
      return 
    Endif
  Else
    MsgStop('Arquivo não encontrado',cFile)
    return 
  Endif
  // Chegou ate aqui, atualiza o campo memo 
  cMemoImg := AGENDA->IMAGE
  If !empty(cMemoImg)
    lOk := MsgYesNo("Este contato já tem uma foto. Deseja substituí-la ?")
  Endif
  If lOk
    // Lê a imagem do disco 
    cMemoImg := ReadFile(cFile)
    If empty(cMemoImg)
      Return
    Endif
    DBSelectArea("AGENDA")
    If DbrLock(recno())
      AGENDA->IMAGE := cMemoImg
      DBRUnlock() 
      MsgInfo("Imagem atualizada.")
    Else
      // Nao conseguiu bloqueio do registro
      // Mostra a mensagem e permanece no modo de alteração
      MsgStop("Registro não pode ser alterado, está sendo usado por outro usuário")
    Endif
  Endif
Endif
Return

A imagem escolhida não pode ter mais que 128 KB — é uma foto 3×4 de 120 x 160 pontos, e deve ser pequena para permitir recuperação e desenho de interface rápidos.

E, por final a função auxiliar ReadFile() que lê um arquivo binário do disco e retorna seu conteúdo em uma String AdvPL a seguir:

STATIC Function ReadFile(cFile)
Local cBuffer := ''
Local nH , nTam
nH := Fopen(cFile)
IF nH != -1
  nTam := fSeek(nH,0,2)
  fSeek(nH,0)
  cBuffer := space(nTam)
  fRead(nH,@cBuffer,nTam)
  fClose(nH)
Else
  MsgStop("Falha na abertura do arquivo ["+cFile+"]","FERROR "+cValToChar(Ferror()))
Endif
Return cBuffer

Pronto

Com tudo isso setado compile os fontes execute, teste,etc. Lembre-se de criar a pasta temp a partir do RootPAth do ambiente. Após entrar na Agenda e acessar a consulta, será mostrado o primeiro contato, com a imagem padrão.

Foto 1

Agora, clicamos no botão “Foto 3×4”, e será apresentada a caixa de diálogo abaixo:

Foto 2

No campo acima, você pode informar manualmente o caminho completo seguido do nome do arquivo de imagem a ser carregado — formatos BMP, PNG, JPG, TIFF — ou usar o botão “Buscar”

foto 3

O Botão de busca abre a interface acima, para escolhermos um arquivo de imagem a partir do RootPath do servidor. Após selecionar o arquivo desejado, clique no botão de confirmação — esse da esquerda com um  “v” vezinho verde. A caixa de diálogo de busca de arquivos será fechada, e o campo do formulário anterior será preenchido com o caminho e nome do arquivo escolhido.

foto 4

Agora, ao clicarmos no botão OK, a imagem será carregada e salva no campo memo chamado “IMAGE” do contato atualmente na tela. Em caso de sucesso, será mostrada a imagem abaixo:

Crud - Foto 6

Ao fechar esta caixa de diálogo, a nova foto atribuída ao contato é mostrada na tela.

foto 5.png

Ao usar os botões de navegação, cada contato posicionado mostrará a foto correspondente.

Conclusão

Não foi fácil chegar ao fim desta implementação, durante os testes vários comportamentos estranhos e ajustes foram necessários. Por exemplo, o componente BITMAP possui uma otimização, para evitar carregar o mesmo arquivo duas vezes. Quando eu resolvi trocar a foto, o arquivo temporário no disco precisava ser apagado e recriado, mas o fato dele usar o mesmo nome, fazia com que a foto não fosse recarregada. Contornei este comportamento simplesmente carregando a foto padrão antes de recarregar a nova foto após a alteração, além de criar o arquivo com a imagem default apenas uma vez na entrada da agenda, e criar uma função para apagar o arquivo do cache em disco ao inserir ou alterar uma foto. Nos próximos POSTS, vamos incrementar mais um pouco este programa !!!!

*** Não entre em pânico, entre no GITHUB e pegue a versão final deste fonte ***

Desejo a todos novamente TERABYTES DE SUCESSO 😀

Referências