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

 

CRUD em AdvPL – Parte 11

Introdução

Gostou de localizar o endereço do contato da Agenda com o Google Maps ? Você usa G-Mail? Que tal apertar mais um botão na agenda, e o programa abrir o seu navegador de internet para você enviar um e-mail para um contato?

Mais um Botão

Na mesma linha do post anterior, apenas mais um botão, que somente estará ativo na tela caso o campo e-Mail do contato esteja preenchido.

@ 110,05 BUTTON oBtnMail PROMPT "G-Mail" SIZE 60,15 ;
   WHEN !empty(cEMAIL) ; 
   ACTION SendMail(cEMAIL) OF oPanelNav PIXEL
aadd(aBtns,oBtnMap) // [14] e-Mail

Agora, vamos criar a função que abre o Browse. Para este truque funcionar, você deve ser um usuário do G-Mail, e estar autenticado com a sua conta do Google no Browse. A URL não poderia ser mais simples:

STATIC Function SendMail(cEMAIL)
Local cMailURL := 'https://mail.google.com/mail/?view=cm&fs=1&tf=1&to='
shellExecute("Open", cMailURL+lower(cEMAIL), "", "", 1 )
Return

Agora, após abrir a consulta da agenda, e encontrar o contato para o qual você deseja enviar o e-mail, basta acionar o botão “G-Mail”:

GRud - Mail 1

Ao acionar o botão “G-Mail”, o seu navegador de internet padrão deve ser aberto, com a interface de envio de uma nova mensagem do G-Mail, já com o e-mail do destinatário preenchido. Basta colocar o assunto, preencher o corpo do e-Mail e enviar 😀

Crud - Mail 2

Outas formas de envio

Agradecendo a dica do Izac Ciszevski, por que não abrir uma janela de diálogo usando um componente de Browser do próprio SmartClient, como por exemplo o TIBrowser() ou o TWebEngine()? Claro, apenas trocamos a função SendMail(), vamos ver como fica:

STATIC Function SendMail(cEMAIL)
Local cMailURL := 'https://mail.google.com/mail/?view=cm&fs=1&tf=1&to='
Local oDlgMail
Local oWebBrowse
Local cTitle := "Enviar eMail ("+Alltrim(Lower(cEMAIL))+")"

DEFINE DIALOG oDlgMail TITLE (cTitle) ;
   FROM 0,0 TO 600,800 PIXEL

oWebBrowse := TWebEngine():New(oDlgMail, 0, 0, 100, 100)
oWebBrowse:Align := CONTROL_ALIGN_ALLCLIENT
oWebBrowse:Navigate(cMailURL+Alltrim(lower(cEMAIL)))

ACTIVATE DIALOG oDlgMail CENTER

Return

Resolvi montar o exemplo sobre a TWEBEngine() mesmo, pois inclusive ela não exige nenhuma configuração adicional no SmartClient, o que não é o caso da TIBrowser(). No primeiro acesso, tive que me autenticar no GMAIL, e uma vez autenticado, o recurso funcionou como o esperado.

Para ver maiores detalhes sobre a documentação das classes acima, consulte os links de referência no final do post, inclusive verifique que a classe TWebEngine() é mais recente, mas apenas está disponível a partir do APPServer Build 7.00.170117A.

Conclusão

As vezes os recursos mais legais e úteis de um programa são os mais simples. Com apenas meia dúzia de linhas, um botão e uma STATIC Function, e está feita mais uma integração usando um serviço do Google !!!

Desejo novamente a todos TERABYTES de SUCESSO !!!

Referências

 

CRUD em AdvPL – Parte 10

Introdução

No último post, acrescentamos um botão de pesquisa de CEP. Agora, que tal mostrarmos o endereço do contato em foco no Google Maps? Vai ser mais rápido e fácil do que você imagina!

Crud - Mapa

Acrescentando mais um botão

No menu de ações do lado direito da tela, vamos acrescentar um botão chamado “Mapa”:

@ 95,05 BUTTON oBtnMap PROMPT "Mapa" SIZE 60,15 ;
   ACTION ShowMap(oDlg,aBtns,aGets) OF oPanelNav PIXEL
aadd(aBtns,oBtnMap) // [13] Mapa

Agora, vamos criar a função que vai fazer a mágica. É mais simples do que parece.

STATIC Function ShowMap(oDlg,aBtns,aGets)
Local nPos
Local cEndereco
Local cCidade
Local cUF
Local cCEP
Local cMapsURL := 'https://www.google.com/maps/search/?api=1&query='
Local cUrlQry := ''

// Busca nos GETS os campos para montar uma Query de busca
// de endereço para o Google Maps

nPos := ascan(aGets , {|x| x[1] == "ENDER" } )
cEndereco := alltrim(Eval( aGets[nPos][2]:bSetGet ))
If !empty(cEndereco)
   cUrlQry += UrlEscape(cEndereco+',')
Endif

nPos := ascan(aGets , {|x| x[1] == "CIDADE" } )
cCidade := alltrim(Eval( aGets[nPos][2]:bSetGet ))
If !empty(cCidade)
   cUrlQry += UrlEscape(cCidade+',')
Endif

nPos := ascan(aGets , {|x| x[1] == "UF" } )
cUF := Eval( aGets[nPos][2]:bSetGet )
If !empty(cUF)
   cUrlQry += UrlEscape(cUF+',')
Endif

nPos := ascan(aGets , {|x| x[1] == "CEP" } )
cCep := alltrim(Eval( aGets[nPos][2]:bSetGet ))
If !empty(cCidade)
   cUrlQry += UrlEscape(cCEP)
Endif

If Empty(cUrlQry)
  MsgStop("Nao há dados preenchidos suficientes para a busca.")
  Return
Endif

