smtazulislam
Member
- Local time
- Today, 09:30
- Joined
- Mar 27, 2020
- Messages
- 808
Thank you so much. Its work..
No sir, I have a strongly login password. and 5 users use with secure. But I here show shortly demo .As already stated, I do urge you to ENCRYPT your passwords
Thank you so much for your advice. I try it as soon.Please start a new thread for that question. I suggest you also try and explain it more clearly
That's a functional code I used to use on 64bit
Option Compare Database
Option Explicit
'////////////////////////////////////////////////////////////////////
'Password masked InputBox
'Allows you to hide characters entered in a VBA Inputbox.
'
' Code written by Daniel Klann
' March 2003
'
' Revised by user riti90 on 12/20/2017
' https://www.access-programmers.co.uk/forums/threads/hide-password-in-input-box.176711/page-2#post-1578142
' It is believed that this version works with Access 32 bit and 64 bit.
'
' Enhanced by Ben Sacherich on 1/23/2023
' The function is named InputBox() and will override any normal calls to the VBA InputBox.
' It has an additional parameter that when set to True will mask all input as '*'
' If a Title is not passed it will default to the app title.
'
' Add this module to your existing app as basInputBox. No additional forms or references are needed.
'////////////////////////////////////////////////////////////////////
'API functions to be used
#If VBA7 Then
Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal ncode As Long, ByVal wParam As LongPtr, lParam As Any) As Long
Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr
Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long
Private Declare PtrSafe Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
Private hHook As LongPtr
#Else
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
Private hHook As Long
#End If
'~~> 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
Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim RetVal
Dim strClassName As String, 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 InputBox(Prompt As String, Optional Title As Variant, _
Optional Default As String, _
Optional Xpos As LongPtr, _
Optional Ypos As LongPtr, _
Optional Helpfile As String, _
Optional Context As LongPtr, _
Optional PasswordInput As Boolean) As String
' This is an override of the default Access InputBox function, based on
' code written by Christian Specht.
' https://christianspecht.de/2016/06/14/overriding-built-in-ms-access-functions-giving-the-msgbox-a-default-title/
' It will default the InputBox title to the app title if one is not specified.
' It also adds the ability to mask the input, based on code by Daniel Klann found here:
' https://www.access-programmers.co.uk/forums/threads/hide-password-in-input-box.176711/page-2
'
' BS 1/23/2023: Added optional parameter PasswordInput that when set to True will change
' the input mask of the inputbox so * is shown for any character that is typed.
Dim lngModHwnd As LongPtr, lngThreadID As LongPtr
On Error Resume Next
If IsMissing(Title) Then
Title = CurrentDb.Properties("AppTitle")
End If
'// Lets handle any Errors JIC! due to HookProc> App hang!
On Error GoTo ExitProperly
lngThreadID = GetCurrentThreadId
lngModHwnd = GetModuleHandle(vbNullString)
If PasswordInput = True Then
lngThreadID = GetCurrentThreadId
lngModHwnd = GetModuleHandle(vbNullString)
hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
End If
If Xpos Then
InputBox = VBA.Interaction.InputBox(Prompt, Title, Default, Xpos, Ypos, Helpfile, Context)
Else
InputBox = VBA.Interaction.InputBox(Prompt, Title, Default, , , Helpfile, Context)
End If
ExitProperly:
If PasswordInput = True Then
UnhookWindowsHookEx hHook
End If
End Function
Public Sub TestInputBox()
Dim x
x = InputBox("Type your password here.", , , , , , , True)
If x = "" Then End
If x <> "yourpassword" Then
MsgBox "You didn't enter a correct password."
End
End If
MsgBox "Welcome Creator!", vbExclamation
End Sub
Public Function MsgBox( _
Prompt, _
Optional Buttons As VbMsgBoxStyle = vbOKOnly, _
Optional Title, _
Optional Helpfile, _
Optional Context _
) _
As VbMsgBoxResult
' This is an override of the default Access MsgBox function.
' It will default the MsgBox title to the app title if one is not specified.
' https://christianspecht.de/2016/06/14/overriding-built-in-ms-access-functions-giving-the-msgbox-a-default-title/
On Error Resume Next
If IsMissing(Title) Then
Title = CurrentDb.Properties("AppTitle")
End If
MsgBox = VBA.Interaction.MsgBox(Prompt, Buttons, Title, Helpfile, Context)
End Function
What does that mean exactly? What does happen?
Did you copy the entire code needed for InputBoxDK?
Have a look at the code on my website Masked Input Box - Mendip Data Systems
EDIT: You have a syntax error in the DLookup line. It should be as shown below with no quote mark before Password:
Rich (BB code):If x<>DLookup("*", "Users", "UserName = '" & me.txtUserName & "' And Password = '" & x & "'")
good night
Could you please update the example address?
thanks.
Hello to all! and thanks!!
I am not very skilled on VBA. I do have a Type mismatch error on on this statement:
hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
error is over lngThreadID parameter. Any comment will be appreciated!!
Hello!Are you using the code from my website or that by @bsacheri in post #49?
You'll need to help us help you as I can't replicate the issue
Which version/bitness of Access are you using?
Dim lngModHwnd As LongPtr, lngThreadID As LongPtr
Dim lngModHwnd As LongPtr, lngThreadID As Long
I like this approach because it is easy to implement into an existing application. All you need to do is add one code module. All of your existing code will continue to work. Any place you want to accept password input you can pass an additional parameter to the InputBox() function. The dialog that appears will still have the standard look and feel of other dialogs.Maybe I'm missing something but that seems to be a lot of code for nothing.
If you create a tiny popup form with a textbox, you can set the input mask to "password" to hide the text as it is typed. The popup form would place the entered value into a control on the calling form and then exit. The control on the calling form can be hidden or if visible, use the "password" input mask to hide the text.