CISA FotoGallery

Statistiche

Tot. visite contenuti : 928189
Home Articoli tecnici Moduli Sicurezza e Impostazioni

Sicurezza e Impostazioni

Option Compare Database
Option Explicit

'*********************************************************************
' NON MODIFICARE IL NOME DELLA MACRO AUTOEXEC
'*********************************************************************

'Questo modulo consente di applicare una sorta di Protezione e/o
'impostazione di AVVIO in modo Automatico
'Si può utilizzare lanciandola da un Menù sotto Password
'oppure inserendo un controllo nascosto in una Form.

'Consente di Modificare in un solo colpo tutte le proprietà
'del menù di AVVIO compreso ALLOW_BYPASS_KEY ed eventualmente
'la Macro AUTOEXEC.

'Startup properties
Private Const strAppTitle As String = "TITOLO APPLICAZIONE"
Private Const strStartUpForm As String = "PANNELLO PRINCIPALE"
Private Const strStartUpMenuBar As String = "mnuPrincipale"
Private Const strStartUpShortcutMenuBar As String = vbNullString
Private Const strAppIcon As String = vbNullString
Private Const blnStartUpShowDBWindow As Boolean = False
Private Const blnStartUpShowStatusBar As Boolean = False
Private Const blnAllowShortcutMenus As Boolean = False
Private Const blnAllowFullMenus As Boolean = False
Private Const blnAllowBuiltInToolbars As Boolean = False
Private Const blnAllowToolbarChanges As Boolean = False
Private Const blnAllowBreakIntoCode As Boolean = False
Private Const blnAllowSpecialKeys As Boolean = False
Private Const blnAllowBypassKey As Boolean = False

Public Function Secure()
    On Error Resume Next
    Call
ChangeProperty("AppTitle", dbText, strAppTitle)
    Call ChangeProperty("StartUpForm", dbText, strStartUpForm)
    Call ChangeProperty("StartUpMenuBar", dbText, strStartUpMenuBar)
    Call ChangeProperty("StartupShortcutMenuBar", dbText, strStartUpShortcutMenuBar)
    Call ChangeProperty("AppIcon", dbText, strAppIcon)
    Call ChangeProperty("StartUpShowDBWindow", dbBoolean, blnStartUpShowDBWindow)
    Call ChangeProperty("StartUpShowStatusBar", dbBoolean, blnStartUpShowStatusBar)
    Call ChangeProperty("AllowShortcutMenus", dbBoolean, blnAllowShortcutMenus)
    Call ChangeProperty("AllowFullMenus", dbBoolean, blnAllowFullMenus)
    Call ChangeProperty("AllowBuiltInToolbars", dbBoolean, blnAllowBuiltInToolbars)
    Call ChangeProperty("AllowToolbarChanges", dbBoolean, blnAllowToolbarChanges)
    Call ChangeProperty("AllowBreakIntoCode", dbBoolean, blnAllowBreakIntoCode)
    Call ChangeProperty("AllowSpecialKeys", dbBoolean, blnAllowSpecialKeys)
    Call ChangeProperty("AllowBypassKey", dbBoolean, blnAllowBypassKey)
    If CurrentDb.Containers("Scripts").Documents("$Autoexec").Name = "$Autoexec" Then _
    EnableAutoExec
End Function

Public Function
UnSecure()
    Call ChangeProperty("AppTitle", dbText, "My Application is UnSecured")
    Call ChangeProperty("StartUpForm", dbText, vbNullString)
    Call ChangeProperty("StartUpMenuBar", dbText, vbNullString)
    Call ChangeProperty("StartupShortcutMenuBar", dbText, vbNullString)
    Call ChangeProperty("AppIcon", dbText, vbNullString)
    Call ChangeProperty("StartUpShowDBWindow", dbBoolean, True)
    Call ChangeProperty("StartUpShowStatusBar", dbBoolean, True)
    Call ChangeProperty("AllowShortcutMenus", dbBoolean, True)
    Call ChangeProperty("AllowFullMenus", dbBoolean, True)
    Call ChangeProperty("AllowBuiltInToolbars", dbBoolean, True)
    Call ChangeProperty("AllowToolbarChanges", dbBoolean, True)
    Call ChangeProperty("AllowBreakIntoCode", dbBoolean, True)
    Call ChangeProperty("AllowSpecialKeys", dbBoolean, True)
    Call ChangeProperty("AllowBypassKey", dbBoolean, True)
    If CurrentDb.Containers("Scripts").Documents("Autoexec").Name = "Autoexec" Then _
    DisableAutoExec
End Function


Private Function
ChangeProperty(strPropName As String, _
            varPropType As Variant, _
            varPropValue As Variant) As Boolean
    Dim
prp As Property
    On Error GoTo
Change_Err
    If Len(varPropValue) > 0 Then
        
CurrentDb.Properties(strPropName) = varPropValue
    Else
        
CurrentDb.Properties.Delete strPropName
    End If
    
ChangeProperty = True
    Change_Bye:
    Set prp = Nothing
    Exit Function
    
Change_Err:
    Select Case Err
        Case
3265 'Item not found in this collection.
            'Do Nothing
            
Resume Next
        Case
3270 'prop not found
            
With CurrentDb
                Set prp = .CreateProperty(strPropName, varPropType, varPropValue)
                .Properties.Append prp
            End With
            Resume Next
        Case Else
            
'unknown error
            
ChangeProperty = False
            Resume Change_Bye
    End Select
End Function


Private Function
DisableAutoExec() As Boolean
    Dim
docCiclo As DAO.Document
    Dim dbs As DAO.Database
    Set dbs = CurrentDb
    DisableAutoExec = False
    For Each docCiclo In dbs.Containers!Scripts.Documents
         'Scorre l'insieme Documents del database per verificare la presenza della Macro
        ' se esiste la Rinomina
        
If docCiclo.Name = "Autoexec" Then
             
DoCmd.Rename "_Autoexec", acMacro, "Autoexec"
             DisableAutoExec = True
        End If
    Next
docCiclo
    Set dbs = Nothing
End Function

Private Function
EnableAutoExec() As Boolean
    Dim
docCiclo As DAO.Document
    Dim dbs As DAO.Database
    Set dbs = CurrentDb
    EnableAutoExec = False
    For Each docCiclo In dbs.Containers!Scripts.Documents
        'Scorre l'insieme Documents del database per verificare la presenza della Macro
        ' se esiste la Rinomina
        
If docCiclo.Name = "_Autoexec" Then
            
DoCmd.Rename "Autoexec", acMacro, "_Autoexec"
            EnableAutoExec = True
        End If
    Next
docCiclo
    Set dbs = Nothing
End Function