// Ao sumbeter uma URL, o sistema operacional abre o navegador 
// padrão com o endereço fornecido
shellExecute("Open", cMapsURL+cUrlQry, "", "", 1 )

Return

Simples assim, ao estar posicionado em um contato da agenda, você clica no botão “Mapa”, e caso pelo menos alguma informação do endereço esteja preenchida, ela será usada para montar uma URL abrindo o Google Maps, para fazer a busca do endereço fornecido.  E, como os dados do formulário podem conter caracteres especiais que devem entrar como informações dentro da URL, usamos a função URLEscape(), também acrescentada no código, vide fonte abaixo:

STATIC Function UrlEscape(cInfo)
cInfo := strtran(cInfo,'%',"%25")
cInfo := strtran(cInfo,'&',"%26")
cInfo := strtran(cInfo," ","+")
cInfo := strtran(cInfo,'"',"%22")
cInfo := strtran(cInfo,'#',"%23")
cInfo := strtran(cInfo,",","%2C")
cInfo := strtran(cInfo,'<',"%3C")
cInfo := strtran(cInfo,'>',"%3E")
cInfo := strtran(cInfo,"|","%7C")
Return cInfo

Existem mais caracteres que poderiam ser tratados, mas para uma versão inicial, um tratamento básico é suficiente.

Conclusão

Não é legal apertar um botão em uma agenda e abrir um mapa mostrando onde fica o endereço ? Antes da Internet, você teria que fazer — ou comprar feito — algum software especifico — e provavelmente caro — para fazer algo assim. Hoje, a sua aplicação não precisa fazer tudo por ela mesma, usar APIs prontas e outros recursos — a maioria deles gratuito (desde que não utilizados para fins comerciais) — torna uma aplicação mais completa, amigável, agrega valor, atrai usuários, enfim…. 🙂

Novamente desejo a todos TERABYTES DE SUCESSO !!

Referências

TDN – ShellExecute

 

 

CRUD em AdvPL – Parte 09

Introdução

Em cada post sobre o CRUD, vamos melhorando partes do código e acrescentando funcionalidade. Neste tópico, vamos acrescentar uma Busca de CEP na Internet, para fazer o preenchimento automático de alguns campos do endereço.

Botão de Consulta de CEP

Para disparar a busca, vamos aproveitar o valor preenchido no campo GET de CEP da Interface, adicionando um botão com o título “Buscar CEP”, porém vamos usar uma pré-validação do Botão — propriedade bWhen do Objeto, acessada pelo comando @…BUTTON através da instrução WHEN <condição>. Quando a expressão usada na condição do botão for verdadeira, o botão torna-se ativo. Caso contrário, ele é desativado. Vamos ao fonte:

(...)
@ 110,60 GET oGet8 VAR cCEP PICTURE "@R 99999-999" ;
   SIZE CALCSIZEGET(9),12 OF oPanelCrud PIXEL

// Habilita a busca de CEP com um botão do lado do GET
// O Botão somente está disponível caso o oGet8 ( campo CEP )
// estiver habilitado para edição
@ 110,110 BUTTON oBtnCEP PROMPT "Buscar CEP" SIZE 60,14 ;
   WHEN (oGet8:LACTIVE) ; 
   ACTION BuscaCEP(oDlg,aBtns,aGets) OF oPanelCrud PIXEL

// Novos campos inseridos em 07/10
(...)


Para que o botão de Busca de CEP somente esteja ativo quando o GET do CEP estiver ativo, usamos a propriedade lActive do objeto GET do CEP (oCep) como condição WHEN do botão.

Função BuscaCEP()

A função de busca de CEP vai verificar se o CEP digitado está completo, rodar uma segunda função para buscar os dados do endereço daquele CEP na Internet, e validar o retorno. Caso os dados sejam buscados com sucesso, o programa mostra os dados encontrados e pergunta se ele deve atualizar os campos de endereço do formulário com os dados obtidos. Vamos ao fonte:

/* ---------------------------------------------------
Botão para busca de CEP e preenchimento de campos 
de endereço automaticamente. 
--------------------------------------------------- */
Static Function BuscaCEP(oDlg,aBtns,aGets)
Local nPos , cCEP
Local cJsonCEP
Local oJsonObj
Local aJsonFields := {}
Local nRetParser := 0
Local oJHashMap
Local lOk
Local cCEPEnder := ''
Local cCEPBairro := ''
Local cCepCidade := ''
Local cCEPUF := ''
Local lCEPERRO := .F.

// Busca o campo CEP nos Gets e recupera o valor informado
nPos := ascan(aGets , {|x| x[1] == "CEP" } )
cCep := Eval(aGets[nPos][2]:bSetGet)
cCep := alltrim(cCep)

// Verifica se o valor informado está completo - 8 dígitos
IF len(cCEp) < 8
  MsgStop("Digite o número do CEP completo para a busca.","CEP Inválido ou incompleto")
  Return
Endif

// Busca o CEP usando uma API WEB
// Em caso de sucesso, a API retorna um JSON
// Em caso de falha, uam string vazia
cJsonCEP := WebGetCep(cCEP)

If !empty(cJsonCEP)
  // Caso o CEP tenha sido encontrado, chama o parser JSON
  oJsonObj := tJsonParser():New()
  // Faz o Parser da mensagem JSon e extrai para Array (aJsonfields)
  // e cria tambem um HashMap para os dados da mensagem (oJHM)
  lOk := oJsonObj:Json_Hash(cJsonCEP, len(cJsonCEP), @aJsonfields, @nRetParser, @oJHashMap)
  If ( !Lok )
    MsgStop(cJsonCEP,"Falha ao identificar CEP",cCEP)
  Else
    // Obtem o valor dos campos usando o Hashmap gerado
    HMGet(oJHashMap, "erro", @lCEPERRO)
    if lCEPERRO
      MsgStop("CEP Inexistente na Base de Dados","Falha ao buscar CEP "+cCEP)
    Else
      HMGet(oJHashMap, "logradouro", @cCEPEnder)
      HMGet(oJHashMap, "bairro", @cCEPBairro)
      HMGet(oJHashMap, "localidade", @cCepCidade)
      HMGet(oJHashMap, "uf", @cCEPUF)
      cCEPEnder := padr(upper(cCEPEnder) ,50)
      cCEPBairro := padr(upper(cCEPBairro),30)
      cCepCidade := padr(upper(cCepCidade),40)
      cCEPUF := padr(Upper(cCEPUF) ,2)

      IF MsgYesNo("Endereço ... "+cCEPEnder + chr(10) + ;
        "Bairro ..... "+cCEPBairro + chr(10) + ;
        "Cidade ..... "+cCEPCidade+ chr(10) + ;
        "Estado ..... "+cCepUF+ chr(10) + ;
        "Deseja atualizar o formulário com estes dados?","CEP encontrado")

        nPos := ascan(aGets , {|x| x[1] == "ENDER" } )
        Eval(aGets[nPos][2]:bSetGet , cCEPEnder )
        nPos := ascan(aGets , {|x| x[1] == "BAIRR" } )
        Eval(aGets[nPos][2]:bSetGet , cCEPBAirro )
        nPos := ascan(aGets , {|x| x[1] == "CIDADE" } )
        Eval(aGets[nPos][2]:bSetGet , cCepCidade )
        nPos := ascan(aGets , {|x| x[1] == "UF" } )
        Eval(aGets[nPos][2]:bSetGet , cCepUF )
      Endif
    Endif
  Endif
  // Limpa os objetos utilizados
  FreeObj(oJsonObj)
  FreeObj(oJHashMap)
Endif
Return

A função WebGetCep() recebe como parâmetro o CEP a ser pesquisado, em formato cartactere. Ela será a responsável bor buscar o CEP na Internet, usando a API oferecida pelo site viacep.com.br — vide deetalhes nas referências no final desse post.

Em caso de indisponibilidade do serviço, a função WebGetCep() deve retornar uma string vazia. Caso contrário, ela retorna uma string em formato JSON, que modemos parsear usando uma classe nativa do AdvPL, que retorna um objeto HashMap, para acelerar a busca pelas informações desejadas. Como a API já tem um formato pré-definido de retorno, basta procurarmos as condições que nos interessam.

Função WebGetCep()

Essa aqui é a responsável pela “mágica” — a chamada da API WEB disponível através de um método GET em HTTP, usando a função HttpGet() do AdvPL, e tratando um possível retorno de erro. Vamos ao código:

STATIC Function WebGetCep(cCEP)
Local cUrl , cJsonRet
Local nCode , cMsg := ''
// Montando a URL de pesquisa
cUrl := 'http://viacep.com.br/ws/'+cCEP+'/json/'
// Buscando o CEP
cJsonRet := httpget(cUrl)
// Verificando retorno 
If empty(cJsonRet)
  nCode := HTTPGETSTATUS(@cMsg)
  MsgStop(cMsg+" ( HTTP STATUS = "+cValToChar(nCode)+" )","Falha na Busca de CEP")
Endif
Return cJsonRet

A função é bem simples, a requisição também, e o tratamento de erro mais ainda. Caso a requisição volte um conteúdo vazio, pode ser uma indisponibilidade do serviço ou da conexão com a internet, seja o que for, o status de erro é recuperado pela função HttpGetStatus().

Busca de CEP funcionando

Primeiro entramos na agenda, acionamos a consulta, mostramos um registro desejado e clicamos em “Alterar” :

CRUD - Busca CEP 1.png

Feito isso, vamos digitar um CEP, por exemplo 18603-730, e clicamos no botão “Buscar CEP”. Caso a busca de CEP tenha sido executada com sucesso, devemos ver na tela a seguinte mensagem:

CRUD - Busca CEP 2

Vamos confirmar a operação, clicando em “Yes”, e vamos ver como ficou a tela com os dados do contato — os dados destacados em vermelho foram alterados.

CRUD - Busca CEP 3

Agora, basta clicar em “Salvar” para persistir as alterações deste contato no Banco de Dados.  😀

Conclusão

Com um fonte modularizado, fica fácil acrescentar novas funcionalidades sem ter que virar o código original do avesso.  Nos próximos posts, vamos começar a separar o processamento dos dados, e tentar deixar as funcionalidades do código mais dinâmicas.

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

Referências

 

CRUD em AdvPL – Parte 08

Introdução

Prontos para mais um capítulo da novela do CRUD? Neste post vamos fazer algumas alterações no layout dos componentes, e acrescentar as funcionalidades de busca indexada por ID e NOME e mudança de ordem de consulta. O fonte completo está disponível no GITHUB, link disponível no final do post.

Alteração da disposição dos componentes

Os botões de navegação “Primeiro”, “Anterior”, “Próximo” e “Último”, que antes eram dispostos horizontalmente na parte de baixo do formulário de campos da Agenda, serão remanejados para a direita do formulário, verticalmente, e com o espaço que ganhamos, vamos acrescentar mais alguns botões.

Crud V2 Consulta

Para isso ser feito de forma simples, primeiro criamos um painel a mais na caixa de diálogo, e colocamos seu alinhamento à direita.

@ 0,0 MSPANEL oPanelNav OF oDlg SIZE 70,600 COLOR CLR_WHITE,CLR_GRAY
oPanelNav:ALIGN := CONTROL_ALIGN_RIGHT

