Seguridad en visual fox

Como se puden crear usuarios y dar distintos niveles de acceso a los usuarios y en criptar una base de datos en fox

1 Respuesta

Respuesta
1
Bueno eso de crear niveles de acceso es relativo ya que puedes crear dos o mas niveles y van a depender de lo que quieras hacer o los permisos que quieras dar a cada nivel, sin embargo hay te envio un pequeño ejemplo:
IF _Login(1)
*-- Usuario autenticado OK.
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
RELE loForm
IF llRet
RETURN .T.
ELSE
RETURN .F.
ENDI
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
* ----------------------------------------
y para encriptar tus datos esta este pequeño ejemplo:
****************************
* ENCRIPTACION DE CLAVE
* NOTA: EL TXTCLAVE, ES LA CAJA
* DE TEXTO QUE CONTIENE LA CLAVE
****************************
A = "Z"
DIMENSION KEY1[20]
FOR I = 1 TO LEN(ALLTRIM(Thisform.TXTCLAVE.Value))
Key1(i) = Asc(Substrc(Thisform.TXTCLAVE.value, i, 1)) + i
ENDFOR
FOR I = 1 TO LEN(ALLTRIM(Thisform.TXTCLAVE.Value))
A = A + Chr(Key1(i)) + "%&" + Chr(Key1(i)+10)
ENDFOR
CLAVE = A
**********************************************************
* Encripta tu clave de acceso
* Se utiliza la técnica de enmascaramiento de caracteres
* por trasposición
* Nombre: crip
* Uso: crip(TuClave)
*********************************************************
Function crip(cClave)
Long=Len(cClave)
Pos=1
car=Space(0)
do while Long>=Pos
Car=Chr(Asc(Substr(cClave,Pos,1))+Long)
Cad1=Stuff(cClave,pos,1,car)
pos=pos+1
Enddo
Return(cClave)

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas