5- Protección Tecla Shift
Autor: Javier Gómez ("javier.mil")
El siguiente código sirve para proteger la tecla SHIFT mediante codigo.
Casi todo el mundo que utiliza Access sabe que pulsando la tecla SHIFT mientras se abre la base de datos, permite saltarse el primer formulario (entrada o inicio). El siguiente código lo evita.
La novedad de este código es que No se aprovecha del error de la propiedad para crearla , sino que busca primero si existe la propiedad y si No la encuentra entonces la crea.
Para que sea 100% operativo hay que ejecutar el procedimiento XecPrimeraVezSHIFT una sola vez.
sitúa el cursor AQUI Public Sub XecPrimeraVezSHIFT ()
luego pulsa F8 Public Sub XecPrimeraVezSHIFT ()
y finalmente F5
En caso que No se ejecute No pasaría nada, simplemente que la base estaría sólo segura la segunda vez que se entrase en la base.
en un FORMULARIO DE
ENTRADA o INICIO
Private Sub
Form_Open
(Cancel
As Integer)
Rem protege la tecla SHIFT
Rem Primera vez hay que ejecutar la
intruccion funSoloPrimeraVezSHIFT
If funProtegerSHIFT(Si) = False Then
Rem La propiedad No fue creada
MsgBox "Se ha producido un error grave de seguridad", vbExclamation,
"Error Shift"
Application.DoCmd.Quit
End If
End Sub
Otra opcion seria:
funProtegerSHIFT Si
en un MODULO
STANDARD
Option Explicit
Rem la propiedad shift solo funciona si
antes se ha creado !
Rem si es la primera vez y no esta creada **
No ** funciona se crearia automaticamente
pero solo funcionaria a partir de la segunda
vez
Rem para evitar esto hay que crear siempre
la proiedad antes de distribuir una
apliacion
Public Const cShift As String = "AllowByPassKey"
Public Enum eValor
Si = False
'<<< False = Protegido
No = True
'<<< True =
Des-Protegido
End Enum
Public Function
funProtegerSHIFT
(SiNo
As eValor) As Boolean
'---------------------------------------------------------------------------------------
' Procedure : XecProtegerSHIFT
' DateTime : 09/06/2009 20:47
' Author : Javier Gomez ("Javier.Mil")
' email : javier.news@gmail.com
' WEB : https://www.accessdemo.info
' Purpose : Protege el formulario de entrada
(o primer formulario) contra la tecla SHIFT
'---------------------------------------------------------------------------------------
On Error GoTo Err_Local
Dim dbs As DAO.Database
Dim prp As DAO.Property
Dim varProp As Variant
Set dbs = CurrentDb()
If funLeerPropiedades = True Then
Rem La propiedad Si esta creada y establezco
el valor correspondiente
dbs.Properties(cShift) = SiNo
Else
Rem La propiedad No esta creada y la creo
Set varProp = dbs.CreateProperty(cShift, dbBoolean, SiNo)
CurrentDb.Properties.Append varProp
End If
Set dbs = Nothing
Set prp = Nothing
funProtegerSHIFT = True
Exit_Local:
Exit Function
Err_Local:
MsgBox Err.Description, vbCritical, "Error
N°: " & Err.Number
Resume Exit_Local
End Function
Private Function
funLeerPropiedades
()
As Boolean
'---------------------------------------------------------------------------------------
' Procedure : funLeerPropiedades
' DateTime : 09/06/2009 20:45
' Author : Javier Gomez ("Javier.Mil")
' email : javier.news@gmail.com
' WEB : https://www.accessdemo.info
' Purpose : Lee la coleccion de propiedades
y busca si existe la propiedad SHIFT
'---------------------------------------------------------------------------------------
Dim dbs As DAO.Database
Dim prp As DAO.Property
On Error Resume Next
Set dbs = CurrentDb
For Each prp In dbs.Properties
Rem busco solo la propiedad SHIFT
If prp.Name = cShift Then
funLeerPropiedades = True
Exit For
End If
Next prp
Set dbs = Nothing
Set prp = Nothing
End Function
Public Sub
XecPrimeraVezSHIFT
()
Ejecutar este codigo 1 sola vez con F8 y luego F5
situa el cursor sobre Public Sub XecPrimeraVezSHIFT ()
luego pulsa F8 Public Sub XecPrimeraVezSHIFT ()
y finalmente
F5
'---------------------------------------------------------------------------------------
' Procedure : XecEjecutarUnaVez
' DateTime : 09/06/2009 20:41
' Author : Javier Gomez ("Javier.Mil")
' email : javier.news@gmail.com
' WEB : https://www.accessdemo.info
' Purpose :Rem Ejecutar este codigo solo 1
vez
Rem ejecutar este codigo antes de distribuir
tu aplicacion
Rem se creara la propiedad SHIFT
Rem puedes comprobar que se haya creado la
propiedad desde funleePropiedad
'---------------------------------------------------------------------------------------
On Error Resume Next
Dim varProp As Variant
Set varProp = CurrentDb.CreateProperty(cShift,
dbBoolean, False)
CurrentDb.Properties.Append varProp
MsgBox "Se ha creado la propiedad SHIFT con
exito", vbNewLine & _
"No hace falta creala mas veces",
vbInformation, "Tecla Shift"
End Sub