Agora, todos os botões de navegação, inclusive os novos botões de consulta e ordem, são acrescentados neste painel. Praticamente aproveitamos todas as coordenadas dos botões do menu de opções do painel esquerdo, afinal as coordenadas dos componentes são sempre relativas à coordenada 0,0 (canto superior esquerdo) do seu container — no caso um objeto tPanel.

// Cria os Botões de Navegação Livre
@ 05,05 BUTTON oBtnFirst PROMPT "Primeiro" SIZE 60,15 ;
  ACTION ManAgenda(oDlg,aBtns,aGets,7,@nMode) OF oPanelNav PIXEL
aadd(aBtns,oBtnFirst) // [7] Primeiro

@ 020,05 BUTTON oBtnPrev PROMPT "Anterior" SIZE 60,15 ;
  ACTION ManAgenda(oDlg,aBtns,aGets,8,@nMode) OF oPanelNav PIXEL
aadd(aBtns,oBtnPrev) // [8] Anterior

@ 35,05 BUTTON oBtnNext PROMPT "Próximo" SIZE 60,15 ;
  ACTION ManAgenda(oDlg,aBtns,aGets,9,@nMode) OF oPanelNav PIXEL
aadd(aBtns,oBtnNext) // [9] Proximo

@ 50,05 BUTTON oBtnLast PROMPT "Último" SIZE 60,15 ;
  ACTION ManAgenda(oDlg,aBtns,aGets,10,@nMode) OF oPanelNav PIXEL
aadd(aBtns,oBtnLast) // [10] Último

@ 65,05 BUTTON oBtnPesq PROMPT "Pesquisa" SIZE 60,15 ;
  ACTION ManAgenda(oDlg,aBtns,aGets,11,@nMode) OF oPanelNav PIXEL
aadd(aBtns,oBtnPesq) // [11] Pesquisa

@ 80,05 BUTTON oBtnOrd PROMPT "Ordem" SIZE 60,15 ;
  ACTION ManAgenda(oDlg,aBtns,aGets,12,@nMode) OF oPanelNav PIXEL
aadd(aBtns,oBtnOrd) // [12] Ordem

A função ManAgenda() agora passa a receber as ações 11 (Pesquisa) e 12 (Ordem). Logo, teremos que implementar estas ações. Mas antes tem uma parte do código que podemos simplificar.

Escondendo os botões de navegação

Na versão anterior do programa Agenda, os botões de navegação eram criados a partir do painel de visualização e edição de registros da agenda (oPanelCrud), e para esconder ou mostrar os botões de navegação, era necessário endereçar cada botão individualmente. Dessa forma, o fonte de ligar e desligar os botões de navegação ficaria assim:

// -------------------------------------------------
// Habilita ou desabilita os botões de navegação
// -------------------------------------------------
STATIC Function SetNavBtn(aBtns,lEnable)
IF lEnable
  aBtns[7]:Show() // Primeiro
  aBtns[8]:Show() // Anterior
  aBtns[9]:Show() // Proximo
  aBtns[10]:Show() // Ultimo
  aBtns[11]:Show() // Pesquisa
  aBtns[12]:Show() // Ordem
Else
  aBtns[7]:Hide() // Primeiro
  aBtns[8]:Hide() // Anterior
  aBtns[9]:Hide() // Proximo
  aBtns[10]:Hide() // Ultimo
  aBtns[11]:Hide() // Pesquisa
  aBtns[12]:Hide() // Ordem
Endif
Return

Agora, que os botões de navegação estão dentro de um painel, podemos simplesmente esconder ou mostrar o painel de navegação inteiro, apenas com uma instrução. E nós não precisamos sequer passar o objeto do Painel como parâmetro, veja a nova função abaixo:

STATIC Function SetNavBtn(aBtns,lEnable)
Local oPanel := aBtns[7]:oParent 
If lEnable
  oPanel:Show()
Else
  oPanel:Hide()
Endif
Return

Desta forma, pegamos o objeto apenas do sétimo botão — botão “Primeiro” — e através dele pegamos o objeto do componente onde ele foi criado usando a propriedade oParent. Assim, conseguimos esconder e mostrar o painel inteiro — e automaticamente todos os componentes criados dentro dele.

Podemos também, ao invés de esconder e mostrar o painel, podemos desabilitar o painel, de modo que o painel e seus componentes fiquem visíveis, mas não possam ser acionados. Neste caso, o fonte ficaria assim:

STATIC Function SetNavBtn(aBtns,lEnable)
Local oPanel := aBtns[7]:oParent
oPanel:SetEnable(lEnable)
Return

Definindo a ordem de consulta

Quando entramos na opção de consulta, a aplicação troca a ordem de navegação da tabela — usando a função DbSetOrder() — para ordem alfabética pelo nome do contato da agenda, usando o índice criado a partir do campo NOME. Quando confirmamos a inclusão de um novo registro, a ordem pode ser alterada para ID, caso seja necessário determinar o último número registrado na Agenda para incrementar e gerar o próximo ID.

Neste momento, vamos criar um recurso para permitir mudar por nossa conta a ordem de navegação da tabela em modo de consulta, mas antes precisamos mostrar em algum lugar qual a ordem que está sendo utilizada atualmente.

Painéis e alinhamentos

Vamos criar um painel superior, dentro da área usada para os campos do formulário, e dentro dele vamos colocar a informação da ordem em uso. Vamos aproveitar a possibilidade de criar um painel dentro de outro, para criar um painel central, onde hoje é criado o painel para CRUD, e dentro desse painel central, colocamos um painel com alinhamento superior, para colocar a informação sobre a ordenação do arquivo, e na área que sobrou, colocamos o painel do CRUD. A implementação ficaria dessa forma:

@ 0,0 MSPANEL oPanelMenu OF oDlg SIZE 70,600 COLOR CLR_WHITE,CLR_GRAY
oPanelMenu:ALIGN := CONTROL_ALIGN_LEFT

