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

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

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", "0101", cUsrAux, cPswAux)
        cCodAux := RetCodUsr()
		lRetorno := .T.
      
     //Senão atualiza o erro e retorna para a rotina
     Else
         cGetErr := "Usuário e/ou senha inválidos!"
         oGetErr:Refresh()
    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.

Tags: AdvPL