Home‎ > ‎

BD Protegida (NO ABRIR)

En Ocasiones, cuando ejecutamos un programa con Back y Front End.... Nuestra Back-End queda expuesta a que cualquier usuario curioso la pueda abrir y entrar a las tablas y modificar ciertos datos o en su defecto todos los datos.
 
Que hariamos..??
 
Pues nada proteger la Back-End Con Codigo VBA 
 
Option Compare Database
Option Explicit
Const Oculto = dbHiddenObject 'Atributos para ocultar tablas
Const ver As Boolean = True 'False si desea ver las tablas
Function BloqueoJJJT()
On Error GoTo BloqueoJJJT_Error
'******************************************************************
'**************   JEFFERSON JIMENEZ (JJJT)  ***********************
'******************************************* CABIMAS - VENEZUELA **
'1)Oculto las tablas......... o Las hago visibles de nuevo
   Dim tbl As TableDef
   For Each tbl In CurrentDb.TableDefs
   With tbl
   If .Attributes = dbAttachedTable And ver Then
      .Attributes = Oculto
   ElseIf .Attributes = (dbAttachedTable + Oculto) And Not ver Then
          .RefreshLink
   ElseIf .Attributes = 0 And ver Then
          .Attributes = Oculto
   ElseIf .Attributes = 1 And Not ver Then
          .Attributes = 0
   End If
   End With
   Next
 '2)En cuanto abran la base de datos
   Dim db As Database
   Set db = CurrentDb
'3)ocultamos la Ventana Propiedades de la Base Access
   Call Ventana
'4)Deshabilitamos la tecla Shift para que ningun curioso la Abra
  '***********  OJO ******** OJO **************** OJO ***********
  'Si no sabes habilitarla despues mejor no toques este comando....????
  'db.Properties!AllowBypassKey = False
'5)ocultamos la cinta de Opciones si es Access 2007
    If Application.Version <> "11.0" Then
      DoCmd.ShowToolbar "Ribbon", acToolbarNo
    End If
              Application.RefreshDatabaseWindow
'6)Lanzamos el Mensaje de Advertencia
 MsgBox "Este Base de Datos no se puede Abrir", vbCritical, "BD Restringida"
'7)Y aqui nos vamos
      DoCmd.Quit
BloqueoJJJT_Exit:
Exit Function
BloqueoJJJT_Error:
If Err = 3270 Then
db.Properties.Append db.CreateProperty("AllowBypassKey", dbBoolean, True)
Resume Next
Else
   MsgBox "Error inesperado: " & Error$ & " (" & Err & ")"
   Resume BloqueoJJJT_Exit
End If
End Function
Private Sub Ventana()
  On Error GoTo ErrFuncion
   Dim db As Database, wks As Workspace
   Dim prop As Property
   Const conPropNotFound = 3270
    Set wks = Workspaces(0)
    Set db = wks.OpenDatabase(CurrentProject.Path & "\" & CurrentProject.Name)
   db.Properties("StartUpShowDbWindow") = False
Exit Sub
ErrFuncion:
   If Err = conPropNotFound Then
    Set prop = db.CreateProperty("StartUpShowDbWindow", _
        dbBoolean, False)
        db.Properties.Append prop
        Resume Next
    Else
        MsgBox Err.Description, vbInformation + vbOKOnly, "A V I S O"
        Exit Sub
    End If
End Sub

 
 
SelectionFile type iconFile nameDescriptionSizeRevisionTimeUser
ċ

Descargar
Descargue el Ejemplo  10 kb v. 1 27 jun. 2009 13:46 Jefferson Jimenez
Comments