|
Option Explicit |
|
'//////////////////////////////////////////////////////////////////// |
|
'Password masked inputbox |
|
'Allows you to hide characters entered in a VBA Inputbox. |
|
' |
|
'Code written by Daniel Klann |
|
'http://www.danielklann.com/ |
|
'March 2003 |
|
'// Kindly permitted to be amended |
|
'// Amended by Ivan F Moala |
|
'// [url=http://www.xcelfiles.com]Microsoft Excel Files by Ivan F Moala contains VBA API WMI VBS and formulas. Remember can do.[/url] |
|
'// April 2003 |
|
'// Works for Xl2000+ due the AddressOf Operator |
|
'// |
|
'// Amended 5th March 2004 for Gopal |
|
'// This allows it to be run on Xl97+ |
|
'//////////////////////////////////////////////////////////////////// |
|
'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 Long |
|
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 |
|
'// Make it public = avail to ALL Modules |
|
'// Lets simulate the VBA Input Function |
|
Public Function InputBoxDK(Prompt As String, Optional Title As String, _ |
|
Optional Default As String, _ |
|
Optional Xpos As Long, _ |
|
Optional Ypos As Long, _ |
|
Optional Helpfile As String, _ |
|
Optional Context As Long) As String |
|
|
|
Dim lngModHwnd As Long, lngThreadID As Long |
|
|
|
'// Lets handle any Errors JIC! due to HookProc> App hang! |
|
On Error GoTo ExitProperly |
|
lngThreadID = GetCurrentThreadId |
|
lngModHwnd = GetModuleHandle(vbNullString) |
|
|
|
#If VBA6 Then |
|
hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID) |
|
#Else |
|
hHook = SetWindowsHookEx(WH_CBT, AddrOf("NewProc"), lngModHwnd, lngThreadID) |
|
#End If |
|
If Xpos Then |
|
InputBoxDK = InputBox(Prompt, Title, Default, Xpos, Ypos, Helpfile, Context) |
|
Else |
|
InputBoxDK = InputBox(Prompt, Title, Default, , , Helpfile, Context) |
|
End If |
|
ExitProperly: |
|
UnhookWindowsHookEx hHook |
|
End Function |