Condividi tramite

[Access] attiva disattiva shift con password [RISOLTO]

Anonimo
2009-12-04T17:16:02+00:00

Ciao a tutti,

anche oggi ho bisogno del vostro cortese aiuto quindi vi sottopongo il mio nuovo problema.

ho un database al quale attivo o disattivo lo shift servendomi di questa maschera che è attivabile 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 l'utility esterna della possibilità di disattivare il blocco dello shift del mio db protetta da password.

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

Microsoft 365 e Office | Access | Per la casa | Windows

Domanda bloccata. Questa domanda è stata eseguita dalla community del supporto tecnico Microsoft. È possibile votare se è utile, ma non è possibile aggiungere commenti o risposte o seguire la domanda.

0 commenti

Risposta accettata dall'autore della domanda

Anonimo
2009-12-04T22:48:30+00:00

ciao giorgio, vorrei applicarla a questa utility esterna ma va oltre le mie competenze :-(

Ciao Luca,

in quel codice ci sono diversi punti oscuri, ad esempio la variabile AD non vedo dove è dichiarata e dove viene valorizzata.

Come già detto in precedenza io creerei un db di utility.

Facciamo così:

se non sei in grado di costruirne uno in modo autonomo, usa e prendi spunto da questo esempio che ho preparato al volo.

AbilitaDisabilitaShift.mdb

http://cid-ac66fd4806f55617.skydrive.live.com/self.aspx/Pubblica/msaccess/Db/AbilitaDisabilitaShift.mdb

Ciao

Giorgio Rancati

La risposta è stata utile?

0 commenti

7 risposte aggiuntive

Ordina per: Più utili
Più utili Più recente Meno recente
  1. Anonimo
    2009-12-04T18:05:24+00:00

    Ciao Luca,

    io non starei li a far troppa fatica, se la maschera di avvio si corrompe ti basta creare un nuovo database e importare in esso tutti gli oggetti da quello corrotto. L'importazione di tutti gli oggetti non implica l'importazione della proprietà AllowBypassKey quindi nel nuovo db il tasto shift non sarà bloccato.

    Ciao

    Giorgio Rancati

    La risposta è stata utile?

    1 persona ha trovato utile questa risposta.
    0 commenti
  2. Anonimo
    2009-12-04T19:47:37+00:00

    ciao giorgio non ho capito bene, ma questo codice riesce a disattivare questo blocco shift?

    Scusa con database con password intendevo dire che la password paperino che leggi giù non ti permette di sbloccare lo shift e se la digiti erratta dopo averlo sbloccato ti riattiva la proprietà AllowBypassKey

    Ti chiedo se è possibile modificare l'utility di cui sotto per lo scopo che ho chiesto. Purtroppo non sono in grado di fare da me :-) 

    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

    La risposta è stata utile?

    0 commenti
  3. Anonimo
    2009-12-04T18:46:23+00:00

    Ciao Luca,

    vero solo che tu hai parlato di "database protetto da password" che è altra cosa :-)

    Comunque... per riabilitare il tasto shift io farei così:

    Mi creo un db di utility e da esso tolgo il blocco del tasto shift al database interessato in questo modo:

    Sub TogliBloccoShift()

    Dim Db As DAO.Database
Set Db = OpenDatabase("C:\Dati\Db6.mdb", False, False, "Ms Access;PWD=12345")
Db.Properties("AllowBypassKey") = False
Db.Close
Set Db = Nothing

    End Sub

    Se il Db non è protetto da password lascia vuoto l'ultimo parametro di OpenDatabase.

    Naturalmente puoi implementare la GetOpenFileName per selezionare il database.

    Ciao

    Giorgio Rancati

    La risposta è stata utile?

    0 commenti
  4. Anonimo
    2009-12-04T18:06:52+00:00

    ciao giorgio, ma se il vba ha la password non permette l'esportazione, almeno così mi sembra, oppure sbaglio?

    La risposta è stata utile?

    0 commenti