Onzichtbaar wachtwoord

[remmie63]

Ik heb een deel van mijn db beveiligd met wachtwoord. Ik zoek nu de VBA code wanneer ik mijn ww intyp niet het wachtwoord te zien krijg maar bijv. ******. Zodat mensen niet mijn ww kunnen afkijken.

Bij voorbaat dank!

 

[manamana]

Hallo remmie 63.
Is dit iets.

http://office.microsoft.com/nl-nl/access-help/vba-code-verbergen-voor-gebruikers-HA010239557.aspx

Groet Manamana

 

[remmie63]

Bedankt Manamana. Ik bedoelde eigenlijk het wachtwoord dat ik invoer in het inlogscherm. Dus als mijn inlognaam bijv. papa is zie ik bij het intypen van "papa" : ****.
Jouw link is inderdaad een stap verder door ook de VB code af te schermen of "onzichtbaar" te maken. Om de echt kwaadwillende buiten te houden.
Thnx maar zo belangrijk is mijn db niet.

 

[OctaFish]

Je kunt een tekstvak een Invoermasker <Wachtwoord> geven; dan zie je letterlijk sterretjes... Geen VBA voor nodig!

 

[remmie63]

bij mijn DB zit het wachtwoord in de code het opent een extra tab waarmee mutaties mogelijk zijn:

Option Compare Database

Option Explicit
Const WachtWoord = "test"

Private Sub CheckBox5_AfterUpdate()
Dim i As Integer

For i = 6 To 11
Me("CheckBox" & i).Visible = Me.CheckBox5
Next i

For i = 1 To 10
If Me.CheckBox5 = -1 Then
Me("TextBox" & i).Visible = True
Else
Me("TextBox" & i).Visible = False
End If
Next i

End Sub

Private Sub Form_Load()
Dim sWW As String
sWW = InputBox("Typ het wachtwoord voor mutaties...", "Wachtwoord!")
If sWW = WachtWoord Then
Me.Mutaties.Visible = True
Else
Me.Mutaties.Visible = False
End If
End Sub

 

[OctaFish]

Dan heb je nog wat werk te doen, want in beginsel kun je in een Inputbox geen sterretjes krijgen. Daarvoor zou ik je toch een extra formuliertje aanraden, met dus een Invoermasker.
Of, als je graag programmeert: deze oplossing inbouwen. Maar een los formuliertje gaat een heel stuk sneller...

 

[remmie63]

Kun je mij een duwtje in de goede richting geven hoe dit aan te pakken!

 

[OctaFish]

Zet onderstaande code in een nieuwe module, en je zou er moeten zijn.

Option Compare Binary
Option Explicit    
'---------------------------------------------------------------------
'Password masked inputbox
'Allows you to hide characters entered in a VBA Inputbox.
'
'Code written by Daniel Klann
'March 2003
'---------------------------------------------------------------------
'Zo gebruiken op een formulier:
''    Dim tmp
''    tmp = InputBoxDK("Typ een wachtwoord", "Wachtwoord")
''    MsgBox tmp
'=====================================================================
 
'API functions to be used
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _
    ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
 
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
 
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
    (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
 
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
 
Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _
    (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, _
    ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
 
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
 
'Constants to be used in our API functions
Private Const EM_SETPASSWORDCHAR = &HCC
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private Const HC_ACTION = 0
Private hHook As Long
 
Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim RetVal As Variant
Dim strClassName As String
Dim lngBuffer As Long
 
    If lngCode < HC_ACTION Then
        NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
        Exit Function
    End If
 
    strClassName = String$(256, " ")
    lngBuffer = 255
 
    If lngCode = HCBT_ACTIVATE Then    'A window has been activated
        RetVal = GetClassName(wParam, strClassName, lngBuffer)
        If Left$(strClassName, RetVal) = "#32770" Then  'Class name of the Inputbox
            'This changes the edit control so that it display the password character *.
            'You can change the Asc("*") as you please.
            SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
        End If
    End If
 
    'This line will ensure that any other hooks that may be in place are called correctly.
    CallNextHookEx hHook, lngCode, wParam, lParam
 
End Function
 
Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, _
    Optional YPos, Optional HelpFile, Optional Context) As String
Dim lngModHwnd As Long, lngThreadID As Long
 
    lngThreadID = GetCurrentThreadId
    lngModHwnd = GetModuleHandle(vbNullString)
 
    hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
 
    InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context)
    UnhookWindowsHookEx hHook
 
End Function

Je kunt hem dan aanroepen zoals in het voorbeeldje staat aangegeven.

 

[remmie63]

Werkt prima!

Wederom veel dank!

Groet, Remco