Hide Password in Input Box (Solved) (1 Viewer)

spOOk123

New member
Local time
Today, 16:42
Joined
Oct 3, 2020
Messages
11
I did not write these functions but it has very easy code implementation and I have have used is numerously over the years (it is very old but still working in Excel and Access 2016) - I hope someone else can benefit from it as I have
Example code usage

Code:
Private Sub cmdButton_Click()
    On Error Resume Next
    Dim pWord As String
    pWord = InputBoxDK("Enter Administrative Password", "Password Required!")
    If pWord = "" Then
        MsgBox "Nothing Entered" & vbCrLf & vbLf & "Please Contact Your Local Administrator", vbCritical, "Security Logging"
        GoTo ExitInput:
    End If
    If pWord = 1234554321 Then 'password is correct (password of your choice)
        'Do stuff here
    Else
       MsgBox "Incorrect Password!" & vbCrLf & vbLf & "Please Contact Your Local Administrator", vbCritical, "Security Logging"
       Exit Sub
    End If
ExitInput:
End Sub


Code:
'All below to be placed in standard module
Option Compare Database
Option Explicit

'Usage is for masking of password entry of a input box - namely InputBoxDK
'=============== '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
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 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
 

Isaac

Lifelong Learner
Local time
Today, 14:42
Joined
Mar 14, 2017
Messages
3,763
Very cool, thanks for posting.

My db security is always based on network/windows usernames, but in password cases it's great to have the asterisks.

In Excel you can set a textbox in a userform to use "password character" (or something like that), and show any character you want, which is a nice feature. (Microsoft you listening?)
 

MajP

You've got your good things, and you've got mine.
Local time
Today, 17:42
Joined
May 21, 2018
Messages
4,493
If you are going to do this, you might as well roll your own inputbox. Here is a good example that you can download

This gives you more flexibility and allows you to format to your DB theme. Also not sure if the API code would need to get modified for 64bit.
 

spOOk123

New member
Local time
Today, 16:42
Joined
Oct 3, 2020
Messages
11
A patch for 64bit would be needed - already read article in mention but thx for input
 

Users who are viewing this thread

Top Bottom