Newsgroup: it.comp.appl.access
Titolo: attiva/disattiva shift

Ciao a tutti,
anche oggi ho bisogno del vostro cortese aiuto quindi vi sottopongo il
mio problema.
ho un database al quale attivo o disattivo lo shift servendomi di
questa della maschera e modulo attivabili dall'interno del DB stesso.
Per una maggiore sicurezza, anche in virtù che in passato è capitato
che la maschera iniziale di un db si è corrotta  impedendomi di fatto
di accedere al db, vorrei implemantare la sottindicata l'utility
esterna della possibilità di disattivare il blocco dello shift del mio
db.
allego i codici che utilizzo per il blocco/sblocco shift interno al db
e i codici dell'utility per l'attiva/disattiva shift esterno al db
Vi ringrazio anticipatamente
Private Sub Pass_AfterUpdate()
If Pass.value = "Paperino" Then
  ChangeProperty "AllowBypassKey", DB_Boolean, True
  MsgBox "Ora chiudi il DB e riaprilo tenendo premuto il tasto Shift",
vbInformation, "Password Corretta"
  DoCmd.Close
         Else
        ChangeProperty "AllowBypassKey", DB_Boolean, False
        MsgBox "Password ERRATA", vbCritical, "AVVISO"
      DoCmd.Close
      DoCmd.OpenForm "PasswordStruttura", acNormal
        End If
End Sub
codice modulo:
Option Compare Database
Sub SetBypassProperty()
Const DB_Boolean As Long = 1
    ChangeProperty "AllowBypassKey", DB_Boolean, False
End Sub
Function ChangeProperty(strPropName As String, varPropType As Variant,
varPropValue As Variant) As Integer
    Dim dbs As Object, prp As Variant
    Const conPropNotFoundError = 3270
    Set dbs = CurrentDb
    On Error GoTo Change_Err
    dbs.Properties(strPropName) = varPropValue
    ChangeProperty = True
Change_Bye:
    Exit Function
Change_Err:
    If err = conPropNotFoundError Then
        Set prp = dbs.CreateProperty(strPropName, varPropType,
varPropValue)
dbs.Properties.Append prp
        Resume Next
    Else
        ChangeProperty = False
        Resume Change_Bye
    End If
End Function
utility esterna al database
maschera:
Option Compare Database
Option Explicit
Private Sub cmdSelFile_Click()
    Dim strDatabase As String
    strDatabase = cmdlg_file
    If strDatabase = "" Then Exit Sub
    Me.txtDatabase = strDatabase
End Sub
Private Sub Esegui_Click()
Dim a As String
    If AD = 0 Then
      a = "disabilitato"
    ElseIf AD = -1 Then
      a = "abilitato"
    End If
    If IsNull(txtDatabase) Then
      MsgBox ("Inserire il percorso, il nome e l'estensione del
database"), vbExclamation
    Else
      Call BypassKey([AD], [txtDatabase])
        If BypassKey([AD], [txtDatabase]) = True Then
          MsgBox ("Tasto shift " & a), vbOKOnly
        Else
          MsgBox ("Database o percorso non validi!"), vbCritical
        End If
    End If
End Sub
Private Sub Comando10_Click()
On Error GoTo Err_Comando10_Click
    DoCmd.Quit
Exit_Comando10_Click:
    Exit Sub
Err_Comando10_Click:
    MsgBox Err.Description
    Resume Exit_Comando10_Click
End Sub
codice modulo:
Option Compare Database
Option Explicit
Private Declare Function GetOpenFileName Lib "comdlg32.dll" _
            Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME)
As Long
Private Type OPENFILENAME
   lStructSize As Long
   hwndOwner As Long
   hInstance As Long
   lpstrFilter As String
   lpstrCustomFilter As String
   nMaxCustFilter As Long
   nFilterIndex As Long
   lpstrFile As String
   nMaxFile As Long
   lpstrFileTitle As String
   nMaxFileTitle As Long
   lpstrInitialDir As String
   lpstrTitle As String
   flags As Long
   nFileOffset As Integer
   nFileExtension As Integer
   lpstrDefExt As String
   lCustData As Long
   lpfnHook As Long
   lpTemplateName As String
End Type
Public Function cmdlg_file() As String
     'Restituisce: il percorso completo del file selezionato
   Dim OpenFile As OPENFILENAME
   Dim lReturn As Long
   Dim sFilter As String
   OpenFile.lStructSize = Len(OpenFile)
   sFilter = "Database di Microsoft Access (*.mdb)" & Chr(0) & "*.mdb"
& Chr(0)
   OpenFile.lpstrFilter = sFilter
   OpenFile.nFilterIndex = 1
   OpenFile.lpstrFile = String(257, 0)
   OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
   OpenFile.lpstrFileTitle = OpenFile.lpstrFile
   OpenFile.nMaxFileTitle = OpenFile.nMaxFile
   OpenFile.lpstrInitialDir = "C:\"
   OpenFile.lpstrTitle = "Seleziona file"
   OpenFile.flags = 0
   lReturn = GetOpenFileName(OpenFile)
   If lReturn = 0 Then
      cmdlg_file = ""
   Else
      cmdlg_file = Left(OpenFile.lpstrFile, InStr(OpenFile.lpstrFile,
Chr$(0)) - 1)
   End If
End Function
Public Function BypassKey(bolVal As Boolean, Optional strMdb As
String) As Boolean
'Autore: Federico Luciani dal sito comune del newsgroup di
it.comp.app.access
'Accetta:
'bolVal = True: abilita; False: disabilita
'strMdb = [Opz.] percorso+nome del database
'Restituisce: True l'operazione e' stata eseguita correttamente
On Error GoTo bypass_Err
    Dim wrk As Workspace
    Dim dbs As Database
    Set wrk = DBEngine.Workspaces(0)
    If strMdb = "" Then
        Set dbs = CurrentDb()
    Else
        Set dbs = wrk.OpenDatabase(strMdb)
    End If
    dbs.Properties("AllowBypassKey") = bolVal
    BypassKey = True
    Set dbs = Nothing
    Set wrk = Nothing
    Exit Function
bypass_Err:
    If Err = 3270 Then
        Dim prp As Property
        Set prp = dbs.CreateProperty("AllowBypassKey", dbBoolean,
True)
        dbs.Properties.Append prp
        Resume
    Else
        BypassKey = False
    End If
End Function


buon giorno a tutti
ho risolto grazie

 wrote:
----cut----
buon giorno a tutti
ho risolto grazie
ma perch� avevi un problema?
-- 
Ciao
Geppo