CISA FotoGallery

Statistiche

Tot. visite contenuti : 928000
Home Articoli tecnici API Input Box modalità Password

Input Box modalità Password

Questo Demo utilizza il SubClassing per dirottare la chiamata alla Finsestra dell'InputBox intercettandone il ClassName, e sostituendo i caratteri digitati con gli "*"...!

L'articolo è stato suggerito da Michele(Gio).

Codice pulito e funzionale:

CODICE

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
'
====================================================================



'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

Private 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
     'A window has been activated
    
If lngCode = HCBT_ACTIVATE Then
    
        
RetVal = GetClassName(wParam, strClassName, lngBuffer)
         'Class name of the Inputbox
        
If Left$(strClassName, RetVal) = "#32770" Then
        
            
'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(Title, _
                            Default, _
                            XPos, _
                            YPos, _
                            HelpFile, _
                            Context)
    UnhookWindowsHookEx hHook


End Function