@ 0,0 MSPANEL oPanelNav OF oDlg SIZE 70,600 COLOR CLR_WHITE,CLR_GRAY
oPanelNav:ALIGN := CONTROL_ALIGN_RIGHT

@ 0,0 MSPANEL oPanelCenter OF oDlg SIZE 700,600 COLOR CLR_WHITE,CLR_LIGHTGRAY
oPanelCenter:ALIGN := CONTROL_ALIGN_ALLCLIENT

@ 0,0 MSPANEL oPanelOrd OF oPanelCenter SIZE 100,20 COLOR CLR_WHITE,CLR_BLUE
oPanelOrd:ALIGN := CONTROL_ALIGN_TOP

@ 0,0 MSPANEL oPanelCrud OF oPanelCenter SIZE 700,600 COLOR CLR_WHITE,CLR_LIGHTGRAY
oPanelCrud:ALIGN := CONTROL_ALIGN_ALLCLIENT

Reparem que os painéis oPanelCrud e oPanelOrd são criados a partir do oPanelCenter, que pega todo o espaço da DIALOG que sobrou depois de alinhar o painel oPanelMenu à esquerda e o oPanelNav a direita.

Se você pensar bem, criar um painel superior para mostrar a ordem de índice … não é um tiro de canhão para matar uma mosca ? Não necessariamente, afinal para eu criar este objeto TSAY na parte superior, dentro do painel do CRUD, seria necessário realinhar todos os componentes mais pra baixo, para abrir espaço para este TSAY. Da forma que foi feita, eu não precisei alterar nenhuma coordenada, apenas criei a sequência de painéis, e se amanhã eu achar que a ordem fica mais legal em baixo, basta eu mudar o alinhamento do painel, simples assim.

Mostrando a ordem de consulta atual

Dentro do painel oPanelOrd, vamos colocar um componente visual para informar a ordenação atual de consulta do arquivo. Neste caso, vamos usar um objeto tSay:

// Mostra Ordenação atual do arquivo de agenda
@ 5,5 SAY oSayOrd PROMPT " " SIZE 100,12 COLOR CLR_WHITE,CLR_BLUE OF oPanelOrd PIXEL
oSayOrd:SetText("Ordem .... "+ AGENDA->(IndexKey()))

Na abertura do programa, a tabela AGENDA é aberta com o ALIAS “AGENDA”, então para simplificar a implementação, eu apenas seto o texto do objeto tSay para colocar a chave de índice da ordem atual da tabela, obtida com a função IndexKey(). Logo, a nova tela de abertura da Agenda deve ficar assim:

Crud V2 Entrada

As trocas de ordem do arquivo são feitas dentro da função ManAgenda(), mas o componente de interface que mostra a ordem é um Objeto TSay, que não é passado como parâmetro. Logo, vamos passar ele como um novo parâmetro para a função ManAgenda(), e atualizá-lo quando necessário, usando a mesma fórmula anteriormente usada, mas sendo executada para pegar o estado atual.

Mudando a Ordem

Pensando novamente em solução SIMPLES, a ação do botão “Ordem” deve apenas trocar a ordem para ID ou NOME. Existem inúmeras formas de se fazer isso, porém como o objetivo é ser simples, e são apenas 2 ordens para escolher, eu optei pela implementação mais simples:

(...)
ElseIf nAction == 12 // Troca de Ordem
   IF ChangeOrd(oDlg)
      // Se a ordem foi trocada 
      // Atualiza texto com a chave do indice em uso 
      oSayOrd:SetText("Ordem .... "+ AGENDA->(IndexKey()))
   Endif
Else 
(...)

E, para permitir a escolha, a nova função ChangeOrd()

Static Function ChangeOrd(oDlg)
Local nOrdAtu := AGENDA->(IndexOrd())
Local nNewOrd := 0
If nOrdAtu == 1 
  If MsgYesNo("Deseja alterar para ordem de NOME ?")
    nNewOrd := 2
  Endif
Else
  If MsgYesNo("Deseja alterar para ordem de ID ?")
    nNewOrd := 1
  Endif
Endif
if ( nNewOrd > 0 ) 
  AGENDA->(DBSETORDER(nNewOrd))
  Return .T.
Endif
return .F.

Implementando a Busca sobre o índice

E, para finalizar, vamos fazer a busca rápida sobre o índice, na ação 11. Para isso, vamos perguntar ao operador do programa, o que ele procura. A ordem de busca usada será a ordem atual. Primeiro, dentro da função ManAgenda(), vamos inserir a execução da ação 11 — Pesquisa.

(...)
ElseIf nAction == 11 // Pesquisa Indexada

   // Realiza a busca pelo índice atual 
   PesqIndeX(oDlg)

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

Else
(...)

Agora, vamos implementar a funcionalidade de busca, acrescentando as duas funções abaixo:

STATIC Function PesqIndeX(oDlgParent)
Local oDlgPesq 
Local cTitle
Local cStrBusca
Local nTamanho
Local nRecSave 
Local lFound := .F.
Local cIndexFld := AGENDA->(Indexkey())
Local oGet1 , oBtn1

// Monta titulo da janela de pesquisa
cTitle := 'Pesquisa por '+ cIndexFld

// Guarda numero do registro atual 
nRecSave := AGENDA->(Recno())

If indexord() == 1 // Campo ID
  nTamanho := 6
  cStrBusca := space(nTamanho)
  cPicture := "@9"
ElseIf indexord() == 2 // Campo NOME
  nTamanho := 50
  cStrBusca := space(nTamanho)
  cPicture := "@!"
Endif

DEFINE DIALOG oDlgPesq TITLE (cTitle) ;
   FROM 0,0 TO 120,415 PIXEL;
   OF oDlgParent ; 
   COLOR CLR_BLACK, CLR_LIGHTGRAY

