Option Compare Database
Option Explicit
' Description:
' This module is designed to provide an enhanced InputBox function that masks
' password input with asterisks. It leverages Windows API calls to create a
' hook procedure that intercepts the activation of an InputBox and modifies
' it to behave like a password field.
'
' The FormattedInputBox function can be used to prompt the user for a password
' and returns the user's input as a masked string. The Test subroutine provides
' an example of how to call this function.
'
' The hard-coded class name "#32770" is used to identify dialog boxes in Windows,
' including the InputBox, so that the password masking character can be set.
'
' Usage:
' Call the FormattedInputBox function with the required prompt and optional title
' to display a password InputBox. Use the returned string as needed in your code.
#If VBA7 Then
' Passes the hook information to the next handler in the chain
Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal ncode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
' Obtains a handle for the specified module
Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr
' Sets a Windows hook to monitor messages
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
' Unhooks the Windows hook
Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hhk As LongPtr) As Long
' Sends a message to a dialog item, controlling its behavior
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
' Retrieves the class name of a window
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
' Gets the identifier for the current thread
Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
#Else
' Passes the hook information to the next handler in the chain
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
' Obtains a handle for the specified module
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
' Sets a Windows hook to monitor messages
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
' Unhooks the Windows hook
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hhk As Long) As Long
' Sends a message to a dialog item, controlling its behavior
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
' Retrieves the class name of a window
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
' Gets the identifier for the current thread
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
#End If
#If VBA7 Then
' The handle for managing the hook
Private hHook As LongPtr
#Else
' The handle for managing the hook
Private hHook As Long
#End If
' Code to set the password masking character
Private Const EM_SETPASSWORDCHAR As Long = &HCC
' Constants for handling Windows hooks and messages
Private Const WH_CBT As Long = 5
Private Const HCBT_ACTIVATE As Long = 5
Private Const HC_ACTION As Long = 0
' Purpose: Intercepts the activation of an InputBox (or dialog box) and modifies it to mask password input with asterisks.
' Params:
' - lngCode: Specifies the hook code
' - wParam: Specifies the identifier of the window
' - lParam: Additional information related to the message (depends on the hook code)
' Returns: The value returned by the next hook in the chain if lngCode is less than HC_ACTION, otherwise returns no specific value.
#If VBA7 Then
Private Function NewProc(ByVal lngCode As Long, ByVal wParam As LongPtr, ByVal lParam As Long) As LongPtr
#Else
Private Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
#End If
On Error GoTo Err_Handler
Dim RetVal As Long ' Holds the return value for GetClassName
Dim lngBuffer As Long ' Size of the buffer to hold the class name
Dim strClassName As String ' Buffer to receive the class name
' If the hook code is less than HC_ACTION, call the next hook
If lngCode < HC_ACTION Then
NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
Exit Function
End If
' Prepare a buffer for the class name of the window
strClassName = String$(256, " ")
lngBuffer = 255
' Check if the hook call corresponds to the window activation
If lngCode = HCBT_ACTIVATE Then
' Get the class name of the window being activated
RetVal = GetClassName(wParam, strClassName, lngBuffer)
' If the class name corresponds to a dialog box (class name "#32770" is standard for dialog boxes in Windows),
' set the password masking character. This check helps to identify the InputBox window.
If Left$(strClassName, RetVal) = "#32770" Then
SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
End If
End If
' Continue processing by calling the next hook in the chain
CallNextHookEx hHook, lngCode, wParam, lParam
Exit_Err_Handler:
Exit Function
Err_Handler:
MsgBox "Error Number: " & Err.Number & vbCrLf & "Error Description: " & Err.Description & vbCrLf & "Procedure: NewProc", vbCritical + vbOKOnly, "NewProc - Error"
Resume Exit_Err_Handler
End Function
' Purpose: Display an InputBox with masked password input using a Windows hook to modify the InputBox behavior.
' Params:
' - Prompt: The text string prompt that appears inside the InputBox.
' - Title (Optional): The text string that appears in the title bar of the InputBox.
' Returns: The user's input from the InputBox as a masked string.
Public Function FormattedInputBox(ByVal Prompt As String, Optional ByVal Title As String = vbNullString) As String
On Error GoTo Err_Handler
#If VBA7 Then
Dim lngModHwnd As LongPtr ' Handle to the module where the procedure is located
#Else
Dim lngModHwnd As Long ' Handle to the module where the procedure is located
#End If
Dim lngThreadID As Long ' Identifier of the current thread
' Get the current thread ID where the hook procedure will be installed
lngThreadID = GetCurrentThreadId
' Get the module handle for the module containing the procedure to be hooked
lngModHwnd = GetModuleHandle(vbNullString)
' Set the hook for the InputBox, pointing it to the NewProc function
hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
' Display the InputBox with the specified prompt and title, capturing the input with password masking
FormattedInputBox = InputBox(Prompt, Title)
' Remove the hook after capturing the input, restoring normal InputBox behavior
UnhookWindowsHookEx hHook
Exit_Err_Handler:
Exit Function
Err_Handler:
MsgBox "Error Number: " & Err.Number & vbCrLf & "Error Description: " & Err.Description & vbCrLf & "Procedure: FormattedInputBox", vbCritical + vbOKOnly, "FormattedInputBox - Error"
Resume Exit_Err_Handler
End Function
