Tela de autenticação customizada no Protheus

Olá pessoal…

Hoje vou mostrar como fazer uma tela de autenticação customizada no Protheus.

Essa tela customizada, serve tanto para o desenvolvimento de rotinas que necessitem de um login, ao invés de abrir o convencional sigamdi, como também, serve para chamar alguma validação dentro de alguma rotina, por exemplo, somente se o usuário forçar o login e a senha, pode prosseguir para a alteração do produto.

Update 20/08/2021:

Pessoal, nas versões mais novas do Protheus, as funções PswOrder, PswSeek e PswName foram descontinuadas. Abrimos um chamado perguntando como poderíamos prosseguir, e nos disseram que a função RPCSetEnv retorna .T. ou .F. em caso de sucesso do login, então foi adaptado o fonte abaixo, substituindo as funções antigas, diretas pelo RPCSetEnv.

Abaixo o conteúdo do artigo.

A rotina valida se o usuário existe, caso não exista é mostrado uma mensagem.

Usuário não encontrado

Usuário não encontrado

Caso o usuário exista, mas a senha esteja inválida, é mostrado outra mensagem.

Senha inválida

Senha inválida

Abaixo o código fonte utilizado:

//Bibliotecas
#Include "Protheus.ch"

/*/{Protheus.doc} zLogin
Função para montar a tela de login simplificada
@type function
@author Atilio
@since 17/09/2015
@version 1.0
	@param cUsrLog, Caracter, Usuário para o login (ex.: "admin")
	@param cPswLog, Caracter, Senha para o login (ex.: "123")
	@return lRet, Retorno lógico se conseguiu encontrar o usuário digitado
	@example
	//Verificando se o login deu certo
	If u_zLogin(@cUsrAux, @cPswAux)
		//....
	EndIf
/*/

User Function zLogin(cUsrLog, cPswLog)
	Local aArea := GetArea()
	Local oGrpLog
	Local oBtnConf
	Private lRetorno := .F.
	Private oDlgPvt
	//Says e Gets
	Private oSayUsr
	Private oGetUsr, cGetUsr := Space(25)
	Private oSayPsw
	Private oGetPsw, cGetPsw := Space(20)
	Private oGetErr, cGetErr := ""
	//Dimensões da janela
	Private nJanLarg := 200
	Private nJanAltu := 200
	
	//Criando a janela
	DEFINE MSDIALOG oDlgPvt TITLE "Login" FROM 000, 000  TO nJanAltu, nJanLarg COLORS 0, 16777215 PIXEL
		//Grupo de Login
		@ 003, 001 	GROUP oGrpLog TO (nJanAltu/2)-1, (nJanLarg/2)-3 		PROMPT "Login: " 	OF oDlgPvt COLOR 0, 16777215 PIXEL
			//Label e Get de Usuário
			@ 013, 006   SAY   oSayUsr PROMPT "Usuário:"        SIZE 030, 007 OF oDlgPvt                    PIXEL
			@ 020, 006   MSGET oGetUsr VAR    cGetUsr           SIZE (nJanLarg/2)-12, 007 OF oDlgPvt COLORS 0, 16777215 PIXEL
		
			//Label e Get da Senha
			@ 033, 006   SAY   oSayPsw PROMPT "Senha:"          SIZE 030, 007 OF oDlgPvt                    PIXEL
			@ 040, 006   MSGET oGetPsw VAR    cGetPsw           SIZE (nJanLarg/2)-12, 007 OF oDlgPvt COLORS 0, 16777215 PIXEL PASSWORD
		
			//Get de Log, pois se for Say, não da para definir a cor
			@ 060, 006   MSGET oGetErr VAR    cGetErr        SIZE (nJanLarg/2)-12, 007 OF oDlgPvt COLORS 0, 16777215 NO BORDER PIXEL
			oGetErr:lActive := .F.
			oGetErr:setCSS("QLineEdit{color:#FF0000; background-color:#FEFEFE;}")
		
			//Botões
			@ (nJanAltu/2)-18, 006 BUTTON oBtnConf PROMPT "Confirmar"             SIZE (nJanLarg/2)-12, 015 OF oDlgPvt ACTION (fVldUsr()) PIXEL
			oBtnConf:SetCss("QPushButton:pressed { background-color: qlineargradient(x1: 0, y1: 0, x2: 0, y2: 1, stop: 0 #dadbde, stop: 1 #f6f7fa); }")
	ACTIVATE MSDIALOG oDlgPvt CENTERED
	
	//Se a rotina foi confirmada e deu certo, atualiza o usuário e a senha
	If lRetorno
		cUsrLog := Alltrim(cGetUsr)
		cPswLog := Alltrim(cGetPsw)
	EndIf
	
	RestArea(aArea)
Return lRetorno

/*---------------------------------------------------------------------*
 | Func:  fVldUsr                                                      |
 | Autor: Daniel Atilio                                                |
 | Data:  17/09/2015                                                   |
 | Desc:  Função para validar se o usuário existe                      |
 *---------------------------------------------------------------------*/

Static Function fVldUsr()
	Local cUsrAux := Alltrim(cGetUsr)
	Local cPswAux := Alltrim(cGetPsw)
	Local cCodAux := ""
	
	//Pega o código do usuário
	RPCClearEnv()
	If RpcSetEnv("01", "", cGetUsr, cGetPsw)
		cCodAux := RetCodUsr()
 	
 	//Senão atualiza o erro e retorna para a rotina
 	Else
 		cGetErr := "Usuário e/ou senha inválidos!"
 		oGetErr:Refresh()
 		Return
	EndIf
	
	//Se o retorno for válido, fecha a janela
	If lRetorno
		oDlgPvt:End()
	EndIf
Return

Caso você queira fazer uma rotina para logar, sem abrir o SIGAMDI, você pode chamar essa zLogin dentro de uma user function normal, através do seguinte trecho:

cUsrAux := ""
cPswAux := ""
 
//Verificando se o login deu certo
If u_zLogin(@cUsrAux, @cPswAux)
     
    //Chamando rotinas abaixo
    //...
EndIf

Bom pessoal, por hoje é só.
Abraços e até a próxima.

Dan Atilio (Daniel Atilio)
Especialista em Engenharia de Software pela FIB. Entusiasta de soluções Open Source. E blogueiro nas horas vagas.

6 Responses

  1. George Allan disse:

    Muito legal a ideia e bem simples e direta a execução, vlw aí por compartilhar 🙂

    George Allan
    http://www.userfunction.com.br

  2. charlles disse:

    Show cara, parabéns.

Deixe uma resposta