@ 05,05 GET oGet1 VAR cStrBusca PICTURE (cPicture) SIZE CALCSIZEGET(nTamanho) ,12 OF oDlgPesq PIXEL

@ 25,05 BUTTON oBtn1 PROMPT "Buscar" SIZE 60,15 ;
   ACTION IIF( SeekAgenda(cIndexFld,cStrBusca) , (lFound := .T. , oDlgPesq:End()) , oGet1:SetFocus() ) OF oDlgPesq PIXEL

ACTIVATE DIALOG oDlgPesq CENTER

If !lFound
   // Nao achou, volta ao registro antes da busca 
   AGENDA->(dbgoto(nRecSave))
Endif

Return

// Ajusta o valor informado na tela de acordo com o campo / indice 
// para fazer a busca corretamente
STATIC Function SeekAgenda(cIndexFld,cStrBusca)
IF cIndexFld == 'ID'
   cStrBusca := strzero(val(cStrBusca),6)
ElseIF cIndexFld == 'NOME'
   cStrBusca := alltrim(cStrBusca)
Endif
If !DbSeek(cStrBusca)
   MsgStop("Informação não encontrada.","Busca por ["+cStrBusca+"]")
   Return .F.
Endif
return .T.

Funcionamento e considerações

A função de busca utilizada  — DBSeek() — vai posicionar no primeiro registro que satisfazer a chave informada. No caso no NOME, pode ser informado apenas uma ou mais primeiras letras do nome, e se houver um nome que comece com estas letras, ele será o registro que vai ser trazido na tela.

Caso a informação não seja encontrada, será exibida uma mensagem, e o programa retorna para a tela de entrada de valor de busca, para você alterar o valor informado ou digitar um valor novo. Caso o registro seja encontrado, a janela fecha sozinha, e o registro encontrado é trazido na tela.

Conclusão

Daqui a pouco esse CRUD vira um produto … e ainda têm muito mais para ser explorado. Quer a versão atualizada desse código ? Acesse o GITHUB na URL https://github.com/siga0984/Blog e faça download do arquivo AGENDA.PRW — devidamente atualizado. Basta compilar, e chamar a função U_AGENDA diretamente no SmartClient.

Referências

 

CRUD em AdvPL – Parte 07

Introdução

Continuando a sequência de posts relacionados ao CRUD em Advpl, onde criamos um exemplo de programa de Agenda, nesse post vamos olhar mais de perto a geração do ID na inclusão de dados da Agenda, como o ERP Microsiga usa sequenciadores nas tabelas de dados, e como podemos fazer um sequenciador em memória para a Agenda.

Interface de Inclusão – Gerador de ID

Passando rapidamente o olho no fonte, ela parece em ordem. Os identificadores de registro (ID) da Agenda são criados protegidos por um semáforo (ou MUTEX), sempre pegamos o último registro usando o índice por ID — Ordem 1 — e acrescentamos uma unidade. Perfeito, certo ?

Não é bem assim. Ao excluir um registro da agenda usando a aplicação, o registro é marcado para deleção — através da função DbDelete() — e devido ao filtro para ignorar registros marcados para deleção nas operações de busca e navegação da tabela — ligado no inicio da aplicação com o comando SET DELETED ON —  o registro marcado para exclusão não é mais visível nas consultas.  Como o primeiro contato com ID 000004 está deletado — ou marcado para deleção — no momento que eu vou inserir um novo contato, a rotina de geração de ID pega o último registro ATIVO da tabela — estamos desconsiderando deletados — lê o valor do registro, e incrementa uma unidade — gerando novamente o ID 000004.

Podemos arrumar isso de uma forma bem simples, apenas desligando o filtro para ignorar registros deletados — usando o comando SET DELETED OFF — e no final da rotina, depois de gerar o novo número, ligar o filtro novamente.

Como a numeração sequencial é feita no ERP ?

Imagine cada inserção feita em uma tabela com um campo com sequência incremental, precisar ir no Banco de Dados, posicionar e ler o último registro para gerar o próximo identificador da sequência ? É um desperdício de requisições, além de ser necessário um MUTEX bloqueando a inserção até ela ser concluída.

Para contornar isso, foram criadas no ERP duas tabelas de controle e reserva de sequência, chamadas de SXE e SXF. A idéia é simples, uma controla todos os registros de sequenciadores do ERP, e a outra controla as reservas de sequência — um processo pode reservar uma sequência para uso, e não confirmar o uso da sequência, então ela torna-se disponível para a próxima inserção, evitando intervalos vazios ou “buracos” nas sequências.

A implementação e a ideia são excelentes, porém com o aumento do número de tabelas do ERP, e todos os sequenciadores sendo controlados pelo mesmo arquivo, a quantidade de acesso a disco por processos concorrentes usando as sequências poderia gerar filas de acesso ao disco no sistema operacional, deixando o sistema lento.

Para resolver isso, o mecanismo de sequenciamento e reserva de sequências foi transferido para dentro do Servidor de Licenças do ERP, onde as sequências são controladas em memória, sem acesso a disco. Com isso, apenas a primeira geração do registro de controle da sequência precisa fazer um acesso a disco, ir no final da tabela, ler o último código, e criar o registro de sequenciamento. A partir de então, usando as mesmas funções de encapsulamento disponibilizadas pelo Framework AdvPL do ERP, as próximas requisições de um novo identificador da sequência são feitas para o Servidor de Licenças, de forma muito rápida, evitando acesso a disco desnecessário, e como todo o controle de sequenciamento é feito na memória, o tempo que a lista permanece bloqueada para a geração do identificador é ridículo.

Construindo um sequenciador para a Agenda

