Hide Password in Input Box

[smtazulislam]

Thank you so much. Its work..

 

[isladogs]

Glad to have assisted.
As already stated, I do urge you to ENCRYPT your passwords

 

[smtazulislam]

As already stated, I do urge you to ENCRYPT your passwords

No sir, I have a strongly login password. and 5 users use with secure. But I here show shortly demo .
I have another question.
If I would like to input my own create a FORM then what I should change there ?

 

[isladogs]

You are missing the point.
No matter how strong the passwords are, storing them in an Access table with or without a password mask is totally insecure.
It is trivial for any user to remove the table password mask and, by doing so, be able to view all users passwords.

If you must store user passwords, encryption is absolutely essential to provide some degree of security.
Better still, don't store passwords. Use Active Directory instead. That is VERY secure.

As for your other question, you are hijacking the thread by asking your own unrelated question.
Please start a new thread for that question. I suggest you also try and explain it more clearly

 

[smtazulislam]

Please start a new thread for that question. I suggest you also try and explain it more clearly

Thank you so much for your advice. I try it as soon.
This is my threads

Input Password box in the Form.

Any help will appreciate. In a FORM, I want to input box for insert USER password which password he enter to access database. If this password is correct then he can allow to edit this form. Can possible ? I dont like to Fixed Password in the VBA.

www.access-programmers.co.uk

 

[bsacheri]

That's a functional code I used to use on 64bit

I have made some enhancements to post #27 by @riti90

• The function is named InputBox() and will override any normal calls to the VBA InputBox thus you don't have to update code if you implement in an existing app.
• 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.
• As a bonus this also includes a MsgBox function that will override the VBA MsgBox function and default the dialog title to the app title if one is not passed.
• I recommend you save this code in a new module named basInputBox. The beauty of this code is that you can add it to any existing app and it should not break existing code. It does not rely on any forms or references.

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

 

[isladogs]

Thanks Ben
I will look at your code properly, hopefully in the next few days

 

[Mylton]

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:

If x<>DLookup("*", "Users", "UserName = '" & me.txtUserName & "' And Password = '" & x & "'")

good night
Could you please update the example address?
thanks.

 

[isladogs]

good night
Could you please update the example address?
thanks.

As requested, I've just updated two old links in this thread

 

[bejaranoangel]

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 apreciated!!

 

[isladogs]

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!!

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?

 

[bejaranoangel]

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?

Hello!
Thanks for your answer.
and yes I am testing @bsacheri code. I am using Access for Microsoft 365, my references are:

Visual Basic For Applications
Microsoft Access 16.0 Object Library
OLE Automation
Microsoft Office 16.0 Access database engine Object Library

let me know if something else is needed.

 

[isladogs]

I've already tested it without error in A365 version 2301 and with the same standard references

32-bit or 64- bit? Version and build number for A365? You might find it easier to use my version checker utility for this

Access/Office365/Win Check

Use this utility to obtain the full Access/Windows/Office 365 version and bitness information

www.isladogs.co.uk

It is also available as an add-in.

Also suggest you test the older masked input box code on my website and see if that works for you

Masked Input Box

This article contains an updated version of the masked input box code and works in 32-bit and 64-bit Access

www.isladogs.co.uk

 

[isladogs]

UPDATE
Just tested it in 64-bit Access & got the same error
Easily fixed.
Change the following line from

Dim lngModHwnd As LongPtr, lngThreadID As LongPtr

to

Dim lngModHwnd As LongPtr, lngThreadID As Long

so that it matches the output of the API declaration for GetCurrentThreadId

Tested & working in both 32-bit & 64-bit

 

[bejaranoangel]

Hello Sir!!
Workeeed!!
I though for x64 ptr was the correct. Thanks so much!, and I wanna get this chance that I grab your attention to let you know that I been follow your job per years, every time I see your contributions are just admirable and personally help full. You're one of the greatest on this area. I wish you the best @isladogs.
Best Regards.
PD: Greetings from México. Apologize my English

 

[isladogs]

Thanks for your very positive feedback

