Ventana de LOGIN

Con la clase Login podemos tener facilmente un control de acceso a nuestras aplicaciones.

Ejemplo

IF _Login(1)
  MESSAGEBOX("Usuario autenticado OK.",64,"Login")
ELSE
   *-- Usuario no válido
   RETURN
ENDIF

* ----------------------------------------
* Function _Login( lnNivel, lnNivelSup)
* ----------------------------------------
* Funcion que muestra el form de LOGIN
* Parámetros:
*     lnNivel [opc] - Nivel autorizado.
*     si se omite permite cualquier 
*     usuario registrado
* ----------------------------------------
FUNCTION _Login( lnNivel, lnNivelSup)
  LOCAL llRet
  IF PARAMETERS() < 1
    lnNivel = 0
  ENDIF
  IF PARAMETERS() < 2
    lnNivelSup = 10
  ENDIF
  loForm = CREATEOBJECT("Login", lnNivel, lnNivelSup)
  loForm.SHOW()
  llRet = loForm.lRetorno
  RELEASE loForm
  loForm = .NULL.
  RETURN llRet
ENDFUNC
* ----------------------------------------
*-- Class:        Login
*-- Ingreso de password
* ----------------------------------------
DEFINE CLASS Login AS FORM
  HEIGHT = 110
  WIDTH = 220
  DOCREATE = .T.
  AUTOCENTER = .T.
  BORDERSTYLE = 2
  CAPTION = "Ingrese usuario y contraseña"
  CONTROLBOX = .F.
  CLOSABLE = .F.
  MAXBUTTON = .F.
  MINBUTTON = .F.
  WINDOWTYPE = 1
  *-- Nivel inferior de acceso
  nNivelInf = -1
  *-- Nivel superior de acceso
  nNivelSup = -1
  *-- Numero de intentos de validacion
  nIntentos = -1
  NAME = "Login"
  *-- retorna .T. si el usuario y contraseña son correctos
  lRetorno = .F.
  ADD OBJECT cmdaceptar AS COMMANDBUTTON WITH ;
    TOP = 72, LEFT = 48, HEIGHT = 25, WIDTH = 72, ;
    FONTNAME = "MS Sans Serif", FONTSIZE = 8, ;
    CAPTION = "Aceptar", DEFAULT = .T., ;
    TABINDEX = 5, NAME = "cmdAceptar"
  ADD OBJECT cmdcancelar AS COMMANDBUTTON WITH ;
    TOP = 72, LEFT = 133, HEIGHT = 25, WIDTH = 72, ;
    FONTNAME = "MS Sans Serif", ;
    FONTSIZE = 8, CANCEL = .T., ;
    CAPTION = "Cancelar", ;
    TABINDEX = 6, NAME = "cmdCancelar"
  ADD OBJECT lblusuario AS LABEL WITH ;
    FONTNAME = "MS Sans Serif", FONTSIZE = 8, ;
    ALIGNMENT = 1, BACKSTYLE = 0, CAPTION = "Usuario", ;
    HEIGHT = 15, LEFT = 12, TOP = 16, WIDTH = 60, ;
    TABINDEX = 2, NAME = "lblUsuario"
  ADD OBJECT lblcontrasena AS LABEL WITH ;
    FONTNAME = "MS Sans Serif", FONTSIZE = 8, ;
    ALIGNMENT = 1, BACKSTYLE = 0, CAPTION = "Contraseña", ;
    HEIGHT = 15, LEFT = 12, TOP = 40, WIDTH = 60, ;
    TABINDEX = 4, NAME = "lblContrasena"
  ADD OBJECT txtusuario AS TEXTBOX WITH ;
    FONTNAME = "MS Sans Serif", FONTSIZE = 8, ;
    FORMAT = "k", HEIGHT = 21, ;
    LEFT = 85, MAXLENGTH = 15, ;
    TABINDEX = 1, TOP = 12, ;
    WIDTH = 120, NAME = "txtUsuario"
  ADD OBJECT txtcontrasena AS TEXTBOX WITH ;
    FONTNAME = "MS Sans Serif", FONTSIZE = 8, ;
    FORMAT = "k", HEIGHT = 21, ;
    LEFT = 85, MAXLENGTH = 15, ;
    TABINDEX = 3, TOP = 36, ;
    WIDTH = 120, PASSWORDCHAR = "*", ;
    NAME = "txtContrasena"
  PROCEDURE validausuario
    LPARAMETERS tcUsuario, tcContrasena, tnNivelInf, tnNivelSup
    LOCAL lcUser, lcPass, lnNivel
    *--- pasa usuario a mayuscula
    tcUsuario = ALLTRIM(UPPER(tcUsuario))
    tcContrasena = ALLTRIM(tcContrasena)
    *-----------------------------
    *--- Aqui busco los datos del usuario
    *--- en la tabla de Usuarios
    *-----------------------------
    lcUser = "LUIS"
    lcPass = "siul"
    lnNivel = 5
    *-----------------------------
    *--- valido usuario y contraseña
    IF NOT (tcUsuario == lcUser ;
        AND tcContrasena == lcPass)
      *--- No existe usuario o Contraseña no válida
      =MESSAGEBOX('Usuario o contraseña inválida',48,'Advertencia')
      RETURN .F.
    ENDI
    IF NOT BETWEEN(lnNivel, tnNivelInf, tnNivelSup)
      *--- Nivel no autorizado
      =MESSAGEBOX('Usuario no autorizado para este módulo',48,'Advertencia')
      RETURN .F.
    ENDI
    *--- Todo correcto
    RETURN .T.
  ENDPROC
  PROCEDURE UNLOAD
    RETURN THISFORM.lRetorno
  ENDPROC
  PROCEDURE INIT
    LPARAMETERS tnNivelInf, tnNivelSup
    IF PARAMETERS() < 0
      tnNivelInf = 0
    ENDIF
    IF PARAMETERS() < 1
      tnNivelSup = 10
    ENDIF
    THISFORM.nIntentos = 0
    THISFORM.nNivelInf = tnNivelInf
    THISFORM.nNivelSup = tnNivelSup
    THISFORM.txtUsuario.SETFOCUS
    THISFORM.cmdAceptar.DEFAULT = .T.   && porque lo pierde en el SetFocus
  ENDPROC
  PROCEDURE cmdaceptar.CLICK
    THISFORM.nIntentos=THISFORM.nIntentos+1
    THISFORM.lRetorno=THISFORM.ValidaUsuario( ;
      THISFORM.txtUsuario.VALUE, ;
      THISFORM.txtContrasena.VALUE, ;
      THISFORM.nNivelInf, THISFORM.nNivelSup)
    IF THISFORM.lRetorno
      THISFORM.HIDE
    ELSE
      IF THISFORM.nIntentos < 3 
        IF EMPTY(THISFORM.txtUsuario.VALUE)
          THISFORM.txtUsuario.SETFOCUS
        ELSE
          THISFORM.txtContrasena.SETFOCUS
        ENDI
      ELSE
        =MESSAGEBOX('Acceso denegado',16,'Advertencia')
        THISFORM.HIDE
      ENDI
    ENDI
  ENDPROC
  PROCEDURE cmdcancelar.CLICK
    THISFORM.lRetorno=.F.
    THISFORM.HIDE
  ENDPROC
ENDDEFINE
* ----------------------------------------
*-- EndDefine: Login
* ----------------------------------------

Luis María Guayán