Partindo ainda da premissa que o programa de AGENDA será executado por hora apenas por um servidor de aplicação, podemos usar por exemplo uma variável global para guardar o último número gerado da agenda, e quando for realizada uma inclusão, resgatamos o número da memória, acrescentamos uma unidade, e atualizamos a variável global. Dessa forma, mesmo com múltiplas threads, cada uma delas ficará bloqueada para gerar um novo identificador por um tempo ínfimo, e a sequência sempre fica na memória, enquanto o servidor estiver no ar. Vamos ver como ficaria a função GetNewID() usando essa abordagem:

 

STATIC Function GetNewID()
Local cLastID,cNewId
Local nRetry := 0
While !GlbNmLock("AGENDA_ID")
   // Espera máxima de 1 segundo, 20 tentativas 
   // com intervalos de 50 milissegundos 
   nRetry++
   If nRetry > 20
      return ""
   Endif
   Sleep(50)
Enddo
cLastID := GetGlbValue("AGENDA_SEQ")
If Empty(cLastID) 
  // Somente busco na Tabela se eu nao tenho o valor na memoria
  DBSelectArea("AGENDA")
  DbsetOrder(1)
  DBGobottom()
  cLastId := AGENDA->ID
Endif
cNewId := StrZero( val(cLastID) + 1 , 6 )
PutGlbValue("AGENDA_SEQ",cNewID)
GlbNmUnlock("AGENDA_ID")
Return cNewId

Reparem como o fonte ficou praticamente do mesmo tamanho que era antes, porém agora seu comportamento está muito — muito mesmo — mais optimizado. Na primeira execução do programa, a variável global AGENDA_SEQ não existe em memória, logo a aplicação busca o último registro do banco de dados. Caso a global já exista, o valor do último ID utilizado é recuperado da memória. Então, criamos o novo ID, atualizamos a variável global de memória com este valor, soltamos o bloqueio nomeado obtido, e retornamos o número para a rotina de inserção.

Diferença de Tempo

Fazendo um teste de inserção usando uma função de teste sem interface, no meu ambiente consegui inserir 10 mil registros em pouco mais de 10 segundos — aproximadamente 1000 registros por segundo — inserindo apenas ID e um nome aleatório. Usando a rotina de geração de ID proposta, lendo os valores da memória, o tempo baixou de 10,5 s. para 5,5 s. — praticamente duas vezes mais rápido. Segue abaixo a função de testes utilizada:

User Function TesteAg1()
Local nI, nTimer
OpenAgenda()
nTimer := seconds()
For nI := 1 to 10000
  cNewId := GetNewID()
  dbappend()
  agenda->ID := cNewId
  agenda->NOME := cvaltochar(str(seconds()*1000))
  DBRUnlock()
Next
conout("Tempo de Insert = "+str(seconds()-nTimer,12,3)+' s.')
return

Esta função foi acrescentada ao fonte AGENDA.PRW, e executada de modo direto. Como a função OpenAgenda() não depende de nada, podemos chamá-la diretamente no nosso teste, para abrir a tabela de AGENDA e usá-la diretamente. Caso você querida fazer o teste comparativo, recomendo renomear a função original GetNewID() para GetNewId1(), inserir a nova como GetNewId2(), e chavear isso no programa de testes, rodando uma vez com dada função para verificar a diferença de tempo.

Restrição Operacional

Naturalmente, devido ao escopo da variável de memória global ser apenas a instância atual do serviço atual do Protheus Server, este tipo de semáforo em memória somente poderia ser usado por exemplo em um ambiente com balanceamento de carga — e consequentemente múltiplos serviços — caso este controle fosse centralizado em um serviço dedicado, e os demais serviços consumissem estas funções fazendo chamadas remotas (RPC Nativo do AdvPL, por exemplo).

Conclusão

Por hora, nada mais a acrescentar. Ao testar a agenda, já encontrei outros pontos que precisam de ajustes, vamos deixar as conclusões para o próximo post.

Desejo a todos novamente TERABYTES de SUCESSO 😀

Referências

 

CRUD em AdvPL – Parte 06

Introdução

Neste post, vamos dar uma incrementada na Agenda, acrescentando 3 novos campos —  FONE1, FONE2 e EMAIL — fazendo mínimas alterações no código, e alterando a estrutura da tabela AGENDA no Banco de Dados.

Inserindo novos campos na Agenda

Pode parecer complicado, mas algumas partes do programa Agenda.PRW já foram criadas pensando em haver mudanças ou novas implementações. Para acrescentarmos mais campos na tabela de Agenda, vamos aproveitar a função separada de criação da tabela e índices, para também verificar e alterar a estrutura da tabela atual caso ela já exista sem estar com nas novas colunas.

Primeira parte – Interface

Acrescentar os novos campos na interface é a parte mais simples. Criamos novos objetos de GET, colocamos eles nos Arrays de controle, criamos as posições de interface, aumentamos 50 pixels na altura da janela, deslocamos todos os botões de navegação, confirmar e voltar 50 pixels para baixo, e declaramos as variáveis a serem usadas. Como a passagem de parâmetros para as funções de controle sempre passam o Array com os objetos GET, nenhuma passagem de parâmetros adicional foi necessária.

Local cFone1 := Space(20)
Local cFone2 := Space(20)
Local cEmail := Space(40)
// Novos campos inseridos em 07/10
@ 125,60 GET oGet9 VAR cFone1 PICTURE "@!" SIZE CALCSIZEGET(20),12 OF oPanelCrud PIXEL
@ 140,60 GET oGetA VAR cFone2 PICTURE "@!" SIZE CALCSIZEGET(20),12 OF oPanelCrud PIXEL
@ 155,60 GET oGetB VAR cEMAIL PICTURE "@!" SIZE CALCSIZEGET(40),12 OF oPanelCrud PIXEL
// Novos campos inseridos em 07/10
aadd( aGets , {"FONE1" , oGet9 , space(20) } )
aadd( aGets , {"FONE2" , oGetA , space(20) } )
aadd( aGets , {"EMAIL" , oGetB , space(40) } )