For info LongPtr is only needed for handles & pointers such as hWnd (or in this case lngModHwnd)
Whereas lngThreadID isn't being used as a handle, Long is correct

There are many lengthy articles about this topic, some better than others. For a good example, see:

Windows API declarations in VBA for 64-bit

How to convert your API Declarations to 64-bit. - Common myths debunked, key factors explained!

codekabinett.com

 

[isladogs]

For info, standard input boxes cannot handle languages which use unicode characters sets e.g. Arabic, Japanese, Malayalam without changes to locale and keyboard settings. This is also true for standard message boxes

However, I've just posted a web article which includes a new function UnicodeInputBox which does work with Unicode characters sets including right-to-left languages such as Arabic, & Hebrew

Unicode Input Box

This function allows input boxes to handle unicode character sets used in languages such as Bengali, Chinese etc without changes to locale or keyboard settings. It can also handle right-to-left languages such as Arabic and Hebrew. A further advantage is that it can be used successfully with...

www.isladogs.co.uk

For example

The language used for the buttons is automatically updated when the Office language is changed

I've not included the code that Ben Sacherich posted earlier but I may merge both sets of code at a later date

 

[bsacheri]

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.

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.

In other applications I have created a custom InputBox form but for my most recent app I felt that copying a form and a module and then tweaking the looks of the form was more work than I wanted to deal with. I guess it depends on the situation.

 

[KitaYama]

For info, standard input boxes cannot handle languages which use unicode characters sets e.g. Arabic, Japanese, Malayalam without changes to locale and keyboard settings. This is also true for standard message boxes

However, I've just posted a web article which includes a new function UnicodeInputBox which does work with Unicode characters sets including right-to-left languages such as Arabic, & Hebrew

Unicode Input Box

This function allows input boxes to handle unicode character sets used in languages such as Bengali, Chinese etc without changes to locale or keyboard settings. It can also handle right-to-left languages such as Arabic and Hebrew. A further advantage is that it can be used successfully with...

www.isladogs.co.uk

For example
View attachment 106139

The language used for the buttons is automatically updated when the Office language is changed

I've not included the code that Ben Sacherich posted earlier but I may merge both sets of code at a later date

@isladogs In the link you provided, a TranslateXL function have been used. May I ask how this function behaves? Does it read the translation from a table?

As you explained, without changing locale, Unicode character set can not be used in vba. My problem at this point is how to pass the Unicode character to UnicodeInputBox function. I do a DLookup against a translator table to pull out the message and show it to the user.

Thanks.

 

[isladogs]

I use 2 functions: Translate & TranslateXL
Both work in a similar way & can translate from a Latin character set language to a Unicode character set language such as Arabic, Japanese etc
Each sets up a URL to use Google Translate & grabs the output string then processes it

However, only the TranslateXL function can handle translation from a Unicode character set, so I normally use that
An Excel instance is used as an intermediary to setup the encoded URL needed to run the translation

I bypass the locale issue by entering the text in e.g. English & translating each section in code first
For example

Private Sub cmdUnicode_Click()

   On Error GoTo Err_Handler

      Dim intID As Integer, strP As String, strT As String, strD As String
    
      strP = TranslateXL("Enter a Record ID between 1 and 27", "En", strLang) 'prompt
      strT = TranslateXL("Select Record ID", "En", strLang) 'title
      strD = TranslateXL("Record Number", "En", strLang) 'default value
  
      'UnicodeInputBox works correctly for non-Latin character set
      'The 9000 & 5000 are x & y positions- omit to centre on the screen

      'get the return value
      intID = UnicodeInputBox(strP, strT, strD, 9000, 5000)
    
      'use to move to specified record
      DoCmd.GoToRecord , , acGoTo, intID

Exit_Handler:
  Exit Sub
        
Err_Handler:
  If Err = 13 Then Exit Sub 'user made no entry or pressed cancel
  MsgBox "Error " & Err.Number & " in cmdUnicodeInputBox_Click procedure: " & Err.Description
  Resume Exit_Handler

End Sub

strLang is the code for the language being translated into e.g. ko, ja etc & is set elsewhere