Wachtwoord beveiliging om shiftkey in en uit te schakelen

[halil]

Heeft iemand simpele VBA Code voor om shiftkey met wachtwoord uitschakelen voor MS access 2010?
ik heb eentje in de forum gezien maar die werkt helaas niet.
Alvast bedankt

 

[OctaFish]

Zonder de code te zien kunnen we natuurlijk niet veel. Want gheid dat ik dezelfde code ga voorstellen die dan bij mij natuurlijk wél werkt .

 

[halil]

Deze CODE heb ik gevonden en werd gebruikt om te ongrendelen:

***********************************
Private Sub Command264_Click()
Dim x As Variant
Dim sCheck As String
Dim sgebruiker As String
sgebruiker = "admin"

On Error Resume Next

Me.txtwachtwoord.SetFocus
If Me.txtwachtwoord.Text & "" = "" Then
MsgBox "Vul het wachtwoord in"
Exit Sub
End If

sCheck = "[Gebruikersnaam]='" & sgebruiker & "' AND [Wachtwoord]='" & Me.txtwachtwoord.Text & "'"
x = Nz(DLookup("[Gebruikersnaam]", "[Inlogtabel]", sCheck))
If Not x = vbNullString Then
SetProperties "AllowBypassKey", dbBoolean, True
MsgBox "De shift-toets is ontgrendeld!"
DoCmd.Close acForm, "FrmAdmin"
Else
MsgBox "Onjuist wachtwoord"

End If

End Sub


******************************
Deze voor grendelen:

Private Sub Afbeelding53_Click()

On Error Resume Next
SetProperties "AllowBypassKey", dbBoolean, False
MsgBox "De shift-toets is vergrendeld!"
DoCmd.Close acForm, "Beheerderstoegang"

 

[halil]

Code loopt vast bij:
SetProperties "AllowBypassKey", dbBoolean, True

 

[OctaFish]

Daar was ik al bang voor . Ik gebruik dezelfde opdracht (andere opzet, maar daar gaat het hier niet om) en bij bij werkt-ie tadellos.

    If strInput = "Hier staat het wachtwoord" Then
        SetProperties "AllowBypassKey", dbBoolean, True
        Beep
        MsgBox "De Bypass Key is ingeschakeld." & vbCrLf & vbLf _
               & "Je kunt de Shift key de volgende keer gebruiken " & vbCrLf _
               & "om het database venster te openen.", vbInformation, "Set Startup Properties"
    Else
        Beep
        SetProperties "AllowBypassKey", dbBoolean, False
        MsgBox "Verkeerd ''AllowBypassKey'' wachtwoord!" & vbCrLf & _
               "De Bypass Key is uitgeschakeld." & vbCrLf & vbLf & _
               "De Shift key kan niet gebruikt worden om de opstart procedure" & vbLf _
               & "te omzeilen bij het starten van de database.", vbCritical, "Invalid Password"
        Exit Sub
    End If

Enige verschil: mijn code staat tussen de CODE tags

 

[halil]

Dit ziet er beter uit Octafish ik ga gelijk uitproberen. bedankt.

 

[halil]

Octafish: bij de andere voorbeeld was 2 buttons op een formulier en paswoord invul vakje.
Hoe is dit met jou code geregeld (ik ben geen VBA deskundige) kan jij beetje toelichten aub
Is dit de complete CODE? en waar onder zet jij deze CODE?

 

[OctaFish]

Ik gebruik een knop en tekstvak omdat ik gebruikers niet wil lastig vallen met teveel knoppen. Op basis van de status verandert dan bijvoorbeeld de knoptekst. De hele procedure ziet er zo uit:

Private Sub bDisableBypassKey_Click()
Dim strInput As String
Dim strMsg As String

    strMsg = "Wil je de Bypass Key inschakelen?" & vbCrLf & vbLf & "Toets het wachtwoord in om deBypass Key te activeren."
    Me.Form.Visible = False
    DoCmd.OpenForm "WachtWoord", , , , , acDialog
    Me.Form.Visible = True

    strInput = Me.txtWachtwoord
    If strInput = "Hier staat het wachtwoord" Then
        SetProperties "AllowBypassKey", dbBoolean, True
        MsgBox "De Bypass Key is ingeschakeld." & vbCrLf & vbLf _
               & "Je kunt de Shift key de volgende keer gebruiken " & vbCrLf _
               & "om het database venster te openen.", vbInformation, "Set Startup Properties"
    Else
        SetProperties "AllowBypassKey", dbBoolean, False
        MsgBox "Verkeerd ''AllowBypassKey'' wachtwoord!" & vbCrLf & _
               "De Bypass Key is uitgeschakeld." & vbCrLf & vbLf & _
               "De Shift key kan niet gebruikt worden om de opstart procedure" & vbLf _
               & "te omzeilen bij het starten van de database.", vbCritical, "Invalid Password"
        Exit Sub
    End If
    Exit Sub

Err_bDisableBypassKey_Click:
    MsgBox "bDisableBypassKey_Click", Err.Number, Err.Description

End Sub

 

[halil]

Octafish hij loopt vast bij SetProperties :-(
ik stuur even mijn demo via de mail naar jou.

 

[OctaFish]

Zal er morgen naar kijken!

 

[OctaFish]

Je roept een functie aan die je niet in de db hebt zitten. dan is het logisch dat de functie daarop vastloopt, want hij kan natuurlijk niet naar een functie gaan die niet bestaat. Zet dus deze functie ergens in een module en alles werkt naar behoren.

Public Function SetProperties(strPropName As String, varPropType As Variant, varPropValue As Variant) As Integer
Dim db As DAO.Database, prp As DAO.Property
    On Error GoTo Err_SetProperties

    Set db = CurrentDb
    db.Properties(strPropName) = varPropValue
    SetProperties = True
    Set db = Nothing

Exit_SetProperties:
    Exit Function

Err_SetProperties:
    If Err = 3270 Then    'Property not found
        Set prp = db.CreateProperty(strPropName, varPropType, varPropValue)
        db.Properties.Append prp
        Resume Next
    Else
        SetProperties = False
        MsgBox "SetProperties", Err.Number, Err.Description
        Resume Exit_SetProperties
    End If
End Function

 

[halil]

Octafish: Dank je wel.
ja, ik had wel zo iets vermoede maar helaas ik ben niet helemaal los met VBA.
nogmaals bedankt.

 

[OctaFish]

Mag de vraag op <Opgelost> .

 

[halil]

Ja zeker.
Vraag is opgelost!

 

[OctaFish]

Maar nu de status nog aanpassen Moet je (kun je ook alleen maar als vraagsteller) zelf doen.

 

[halil]

Done!