Segunda parte – tabela AGENDA

O programa trabalha com uma tabela de dados criada em um Banco de Dados relacional acessado pelo DBAccess. Originalmente estes campos não existiam na tabela, não há alteração, apenas acrescentar campos novos. Para esta tarefa, vamos usar a função TCAlter(), e mexer apenas na função de criação e abertura da tabela AGENDA — no nosso caso, a função OpenAgenda(), vide novo fonte abaixo:

STATIC Function OpenAgenda()
Local nH
Local cFile := "AGENDA"
Local aStru := {}
Local aDbStru := {}
Local nRet

// Conecta com o DBAccess configurado no ambiente
nH := TCLink()

If nH < 0
  MsgStop("DBAccess - Erro de conexao "+cValToChar(nH))
  QUIT
Endif


// 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})

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) EXCLUSIVE NEW VIA "TOPCONN"
  aDbStru := DBStruct()
  USE

  If len(aDbStru) <> len(aStru)
    // O tamanho está diferente ? 
    // 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 AGENDA")
      QUIT
    Endif
    MsgInfo("Estrutura do arquivo AGENDA 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"
  nRet := TCUnique(cFile,"ID")
  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"
  INDEX ON ID TO (cFile+'1')
  USE
EndIf

If !tccanopen(cFile,cFile+'2')
  // Se o indice por nome nao existe, cria
  USE (cFile) ALIAS (cFile) EXCLUSIVE NEW VIA "TOPCONN"
  INDEX ON NOME TO (cFile+'2')
  USE
EndIf

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

If NetErr()
  MsgStop("Falha ao Abrir a Agenda em modo compartilhado.")
  QUIT
  Return .F. 
Endif

// Liga o filtro para ignorar registros deletados 
SET DELETED ON

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

Return .T.

Novo comportamento do fonte

A parte nova e interessante é avaliar a estrutura da tabela caso ela já exista. Usamos a função DBStruct() após abrir a tabela para verificar qual é a estrutura atual da tabela no Banco de Dados. E, na memória, verificamos o tamanho desta estrutura com o array aStru, que contém a lista de campos com a estrutura atual (nova) da tabela.

Caso os arrays estejam diferentes, a tabela existente no SGDB precisa de alteração para contemplar os novos campos. Neste caso, com a tabela FECHADA, chamamos a função TCAlter(), informando o nome da tabela a ser alterada, o array com a estrutura atual da tabela segundo o banco de dados, e o array com a nova estrutura.

Internamente, a função TCAlter() vai verificar as diferenças entre as estruturas — que no caso serão apenas a adição de novos campos — e o DBAccess vai definir a sequência de operações que serão submetidas ao Banco de Dados para acrescentar estas colunas,

Logo, no primeiro acesso ao fonte, as estruturas estarão diferentes, e o programa vai executar a TCAlter() para inserir os novos campos. Em uma segunda execução, as estruturas já terão o mesmo tamanho, e esta operação não será mais necessária.

Demais proteções

Ainda faltam no fonte algumas proteções básicas, como por exemplo:

  • Proteger a rotina de abertura de tabela com um MUTEX, para evitar que dois processos tentem ao mesmo tempo fazer a criação ou alteração da tabela, bem como a criação dos índices.
  • Proteger as tentativas de abertura de modo EXCLUSIVE da tabela para manutenção, verificando após cada tentativa se a tabela foi realmente aberta, verificando o retorno da função NETERR(), ou verificando o alias atual usando a função ALIAS().

Outros tipos de alteração estrutural

A função TCAlter() apenas repassa a tabela e as estruturas ao DBAccess, que avalia de acordo com o tipo do banco de dados em uso quais as etapas necessárias para fazer a tabela partir da estrutura atual para chegar na nova estrutura informada. A comparação entre as estruturas é feita baseado no nome do campo, e identifica os seguintes casos:

  1. Inclusão de novo campo — o campo existe no segundo array mas não existe no primeiro.
  2. Alteração de tipo de campo — o campo existe nos dois arrays, mas o tipo do campo está diferente. A troca de tipo de um campo numérico inteiro (sem decimais) para caractere realiza internamente a conversão dos dados, sem haver perda do conteúdo. Qualquer outra troca de tipo será tratada internamente como se a coluna fosse eliminada e criada novamente com o tipo novo, com seu conteúdo vazio (default).
  3. Alteração de tamanho de campo — o campo existe nos dois arrays, mas o tamanho foi aumentado ou diminuído — alguns bancos de dados não suportam que uma operação destas seja feita diretamente, principalmente a redução do tamanho do campo. Nestes casos, o DBAccess internamente realiza uma sequencia de etapas — de acordo com o banco de dados eu uso — para no final do processo conseguir fazer a alteração mantendo os dados originais da coluna. Em alguns bancos, pode ser necessário que o DBAccess faça um BACKUP interno da tabela, crie ela novamente com a nova estrutura, e importe novamente os dados da tabela de Backup no formato adequado.
  4. Exclusão da coluna – o campo existe no primeiro Array, mas não existe no segundo.

Conclusão

O programa de CRUD já está ficando mais esperto do que a sua primeira versão, e ainda existem muitas possibilidades de melhoria. Não há melhor aprendizado do que ter um bom programa de exemplo nas mãos, e entender por quê ele precisa evoluir, e como podemos fazer isso. Aguardem mais surpresas e recursos nos próximos posts do CRUD.

Desejo novamente a todos TERABYTES de SUCESSO !!!!

Referências